Recent

Author Topic: Associate files and icons, in Listview  (Read 7960 times)

Ericktux

  • Full Member
  • ***
  • Posts: 242
Associate files and icons, in Listview
« on: October 12, 2016, 04:08:52 am »
Hi my friends, i use this code for associate files and icons:

Code: Pascal  [Select][+][-]
  1. unit Unit1;
  2.  
  3. {$mode objfpc}{$H+}
  4.  
  5. interface
  6.  
  7. uses
  8.   windows, ShellApi, Classes, SysUtils, FileUtil, Forms, Controls, Graphics,
  9.   Dialogs, ComCtrls, StdCtrls, LazUTF8;
  10.  
  11. type
  12.  
  13.   { TForm1 }
  14.  
  15.   TForm1 = class(TForm)
  16.     Button1: TButton;
  17.     ImageList1: TImageList;
  18.     ListView1: TListView;
  19.     procedure Button1Click(Sender: TObject);
  20.   private
  21.     { private declarations }
  22.   public
  23.     { public declarations }
  24.   end;
  25.  
  26. var
  27.   Form1: TForm1;
  28.  
  29. implementation
  30.  
  31. {$R *.lfm}
  32.  
  33. { TForm1 }
  34.  
  35. procedure TForm1.Button1Click(Sender: TObject);
  36. var
  37.   spath: string;
  38.   SysStr: Widestring;
  39.   i: integer;
  40.   mIcon: TIcon;
  41.   SearchRec: TSearchRec;
  42.   ListItem: TListItem;
  43.   FileInfo: SHFILEINFOw;
  44. begin
  45.  
  46.   sPath := 'C:\Files';  // ejem:  "f:"   ó   "sPath := 'C:\Documents and Settings\Propietario\Recent'";
  47.   if sPath[Length(sPath)]<>'\' then sPath := sPath+'\';  // agregar el slash si es ncesario
  48.   ListView1.SmallImages := ImageList1;
  49.   ListView1.ViewStyle := vsReport;
  50.   ListView1.Columns.Add;
  51.   ListView1.Columns.Add;
  52.   mIcon := TIcon.Create;
  53.   try
  54.     ListView1.Items.BeginUpdate;
  55.     i := FindFirst(sPath + '*.*', faAnyFile, SearchRec);
  56.     while i = 0 do
  57.       begin
  58.         application.ProcessMessages;
  59.         with ListView1 do
  60.         begin
  61.         //if ((SearchRec.Attr and FaDirectory <> FaDirectory) and (SearchRec.Attr and FaVolumeId <> FaVolumeID)) then   // for only files
  62.         If (SearchRec.Name<>'.') and (SearchRec.Name<>'..') then
  63.           Begin
  64.           // ShowMessage(sPath+SR.Name);   // mostrar el archivo encontrado ejem:     f:\casas\hola.txt     SR.Name=hola.txt
  65.           SysStr:=UTF16ToUTF8(sPath + SearchRec.Name);
  66.           ListItem := ListView1.Items.add;
  67.           SHGetFileInfo(PwideChar(SysStr), 0, FileInfo, SizeOf(FileInfo), SHGFI_DISPLAYNAME);
  68.           Listitem.Caption := UTF16ToUTF8(FileInfo.szDisplayName);
  69.           SHGetFileInfo(PwideChar(SysStr), 0, FileInfo, SizeOf(FileInfo), SHGFI_TYPENAME);
  70.           ListItem.SubItems.Add(UTF16ToUTF8(FileInfo.szTypeName));
  71.           SHGetFileInfo(PwideChar(SysStr), 0, FileInfo, SizeOf(FileInfo), SHGFI_ICON or SHGFI_SMALLICON);
  72.           mIcon.Handle := FileInfo.hIcon;
  73.           ListItem.ImageIndex := ImageList1.AddIcon(mIcon);
  74.         end;
  75.  
  76.       end;
  77.       i := FindNext(SearchRec);
  78.     end;
  79.   finally
  80.     ListView1.items.EndUpdate;
  81.     mIcon.Free;
  82.   end;
  83. end;
  84.  
  85. end.

