SHGetFileInfo under Win XP

[MBulu]

Hi, i have found this code (Delphi) to extract icon from files EXE. Why it don't works in Lazarus?



procedure TForm1.Button1Click(Sender: TObject);
var
  Icon: TIcon;
  FileInfo: SHFILEINFO;
begin
  Icon := TIcon.Create;
  try
    // Get the Icon
    SHGetFileInfo(PChar('Filename.exe'), 0, FileInfo, SizeOf(FileInfo),
SHGFI_ICON);
    icon.Handle := FileInfo.hIcon;

    DestroyIcon(FileInfo.hIcon);
    // Save the Icon to a file:
    icon.SaveToFile('IconFromExe.ico');
    // Set the Icon as Application Icon (temporary)
    Application.Icon := icon;

  finally
    Icon.Free;
  end;
end;

[Vincent Snijders]

This code doesn't work yet:
 // Set the Icon as Application Icon (temporary)
Application.Icon := icon;

[Anonymous]

This code doesn't work yet:
 // Set the Icon as Application Icon (temporary)
Application.Icon := icon;

Probably also this:
// Save the Icon to a file:
icon.SaveToFile('IconFromExe.ico');

If i use that code, the file produced have 0 bytes, so i've thinked that the problem was in the SHGetFileInfo

[greymfm]

The problem is that TIcon currently cannot cope with handles (TIcon.setHandles is not yet implemented => TIcon.LoadFromBitmapHandles fails).

You can work around with a TBitmap:

uses
  ... Graphics, Windows, ShellApi, ...

function TForm1.GetFileInfosFromExt(const AExt: string; const GetSmallIcon : boolean; var anIcon : TIcon; out aDescr, aTypeName : string): boolean;
var
  SFI: SHFileInfo;
  flags : dword;
  myIconInfo: TIconInfo;
  winBitmap: windows.TBitmap;
  aBmp : graphics.TBitmap;
begin
  result:=false;
  if GetSmallIcon then
    flags:=SHGFI_SMALLICON
  else
    flags:=SHGFI_LARGEICON;
  flags:=flags or SHGFI_ICON or SHGFI_USEFILEATTRIBUTES or SHGFI_DISPLAYNAME or SHGFI_TYPENAME;
  if SHGetFileInfo(PChar(AExt), $80, SFI, SizeOf(SHFileInfo), flags)<>0 then // Windows FILE_ATTRIBUTE_NORMAL=$80
  begin
    if (assigned(anIcon)) and (sfi.hIcon <> 0) and (GetIconInfo(sfi.hIcon, myIconInfo)) then
    begin
        aBmp := graphics.TBitmap.Create;
        aBmp.LoadFromBitmapHandles(myIconInfo.hbmColor, myIconInfo.hbmMask, nil); // @r
        anIcon.Assign(aBMP); // there is no other way for TIcons - you MUST use a Bitmap, as it has implemented "Handles"-handling (setHandles)
        // TIcons themselves cannot cope with handles
        aBmp.Free;
    end;
    aDescr := sfi.szDisplayName;
    aTypeName := sfi.szTypeName;
    result:=true;
  end;
end;

[bonmario]

You can work around with a TBitmap:

I've used your code and it works, but how can change the background color of the icon? It's black and i want it "transparent". It's possible change that color?

See the attached image

Thanks, Mario