Delphi - 获取文件夹图标

Question

我怎么能得到特殊文件夹的图标,例如 Desktop

function GetFolderIcon( FName: string ): integer;
var
  FInfo: TSHFileInfo;
begin
  if SHGetFileInfo(pChar(FName), FILE_ATTRIBUTE_NORMAL, FInfo, SizeOf(FInfo),
     SHGFI_SYSICONINDEX or SHGFI_SMALLICON or SHGFI_USEFILEATTRIBUTES or SHGFI_PIDL or SHGFI_ICON or SHGFI_OPENICON ) <> 0 then begin
        Result := FInfo.iIcon
    end
  else
    Result := -1;
end;

GetFolderIcon(GetSpecialFolder(CSIDL_DESKTOP)); retern -1

Answer 1

CSIDL_DESKTOP是" 代表Windows桌面的虚拟文件夹,命名空间的根 ".因此,它没有可以传递给的文件系统路径SHGetFileInfo().您可能正在考虑CSIDL_DESKTOPDIRECTORY,这是" 用于在桌面上物理存储文件对象的文件系统目录(不要与桌面文件夹本身混淆) ":

GetFolderIcon(GetSpecialFolder(CSIDL_DESKTOPDIRECTORY));

调用时SHGetFileInfo(),您可以指定SHGFI_PIDL标志,以便传递PIDL而不是文件系统路径.这允许查询虚拟物品.您的代码已在使用SHGFI_PIDL,但它没有使用任何PIDLs,这意味着您SHGetFileInfo()开始使用不正确.

试试这个:

uses
  ..., ShlObj, SHFolder;

function GetSpecialFolderPath(FolderID: Integer): String;
var
  Path: array[0..MAX_PATH] of Char;
begin
  if SHGetFolderPath(0, FolderID, nil, SHGFP_TYPE_CURRENT, Path) = 0 then
    Result := Path
  else
    Result := '';
end;

function GetSpecialFolderPidl(FolderID: Integer): PItemIDList;
begin
  Result := nil;
  SHGetSpecialFolderLocation(0, FolderID, Result);
end;

function GetFolderIcon( FName: String ): integer; overload;
var
  FInfo: TSHFileInfo;
begin
  ZeroMemory(@FInfo, SizeOf(FInfo));
  if SHGetFileInfo(PChar(FName), FILE_ATTRIBUTE_NORMAL, FInfo, SizeOf(FInfo), SHGFI_USEFILEATTRIBUTES or SHGFI_SYSICONINDEX or SHGFI_SMALLICON or SHGFI_ICON or SHGFI_OPENICON ) <> 0 then
  begin
    Result := FInfo.iIcon;
    if FInfo.hIcon <> 0 then DestroyIcon(FInfo.hIcon);
  end else
    Result := -1;
end;

function GetFolderIcon( Pidl: PItemIDList ): integer; overload;
var
  FInfo: TSHFileInfo;
begin
    if SHGetFileInfo(PChar(Pidl), FILE_ATTRIBUTE_NORMAL, FInfo, SizeOf(FInfo), SHGFI_PIDL or SHGFI_USEFILEATTRIBUTES or SHGFI_SYSICONINDEX or SHGFI_SMALLICON or SHGFI_ICON or SHGFI_OPENICON ) <> 0 then
  begin
    Result := FInfo.iIcon;
    if FInfo.hIcon <> 0 then DestroyIcon(FInfo.hIcon);
  end
  else
    Result := -1;
end;

var
  Icon: Integer;
  Pidl: PItemIDList;
begin
  Icon := -1;
  Pidl := GetSpecialFolderPidl(CSIDL_DESKTOP);
  if Pidl <> nil then
  try
    Icon := GetFolderIcon(Pidl);
  finally
    CoTaskMemFree(Pidl);
  end;
end;

var
  Icon: Integer;
  Path: string;
begin
  Icon := -1;
  Path := GetSpecialFolderPath(CSIDL_DESKTOPDIRECTORY);
  if Path <> '' then
    Icon := GetFolderIcon(Path);
end;