SHGetFileInfo produces icon with black background

Question

i have a problem with SHGetFileInfo. I am using FPC 2.6.2 with Lazarus 1.0.14, here is the code:

procedure x;
var
  FI: SHFILEINFO;
  icon: ticon;
begin
  SHGetFileInfo('app.exe', 0, FI, SizeOf(FI), SHGFI_SYSICONINDEX or SHGFI_ICON or SHGFI_LARGEICON);

  icon := TIcon.Create;
  icon.Handle := FI.hIcon;
  icon.SaveToFile('extracted.ico');
end;

The problem is it produces icon file with black background instead od transparent. Here is how it looks like:

http://i.imgur.com/5BF3xbT.jpg

When i compile the same code in Delphi, it works perfectly. Icon has transparent background.

I would appreciate if anyone could help me to solve this problem :-)

Answer 1

I have same problem time ago. LCL seems can't have full alpha support for TIcon, so you must use another similar component. I tried TKIcon and it works. You can find here http://www.tkweb.eu/en/delphicomp/kicon.html

I post a sample procedure to extract a icon. It is very simple.

procedure ExtractIconAndSave(xpath: string);
var
  FileInfo: SHFILEINFO;
  Icon: KIcon.TIcon; //Don't confused with Graphics.TIcon
begin
  //Get icon handle
  SHGetFileInfo(PChar(xpath), 0, FileInfo, SizeOf(FileInfo), SHGFI_SYSICONINDEX or SHGFI_ICON or SHGFI_LARGEICON);
  //Check if SHGetFileInfo get the icon handle
  if FileInfo.hIcon <> 0 then
  begin
    //Use kIcon's TIcon - It supports alpha 32bpp
    Icon := KIcon.TIcon.Create;
    try
      //Load icon handle in TKIcon and save it in a file
      Icon.LoadFromHandle(FileInfo.hIcon);
      Icon.SaveToFile('extracted.ico');
    finally
      DestroyIcon(FileInfo.hIcon);
      FreeAndNil(Icon);
    end;
  end;
end;