SHGetFileInfo produces icon with black background - icons

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;