Delphi - 获取文件夹图标

Question

如何获取特殊文件夹的图标，例如桌面

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，但未使用任何 PIDL，这意味着您一开始就错误地使用了 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;