2 years ago

#64842

test-img

user1580348

In a TListBox containing filenames , how to use the associated small system image for each item file type?

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;

delphi

ownerdrawn

delphi-11-alexandria

tlistbox

0 Answers

Your Answer

Accepted video resources