德爾福 - 獲取文件夾圖標

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;