Question

我有SHGetFileInfo的问题。我正在使用FPC 2.6.2和Lazarus 1.0.14，这是代码：

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;

问题是它生成带黑色背景的图标文件而不是透明。这是它的样子：

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

当我在Delphi中编译相同的代码时，它完美地运行。图标具有透明背景。

如果有人能帮助我解决这个问题，我将不胜感激： - ）

Answer 1

我以前遇到同样的问题。 LCL似乎不能完全支持TIcon，因此您必须使用其他类似的组件。我尝试过TKIcon并且它有效。你可以在这里找到http://www.tkweb.eu/en/delphicomp/kicon.html

我发布了一个示例程序来提取图标。这很简单。

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;

SHGetFileInfo生成带有黑色背景的图标

1 个答案: