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，但它没有使用任何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;

Delphi - 获取文件夹图标

1 个答案: