In a 32-bit VCL Application in Windows 10 in Delphi 11 Alexandria, I have a TListBox
where Style = lbOwnerDrawVariable
to draw images from a 16x16 TImageList
in front of the ListBox items showing filenames:
procedure TformMain.listboxProjectFilesDrawItem(Control: TWinControl; Index: Integer; Rect: TRect; State: TOwnerDrawState);
var
CenterText: integer;
begin
listboxProjectFiles.Canvas.FillRect(Rect);
ImageList1.Draw(listboxProjectFiles.Canvas, Rect.Left + 4, Rect.Top + 4, 5);
CenterText := (Rect.Bottom - Rect.Top - listboxProjectFiles.Canvas.TextHeight(text)) div 2;
listboxProjectFiles.Canvas.TextOut(Rect.left + ImageList1.Width + 8, Rect.Top + CenterText, listboxProjectFiles.Items.Strings[Index]);
end;
procedure TformMain.listboxProjectFilesMeasureItem(Control: TWinControl; Index: Integer; var Height: Integer);
begin
Height := 20;
end;
This produces the following result:
However, this example uses a fixed index number for the ImageList (Index = 5). How can I instead show the associated system image for each file type? (dpr, pas, dfm)
EDIT: I used the advice of @Amigojack and wrote this code:
procedure SetShellIcons;
var
FileInfo: SHFILEINFO;
NewIcon: TIcon;
begin
NewIcon := TIcon.Create;
try
SHGetFileInfo(PChar('C:\MyExistingFile.dpr'), 0, FileInfo, SizeOf(FileInfo), SHGFI_ICON or SHGFI_SMALLICON);
NewIcon.Handle := FileInfo.hIcon;
CodeSite.Send('SetFileIcons: NewIcon', NewIcon);
formMain.ilShellIcons.AddIcon(NewIcon);
DestroyIcon(FileInfo.hIcon);
finally
NewIcon.Free;
end;
end;
This works - but I have to provide an EXISTING file - '.DPR' does NOT work!. This forces me to create a new icon for each new file which is a waste of resources because it happens very often in my application. Instead, I would prefer to create the few icons I need at program-start and then use these icons throughout my application. So, how can I use '.DPR' with SHFILEINFO
instead of an existing file?
EDIT2: Now I use this code to effectively set the icons for the desired extensions at program start:
procedure TformMain.SetShellIcons;
var
FileInfo: Winapi.ShellAPI.SHFILEINFO;
NewIcon: TIcon;
function GetFileInfo(const aExt: string): Integer;
begin
Winapi.ShellAPI.SHGetFileInfo(PChar(aExt), FILE_ATTRIBUTE_NORMAL, FileInfo, SizeOf(FileInfo), SHGFI_ICON or SHGFI_SMALLICON or SHGFI_SYSICONINDEX or SHGFI_USEFILEATTRIBUTES);
NewIcon.Handle := FileInfo.hIcon;
Result := formMain.ilShellIcons.AddIcon(NewIcon);
end;
begin
NewIcon := TIcon.Create;
try
FIconIdx_DPR := GetFileInfo('*.dpr');
FIconIdx_PAS := GetFileInfo('*.pas');
FIconIdx_DFM := GetFileInfo('*.dfm');
finally
DestroyIcon(FileInfo.hIcon);
NewIcon.Free;
end;
end;
function TformMain.GetIconIdx(const aExtension: string): Integer;
begin
Result := -1;
if SameText(aExtension, '.DPR') then
Result := FIconIdx_DPR
else if SameText(aExtension, '.PAS') then
Result := FIconIdx_PAS
else if SameText(aExtension, '.DFM') then
Result := FIconIdx_DFM;
end;
procedure TformMain.listboxProjectFilesDrawItem(Control: TWinControl; Index: Integer; Rect: TRect; State: TOwnerDrawState);
var
CenterText: integer;
begin
listboxProjectFiles.Canvas.FillRect(Rect);
ilShellIcons.Draw(listboxProjectFiles.Canvas, Rect.Left + 4, Rect.Top + 4, GetIconIdx(ExtractFileExt(listboxProjectFiles.Items.Strings[Index])));
CenterText := (Rect.Bottom - Rect.Top - listboxProjectFiles.Canvas.TextHeight(text)) div 2 + 1;
listboxProjectFiles.Canvas.TextOut(Rect.left + ilShellIcons.Width + 8, Rect.Top + CenterText, listboxProjectFiles.Items.Strings[Index]);
end;