0

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:

enter image description here

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;
user1580348
  • 5,721
  • 4
  • 43
  • 105
  • 1
    Like this: https://stackoverflow.com/questions/31805944/how-to-get-the-default-system-icon-for-a-drive-a-device-or-a-file – Andreas Rejbrand Jan 18 '22 at 11:25
  • @AndreasRejbrand isn't that for non-files only? As [for filename extensions `SHGetFileInfo()`](https://stackoverflow.com/q/829843/4299358) does most of the job. And exactly like OP asked (which implies not digging for resources to display i.e. each EXE's individual icon). – AmigoJack Jan 18 '22 at 11:50
  • @AmigoJack: No. Read the Q. – Andreas Rejbrand Jan 18 '22 at 12:02
  • 1
    My linked A explains to literally use `*.ext` as filename. @AndreasRejbrand I read the Q and you remain wrong unless you have an example on how to get a DPR file icon using `SHGetStockIconInfo()`. Or was your intention to link to the Q only, without any A? – AmigoJack Jan 18 '22 at 13:08
  • @AmigoJack: Yes. I was looking at the code block in the Q by Guybrush. It uses `SHGetFileInfo` which I think is a good idea here. And my link *is* to a Q, not to an A! – Andreas Rejbrand Jan 18 '22 at 13:09
  • It was a long URI as seen in the address when viewing a Q. Since it didn't have the short form which can be optained from the "Share" link I interpreted it as not _only_ linking to the Q, but to linking to everything. Even your "read the Q" is too ambiguous - it should have been either "read _this_ Q (here)" or "read _that_ (linked) Q". – AmigoJack Jan 18 '22 at 13:20
  • @AmigoJack Ah, I see. To use an extension only, the correct bit pattern must be used: `SHGFI_ICON or SHGFI_SMALLICON or SHGFI_SYSICONINDEX or SHGFI_USEFILEATTRIBUTES`. Now it works. – user1580348 Jan 18 '22 at 14:55
  • You do not need to create any new icons at all. Drop an imagelist on the form named sysimages and use `sysimages.Handle := SHGetFileInfo('', 0, SFI, SizeOf(SFI), SHGFI_SYSICONINDEX OR SHGFI_SMALLICON);` in FormCreate to obtain a copy of the system images list. You can use this imagelist like any other imagelist. Use `SHGetFileInfo('anyfile.dpr', 0, SFI, SizeOf(TSHFileInfo), SHGFI_SYSICONINDEX OR SHGFI_SMALLICON);` to obtain the icon index in this list in `SFI.iicon`. SFI is of type TSHFileInfo. – Andre Ruebel Jan 18 '22 at 20:17
  • @AndreRuebel Your solution doesn't work for me. For me your solution populates image list with only 7 icons. – SilverWarior Jan 19 '22 at 08:15
  • @SilverWarior Strange, this still works for me, however using Seattle. Could this be related that Delphi does not use native Windows imagelists anymore? – Andre Ruebel Jan 19 '22 at 20:51

0 Answers0