Schwarzer Hintergrund bei Icons in Listview

[lazarusjulian]

Hallo,
es geht um dieses Thema:
http://forum.lazarus.freepascal.org/ind ... ic=24111.0

Bei einer Listview mit Icons welche per SHGetFileInfo geholt werden, ergibt sich ab Windows 8 und neuer ein schwarzer Hintergrund.
Die Lösung für dieses Problem war bisher die Verwendung von ImageList_ReplaceIcon aus der Windows Unit.
Leider wurde diese Methode aus Free Pascal entfernt. Siehe:
http://wiki.freepascal.org/User_Changes_2.2.4

Kennt Jemand eine existente Lösung?

Gruß Julian

[Socke]

Kennt Jemand eine existente Lösung?

Hallo Julian,

das steht dort im Wiki:

Remedy: Add the commdlg and/or commctrl unit(s) to your uses clause.

[lazarusjulian]

Ach Gott, danke. Wer lesen kann..
Leider ärgert es mich gerade noch damit, dass es ImageList.Handle nicht gibt

[six1]

Hi,
ich habe einen Type deklariert, welcher File extension, Beschreibung der Datei und das Icon in Stringlisten bzw ImageList enthält.
Wenn ein Fileicon benötigt wird, wird eine Routine aufgerufen, welche den Index auf die Listen zurück liefert.
Ist eine Dateiinformation noch nicht in der Liste, wird diese von der Routine den Listen zugefügt. Bei der nächsten Verwendung der Routine, für gleiche Dateiendung, müssen Die Infos nicht mehr vom System geladen werden, sondern sind in den Listen vorhanden.

Code: Alles auswählen

 
uses ...
       ,shellapi , LazUtils
 
type TSystemIconsList = record
   Imagelist:TImageList;
   FileExtension:TStringlist;
   FileDescription:TStringlist;
end;
 
...
private
    SystemIconsList:TSystemIconsList;
end;
 
 
procedure TForm1.FormDestroy(Sender: TObject);
begin
  SystemIconsList.Imagelist.Free;
  SystemIconsList.FileDescription.Free;
  SystemIconsList.FileExtension.Free;
end;
 
procedure TForm1.FormCreate(Sender: TObject);
begin
  SystemIconsList.Imagelist:=TImagelist.Create(Form1);
  SystemIconsList.Imagelist.Height:=36;
  SystemIconsList.Imagelist.Width:=40;
  SystemIconsList.Imagelist.BkColor:=clwhite;
  //SystemIconsList.Imagelist.DrawingStyle:=dsTransparent;
  //SystemIconsList.Imagelist.ImageType:=itImage;
  SystemIconsList.FileExtension:=TStringlist.Create;
  SystemIconsList.FileDescription:=TStringlist.Create;
End;
 
function TForm1.GetFileIcon(const AExt: string {File Extension}): integer;
var
  SFI: SHFileInfo;
  flags : dword;
  Icon_: TIcon;
  i:integer;
  Bmp:TBitmap;
begin
  result:=-1;
  for i := 0 to SystemIconsList.FileExtension.Count - 1 do begin
    if lowercase(AExt) = SystemIconsList.FileExtension[i] then begin
      result:=i;
      break;
    end;
  end;
  if result = -1 then
  begin
    // Extension wurde nicht gefunden, Icon laden
    ZeroMemory(@SFI, SizeOf(TSHFileInfo));
    Icon_ := TIcon.Create;
    if length(AExt) > 5 then
      // frage Icon für Ordner ab
      SHGetFileInfo(PChar(AExt), 0, SFI, SizeOf(TSHFileInfo), SHGFI_LARGEICON or SHGFI_ICON or SHGFI_TYPENAME)
    else
      SHGetFileInfo(PChar(AExt), $80, SFI, SizeOf(TSHFileInfo), SHGFI_LARGEICON or SHGFI_ICON or SHGFI_TYPENAME or SHGFI_USEFILEATTRIBUTES);
    Icon_.Handle := SFI.hIcon;
    SystemIconsList.Imagelist.BkColor:=1;
 
    Bmp:= TBitmap.Create;
    Bmp.Width:= SystemIconsList.Imagelist.Width;
    Bmp.Height:= SystemIconsList.Imagelist.Height;
    Bmp.Canvas.Brush.Style:= bsSolid;
    Bmp.Canvas.Brush.Color:= clwhite;//ImageList.BkColor;
    Bmp.Canvas.FillRect(0, 0, Bmp.Width, Bmp.Height);
    Bmp.Canvas.Draw(0, 0, Icon_);
 
    result:= SystemIconsList.Imagelist.Add(Bmp ,nil);
    bmp.free;
    SystemIconsList.FileDescription.add( CP1252toUTF8( sfi.szTypeName));
    SystemIconsList.FileExtension.add( lowercase(AExt));
    result:=SystemIconsList.FileExtension.Count-1;
    Icon_.Free;
  end;
end;