德尔福 - 获取文件夹图标

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 s，这意味着您错误地使用了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;