Associate files and icons, in Listview

[Ericktux]

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.

[Remy Lebeau]

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) .

[Ericktux]

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]

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.

[Fungus]

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).

[Ericktux]

thanks to all, this works fine with transparency   

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.

[Ed78z]

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????

[balazsszekely]

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.