Forum > Win32/64
Associate files and icons, in Listview
Ericktux:
Hi my friends, i use this code for associate files and icons:
--- Code: Pascal [+][-]window.onload = function(){var x1 = document.getElementById("main_content_section"); if (x1) { var x = document.getElementsByClassName("geshi");for (var i = 0; i < x.length; i++) { x[i].style.maxHeight='none'; x[i].style.height = Math.min(x[i].clientHeight+15,306)+'px'; x[i].style.resize = "vertical";}};} ---unit Unit1; {$mode objfpc}{$H+} interface uses windows, ShellApi, Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs, ComCtrls, StdCtrls, LazUTF8; type { TForm1 } TForm1 = class(TForm) Button1: TButton; ImageList1: TImageList; ListView1: TListView; procedure Button1Click(Sender: TObject); private { private declarations } public { public declarations } end; var Form1: TForm1; implementation {$R *.lfm} { TForm1 } procedure TForm1.Button1Click(Sender: TObject);var spath: string; SysStr: Widestring; i: integer; mIcon: TIcon; SearchRec: TSearchRec; ListItem: TListItem; FileInfo: SHFILEINFOw;begin sPath := 'C:\Files'; // ejem: "f:" ó "sPath := 'C:\Documents and Settings\Propietario\Recent'"; if sPath[Length(sPath)]<>'\' then sPath := sPath+'\'; // agregar el slash si es ncesario ListView1.SmallImages := ImageList1; ListView1.ViewStyle := vsReport; ListView1.Columns.Add; ListView1.Columns.Add; mIcon := TIcon.Create; try ListView1.Items.BeginUpdate; i := FindFirst(sPath + '*.*', faAnyFile, SearchRec); while i = 0 do begin application.ProcessMessages; with ListView1 do begin //if ((SearchRec.Attr and FaDirectory <> FaDirectory) and (SearchRec.Attr and FaVolumeId <> FaVolumeID)) then // for only files If (SearchRec.Name<>'.') and (SearchRec.Name<>'..') then Begin // ShowMessage(sPath+SR.Name); // mostrar el archivo encontrado ejem: f:\casas\hola.txt SR.Name=hola.txt SysStr:=UTF16ToUTF8(sPath + SearchRec.Name); ListItem := ListView1.Items.add; SHGetFileInfo(PwideChar(SysStr), 0, FileInfo, SizeOf(FileInfo), SHGFI_DISPLAYNAME); Listitem.Caption := UTF16ToUTF8(FileInfo.szDisplayName); SHGetFileInfo(PwideChar(SysStr), 0, FileInfo, SizeOf(FileInfo), SHGFI_TYPENAME); ListItem.SubItems.Add(UTF16ToUTF8(FileInfo.szTypeName)); SHGetFileInfo(PwideChar(SysStr), 0, FileInfo, SizeOf(FileInfo), SHGFI_ICON or SHGFI_SMALLICON); mIcon.Handle := FileInfo.hIcon; ListItem.ImageIndex := ImageList1.AddIcon(mIcon); end; end; i := FindNext(SearchRec); end; finally ListView1.items.EndUpdate; mIcon.Free; end;end; end.
Work Fine :) (also with "Ñ" and tildes) :)
But why some icons has black background and nontransparent ?? :( :(
PD: attached code and images.
Remy Lebeau:
--- Quote from: Ericktux on October 12, 2016, 04:08:52 am ---Hi my friends, i use this code for associate files and icons:
--- End quote ---
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 [+][-]window.onload = function(){var x1 = document.getElementById("main_content_section"); if (x1) { var x = document.getElementsByClassName("geshi");for (var i = 0; i < x.length; i++) { x[i].style.maxHeight='none'; x[i].style.height = Math.min(x[i].clientHeight+15,306)+'px'; x[i].style.resize = "vertical";}};} ---procedure TForm1.Button1Click(Sender: TObject);var sPath: string; SysStr: WideString; i: Integer; SearchRec: TSearchRec; ListItem: TListItem; FileInfo: SHFILEINFOW;begin sPath := 'C:\Files'; // ejem: "f:" ó "sPath := 'C:\Documents and Settings\Propietario\Recent'"; if sPath[Length(sPath)] <> '\' then sPath := sPath+'\'; // agregar el slash si es ncesario // better: // sPath := IncludeTrailingPathDelimiter(sPath); ImageList1.SharedImages := True; ImageList1.Handle := SHGetFileInfo('', 0, FileInfo, SizeOf(FileInfo), SHGFI_SYSICONINDEX or SHGFI_SMALLICON); ListView1.SmallImages := ImageList1; ListView1.ViewStyle := vsReport; ListView1.Columns.Add; ListView1.Columns.Add; i := FindFirst(sPath + '*.*', faAnyFile, SearchRec); if i = 0 then try ListView1.Items.BeginUpdate; try repeat Application.ProcessMessages; //if ((SearchRec.Attr and FaDirectory <> FaDirectory) and (SearchRec.Attr and FaVolumeId <> FaVolumeID)) then // for only files if (SearchRec.Name <> '.') and (SearchRec.Name <> '..') then begin // ShowMessage(sPath+SR.Name); // mostrar el archivo encontrado ejem: f:\casas\hola.txt SR.Name=hola.txt SysStr := UTF8ToUTF16(sPath + SearchRec.Name); SHGetFileInfoW(PWideChar(SysStr), 0, FileInfo, SizeOf(FileInfo), SHGFI_DISPLAYNAME or SHGFI_TYPENAME or SHGFI_SYSICONINDEX or SHGFI_SMALLICON); ListItem := ListView1.Items.Add; Listitem.Caption := UTF16ToUTF8(FileInfo.szDisplayName); ListItem.SubItems.Add(UTF16ToUTF8(FileInfo.szTypeName)); ListItem.ImageIndex := FileInfo.iIcon; end; i := FindNext(SearchRec); until i <> 0; finally ListView1.Items.EndUpdate; end; finally FindClose(SearchRec); end;end;
--- Quote from: Ericktux on October 12, 2016, 04:08:52 am ---But why some icons has black background and nontransparent ?? :( :(
--- End quote ---
See Icon from shell in TImageList, black background (solved) .
Ericktux:
Thank for help me :) , but get this error: :( :(
In:
--- Code: Pascal [+][-]window.onload = function(){var x1 = document.getElementById("main_content_section"); if (x1) { var x = document.getElementsByClassName("geshi");for (var i = 0; i < x.length; i++) { x[i].style.maxHeight='none'; x[i].style.height = Math.min(x[i].clientHeight+15,306)+'px'; x[i].style.resize = "vertical";}};} ---ImageList1.Handle:= SHGetFileInfo('', 0, FileInfo, SizeOf(FileInfo), SHGFI_SYSICONINDEX or SHGFI_SMALLICON);
Show error:
--- Code: Pascal [+][-]window.onload = function(){var x1 = document.getElementById("main_content_section"); if (x1) { var x = document.getElementsByClassName("geshi");for (var i = 0; i < x.length; i++) { x[i].style.maxHeight='none'; x[i].style.height = Math.min(x[i].clientHeight+15,306)+'px'; x[i].style.resize = "vertical";}};} ---unit1.pas(51,20) Error: No member is provided to access property
Remy Lebeau:
--- Quote from: Ericktux on October 12, 2016, 05:01:14 am ---In:
--- Code: Pascal [+][-]window.onload = function(){var x1 = document.getElementById("main_content_section"); if (x1) { var x = document.getElementsByClassName("geshi");for (var i = 0; i < x.length; i++) { x[i].style.maxHeight='none'; x[i].style.height = Math.min(x[i].clientHeight+15,306)+'px'; x[i].style.resize = "vertical";}};} ---ImageList1.Handle:= SHGetFileInfo('', 0, FileInfo, SizeOf(FileInfo), SHGFI_SYSICONINDEX or SHGFI_SMALLICON);
Show error:
--- Code: Pascal [+][-]window.onload = function(){var x1 = document.getElementById("main_content_section"); if (x1) { var x = document.getElementsByClassName("geshi");for (var i = 0; i < x.length; i++) { x[i].style.maxHeight='none'; x[i].style.height = Math.min(x[i].clientHeight+15,306)+'px'; x[i].style.resize = "vertical";}};} ---unit1.pas(51,20) Error: No member is provided to access property
--- End quote ---
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 [+][-]window.onload = function(){var x1 = document.getElementById("main_content_section"); if (x1) { var x = document.getElementsByClassName("geshi");for (var i = 0; i < x.length; i++) { x[i].style.maxHeight='none'; x[i].style.height = Math.min(x[i].clientHeight+15,306)+'px'; x[i].style.resize = "vertical";}};} ---//Load iconBmp:= TBitmap.Create;Bmp.Width:= ImageList.Width;Bmp.Height:= ImageList.Height;Bmp.Canvas.Brush.Style:= bsSolid;Bmp.Canvas.Brush.Color:= ImageList.BkColor;Bmp.Canvas.FillRect(0, 0, Bmp.Width, Bmp.Height);Bmp.Canvas.Draw(0, 0, TheIcon);ImageList.Add(Bmp);//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).
Navigation
[0] Message Index
[#] Next page