implementation
uses Windows, CommCtrl, WinDirs, ShellApi;
{$R *.lfm}
function GetShellIcon(const FileName: UnicodeString): HICON;
const
CFlagGetIcon = SHGFI_ICON or SHGFI_SMALLICON or SHGFI_USEFILEATTRIBUTES;
var
R: TSHFileInfoW;
begin
Result := 0;
if ExtractIconExW(Pointer(FileName), 0, HICON(nil^), Result, 1) <> 1 then
begin
if SHGetFileInfoW(Pointer(FileName), 0, @R, SizeOf(R), CFlagGetIcon) <> 0 then
Result := R.hIcon;
end;
end;
procedure TForm1.Button1Click(Sender: TObject);
var
DesktopPath: UnicodeString;
R: TUnicodeSearchRec;
Item: TListItem;
FileIcon: HICON;
begin
DesktopPath := GetWindowsSpecialDirUnicode(CSIDL_DESKTOPDIRECTORY, False);
if FindFirst(DesktopPath + '*', faNormal, R) = 0 then
try
repeat
Item := ListView1.Items.Add;
Item.Caption := UTF8Encode(R.Name);
FileIcon := GetShellIcon(DesktopPath + R.Name);
if FileIcon <> 0 then
Item.ImageIndex := ImageList_AddIcon(ImageList1.{%H-}Handle, FileIcon);
until FindNext(R) <> 0;
finally
SysUtils.FindClose(R);
end;
end;
end.