为何用 SHGetFileInfo 获取的文件图标，保存为图标文件后失真（颜色数减少了）？

Question

代码如下
---------------------------------------------------------------
unit Unit1;interfaceuses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls;type
  TForm1 = class(TForm)
    Button1: TButton;
    Edit1: TEdit;
    Button2: TButton;
    SaveDialog: TSaveDialog;
    OpenDialog: TOpenDialog;
    procedure Button2Click(Sender: TObject);
    procedure Button1Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;var
  Form1: TForm1;implementationuses ShellAPI;{$R *.dfm}function GetFileIcon(const FileName: string; SmallIcon: Boolean): HICON;
var
  Info: TSHFileInfo;
  Flag: Integer;
begin
  if SmallIcon then
    Flag := (SHGFI_SMALLICON or SHGFI_ICON) else
    Flag := (SHGFI_LARGEICON or SHGFI_ICON);
  SHGetFileInfo(PChar(FileName),0,Info,Sizeof(Info),Flag);
  Result := Info.hIcon;
end;procedure TForm1.Button2Click(Sender: TObject);
begin
  if SaveDialog.Execute then
    Edit1.Text := SaveDialog.FileName;
end;procedure TForm1.Button1Click(Sender: TObject);
var
  Ico: TIcon;
begin
  if OpenDialog.Execute then
  begin
    Ico := TIcon.Create;
    Ico.Handle := GetFileIcon(OpenDialog.FileName, False);
    Ico.SaveToFile(Edit1.Text);
    Ico.Free;
  end;
end;end.
-----------------------------------------------------------------------------
  object Button1: TButton
    Left = 24
    Top = 24
    Width = 161
    Height = 25
    Caption = '选择文件并保存图标为 ↓'
    TabOrder = 0
    OnClick = Button1Click
  end
  object Edit1: TEdit
    Left = 24
    Top = 64
    Width = 401
    Height = 22
    TabOrder = 1
    Text = 'Edit1'
  end
  object Button2: TButton
    Left = 432
    Top = 64
    Width = 75
    Height = 25
    Caption = '浏览(&R)...'
    TabOrder = 2
    OnClick = Button2Click
  end
  object SaveDialog: TSaveDialog
    Left = 296
    Top = 32
  end
  object OpenDialog: TOpenDialog
    Left = 224
    Top = 16
  end
------------------------将以上文本复制，并在一个空白窗体上粘贴就行

Answer 1

这个问题如果解决了，是很有用的，它可以获取任意文件的图标，包括可执行文件也包括 Windows 关联的图标。

Answer 2

你的代码可以取出WindowXP色彩图标

Answer 3

to postren(小虫):
32bit真彩色的图标取出后，变成了 256 色的了！
我在 Windows2000 上测试的是这样。

Answer 4

我系统是Windows Server 2003测试没问题那大概这个API是系统相关的吧

Answer 5

我想不应该是这个 API 函数的原因，应该是 SaveToFile 的原因，
因为我在窗体上放了一个 TImage ，然后把取出的图标显示在 Image 中，
在窗体上的图标颜色是正常的，但是
再用 Image 的 SaveToFile 保存到文件中，效果就变差了。
Button1 的修改后的代码如下：
procedure TForm1.Button1Click(Sender: TObject);
var
  Ico: TIcon;
begin
  if OpenDialog.Execute then
  begin
    Ico := TIcon.Create;
    Ico.Handle := GetFileIcon(OpenDialog.FileName, False);
    Ico.SaveToFile(Edit1.Text);
    Image1.Picture.Icon.Assign(Ico);
    Image1.Picture.SaveToFile(ExtractFilePath(Edit1.Text)+'Image1.ico');
    Image1.Picture.Icon.SaveToFile(ExtractFilePath(Edit1.Text)+'Image2.ico');
    Ico.Free;
  end;
end;

Answer 6

http://community.csdn.net/Expert/TopicView3.asp

Answer 7

这个连接才对
http://community.csdn.net/Expert/TopicView3.asp?id=4814219