Logo Questions Linux Laravel Mysql Ubuntu Git Menu
 

Delphi - Get folder icon

Tags:

winapi

delphi

How i can get the icon of special folder for example 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

like image 808
RepeatUntil Avatar asked Jan 08 '23 07:01

RepeatUntil


1 Answers

CSIDL_DESKTOP is the "virtual folder that represents the Windows desktop, the root of the namespace". As such, it does not have a filesystem path that you can pass to SHGetFileInfo(). You are probably thinking of CSIDL_DESKTOPDIRECTORY instead, which is "The file system directory used to physically store file objects on the desktop (not to be confused with the desktop folder itself)":

GetFolderIcon(GetSpecialFolder(CSIDL_DESKTOPDIRECTORY));

When calling SHGetFileInfo(), you can specify the SHGFI_PIDL flag so you can pass a PIDL instead of a filesystem path. That allows for querying virtual items. Your code is already using SHGFI_PIDL, but it is not using any PIDLs, which means you are using SHGetFileInfo() incorrectly to begin with.

Try this:

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;
like image 102
Remy Lebeau Avatar answered Jan 12 '23 04:01

Remy Lebeau