Work Fine  :) (also with "Ñ" and tildes)  :)
But why some icons has black background and nontransparent ??   :( :(

PD: attached code and images.






« Last Edit: October 12, 2016, 04:11:28 am by Ericktux »

Remy Lebeau

  • Hero Member
  • *****
  • Posts: 1021
    • Lebeau Software
Re: Associate files and icons, in Listview
« Reply #1 on: October 12, 2016, 04:39:51 am »
Hi my friends, i use this code for associate files and icons:

You are not using SHGetFileInfo() very effectively.  The code you showed can be simplified to something more like the following (I'm assuming FreePascal's TImageList works similarly to Delphi's):

Code: Pascal  [Select][+][-]
  1. procedure TForm1.Button1Click(Sender: TObject);
  2. var
  3.   sPath: string;
  4.   SysStr: WideString;
  5.   i: Integer;
  6.   SearchRec: TSearchRec;
  7.   ListItem: TListItem;
  8.   FileInfo: SHFILEINFOW;
  9. begin
  10.   sPath := 'C:\Files';  // ejem:  "f:"   ó   "sPath := 'C:\Documents and Settings\Propietario\Recent'";
  11.  
  12.   if sPath[Length(sPath)] <> '\' then sPath := sPath+'\';  // agregar el slash si es ncesario
  13.   // better:
  14.   // sPath := IncludeTrailingPathDelimiter(sPath);
  15.  
  16.   ImageList1.SharedImages := True;
  17.   ImageList1.Handle := SHGetFileInfo('', 0, FileInfo, SizeOf(FileInfo), SHGFI_SYSICONINDEX or SHGFI_SMALLICON);
  18.  
  19.   ListView1.SmallImages := ImageList1;
  20.   ListView1.ViewStyle := vsReport;
  21.   ListView1.Columns.Add;
  22.   ListView1.Columns.Add;
  23.  
  24.   i := FindFirst(sPath + '*.*', faAnyFile, SearchRec);
  25.   if i = 0 then
  26.   try
  27.     ListView1.Items.BeginUpdate;
  28.     try
  29.       repeat
  30.         Application.ProcessMessages;
  31.         //if ((SearchRec.Attr and FaDirectory <> FaDirectory) and (SearchRec.Attr and FaVolumeId <> FaVolumeID)) then   // for only files
  32.         if (SearchRec.Name <> '.') and (SearchRec.Name <> '..') then
  33.         begin
  34.           // ShowMessage(sPath+SR.Name);   // mostrar el archivo encontrado ejem:     f:\casas\hola.txt     SR.Name=hola.txt
  35.           SysStr := UTF8ToUTF16(sPath + SearchRec.Name);
  36.           SHGetFileInfoW(PWideChar(SysStr), 0, FileInfo, SizeOf(FileInfo), SHGFI_DISPLAYNAME or SHGFI_TYPENAME or SHGFI_SYSICONINDEX or SHGFI_SMALLICON);
  37.           ListItem := ListView1.Items.Add;
  38.           Listitem.Caption := UTF16ToUTF8(FileInfo.szDisplayName);
  39.           ListItem.SubItems.Add(UTF16ToUTF8(FileInfo.szTypeName));
  40.           ListItem.ImageIndex := FileInfo.iIcon;
  41.         end;
  42.         i := FindNext(SearchRec);
  43.       until i <> 0;
  44.     finally
  45.       ListView1.Items.EndUpdate;
  46.     end;
  47.   finally
  48.     FindClose(SearchRec);
  49.   end;
  50. end;
  51.  

But why some icons has black background and nontransparent ??   :( :(

See Icon from shell in TImageList, black background (solved) .
Remy Lebeau
Lebeau Software - Owner, Developer
Internet Direct (Indy) - Admin, Developer (Support forum)

Ericktux

  • Full Member
  • ***
  • Posts: 242
Re: Associate files and icons, in Listview
« Reply #2 on: October 12, 2016, 05:01:14 am »
Thank for help me  :) , but get this error:  :( :(

In:
Code: Pascal  [Select][+][-]
  1. ImageList1.Handle:= SHGetFileInfo('', 0, FileInfo, SizeOf(FileInfo), SHGFI_SYSICONINDEX or SHGFI_SMALLICON);

Show error:
Code: Pascal  [Select][+][-]
  1. unit1.pas(51,20) Error: No member is provided to access property


Remy Lebeau

  • Hero Member
  • *****
  • Posts: 1021
    • Lebeau Software
Re: Associate files and icons, in Listview
« Reply #3 on: October 12, 2016, 08:00:59 pm »
In:
Code: Pascal  [Select][+][-]
  1. ImageList1.Handle:= SHGetFileInfo('', 0, FileInfo, SizeOf(FileInfo), SHGFI_SYSICONINDEX or SHGFI_SMALLICON);

Show error:
Code: Pascal  [Select][+][-]
  1. unit1.pas(51,20) Error: No member is provided to access property

Apparently the TImageList.Handle property is read-only in FreePascal.  It is read/write in Delphi.  I don't know how to assign an HIMAGELIST handle to a TImageList in FreePascal.  But if you can figure out it, your code will be better for it.
Remy Lebeau
Lebeau Software - Owner, Developer
Internet Direct (Indy) - Admin, Developer (Support forum)

Fungus

  • Sr. Member
  • ****
  • Posts: 352
Re: Associate files and icons, in Listview
« Reply #4 on: October 12, 2016, 08:54:26 pm »
It you cannot assign the image list handle, you must set the width and height of the image list to the size of small icons (usually 16x16). Then you need to set a BkColor (used for transparency) for the image list - use a color rarely used, like 1 (ImageList.BkColor:= 1). Whenever you need to add an icon to the list you load it as you did in the first post and then you paint it onto a bitmap with the correct size and background, and paint the icon onto that and add it to the ImageList:

Code: Pascal  [Select][+][-]
  1. //Load icon
  2. Bmp:= TBitmap.Create;
  3. Bmp.Width:= ImageList.Width;
  4. Bmp.Height:= ImageList.Height;
  5. Bmp.Canvas.Brush.Style:= bsSolid;
  6. Bmp.Canvas.Brush.Color:= ImageList.BkColor;
  7. Bmp.Canvas.FillRect(0, 0, Bmp.Width, Bmp.Height);
  8. Bmp.Canvas.Draw(0, 0, TheIcon);
  9. ImageList.Add(Bmp);
  10. //Release icon

This should ensure the correct transparency for all icons. When you do this you need to set ImageList.ShareImages to false in order to let the image list free the added bitmaps on destruction.

EDIT: Alternately you can create a custom draw event for the list view and draw the images from the shell-imagelist with ImageList_Draw. Or you can use the ImageList_Draw with the bitmap sollution above (I think it is faster than loading individual icons).
« Last Edit: October 12, 2016, 09:09:48 pm by Fungus »

Ericktux

  • Full Member
  • ***
  • Posts: 242
Re: Associate files and icons, in Listview
« Reply #5 on: October 14, 2016, 05:04:23 am »
thanks to all, this works fine with transparency   :D :D

Code: Pascal  [Select][+][-]
  1. unit Unit1;
  2.  
  3. {$mode objfpc}{$H+}
  4.  
  5. interface
  6.  
  7. uses
  8.   windows, ShellApi, Classes, SysUtils, FileUtil, Forms, Controls, Graphics,
  9.   Dialogs, ComCtrls, StdCtrls, LazUTF8, CommCtrl;
  10.  
  11. type
  12.  
  13.   { TForm1 }
  14.  
  15.   TForm1 = class(TForm)
  16.     Button1: TButton;
  17.     ImageList1: TImageList;
  18.     ListView1: TListView;
  19.     procedure Button1Click(Sender: TObject);
  20.   private
  21.     { private declarations }
  22.   public
  23.     { public declarations }
  24.   end;
  25.  
  26. var
  27.   Form1: TForm1;
  28.  
  29. implementation
  30.  
  31. {$R *.lfm}
  32.  
  33. { TForm1 }
  34.  
  35. procedure TForm1.Button1Click(Sender: TObject);
  36. var
  37.   spath: string;
  38.   SysStr: Widestring;
  39.   i: integer;
  40.   mIcon: TIcon;
  41.   SearchRec: TSearchRec;
  42.   ListItem: TListItem;
  43.   FileInfo: SHFILEINFOw;
  44. begin
  45.  
  46.   sPath := 'C:\Files';  // ejem:  "f:"   ó   "sPath := 'C:\Documents and Settings\Propietario\Recent'";
  47.   if sPath[Length(sPath)]<>'\' then sPath := sPath+'\';  // agregar el slash si es ncesario
  48.   ListView1.SmallImages := ImageList1;
  49.   ListView1.ViewStyle := vsReport;
  50.   ListView1.Columns.Add;
  51.   ListView1.Columns.Add;
  52.   mIcon := TIcon.Create;
  53.   //mIcon.Transparent:=true;
  54.   try
  55.     ListView1.Items.BeginUpdate;
  56.     i := FindFirst(sPath + '*.*', faAnyFile, SearchRec);
  57.     while i = 0 do
  58.       begin
  59.         application.ProcessMessages;
  60.         with ListView1 do
  61.         begin
  62.         //if ((SearchRec.Attr and FaDirectory <> FaDirectory) and (SearchRec.Attr and FaVolumeId <> FaVolumeID)) then   // for only files
  63.         If (SearchRec.Name<>'.') and (SearchRec.Name<>'..') then
  64.           Begin
  65.           // ShowMessage(sPath+SR.Name);   // mostrar el archivo encontrado ejem:     f:\casas\hola.txt     SR.Name=hola.txt
  66.           SysStr := UTF8ToUTF16(sPath + SearchRec.Name);
  67.           SHGetFileInfoW(PWideChar(SysStr), 0, FileInfo, SizeOf(FileInfo), SHGFI_DISPLAYNAME or SHGFI_TYPENAME or SHGFI_ICON or SHGFI_SMALLICON);
  68.           ListItem := ListView1.Items.Add;
  69.           Listitem.Caption := UTF16ToUTF8(FileInfo.szDisplayName);
  70.           ListItem.SubItems.Add(UTF16ToUTF8(FileInfo.szTypeName));
  71.           mIcon.Handle := FileInfo.hIcon;
  72.  
  73.           ListItem.ImageIndex := ImageList1.AddIcon(mIcon); // original
  74.           ListItem.ImageIndex := ImageList_ReplaceIcon(ImageList1.Handle, ListItem.ImageIndex, micon.Handle);
  75.         end;
  76.  
  77.       end;
  78.       i := FindNext(SearchRec);
  79.     end;
  80.   finally
  81.     ListView1.items.EndUpdate;
  82.     mIcon.Free;
  83.   end;
  84. end;
  85.  
  86. end.




Aqdam1978@yahoo.com

  • New Member
  • *
  • Posts: 13
Re: Associate files and icons, in Listview
« Reply #6 on: September 07, 2021, 04:35:58 am »
I just check the code, it's still showing error since there is no HANDLE property available for the ImageList. How you did claim that code works fine????

GetMem

  • Hero Member
  • *****
  • Posts: 3514
Re: Associate files and icons, in Listview
« Reply #7 on: September 07, 2021, 06:33:00 am »
How you did claim that code works fine????

When the OP posted the code it worked fine, since then things has changed. Instead of  ImageList1.Handle try:
 
Code: Pascal  [Select][+][-]
  1.  ImageList1.ResolutionByIndex[0].Reference.Handle

or even better
 
Code: Pascal  [Select][+][-]
  1. ImageList1.ReferenceForPPI[0, Font.PixelsPerInch].Handle

 and make sure CommCtrl is in the uses list.

With that said OP's code is very slow, just search the forum, there are much faster solutions available.

 

TinyPortal © 2005-2018