难题：为什么delphi保存出来的ICO都是16色？如果你能解决，至少可以得到600分！！(300分)

我使用下面的方法提取dll中的图标：
image1.picture.icon.Handle:=ExtractIcon(hInstance,'c:/windows/system/shell32.dll',4);
image1.picture.icon.savetofile('C:/1.ico');
可原本是256色的图标变成了16色，怎么才能使保存出来的ICO使用原来的颜色数呢？
我是初学者，请各位高手帮忙。谢谢。
你只要解决了这个问题，除了本题的300分，还有许多相同问题的分都是你的啦！
LID
593378 200分
507223 100分


下面是电脑爱好者上的一篇文章，也许对大家有点帮助。

用VB6制作图标提取器
--------------------- 1 ------------------------
Dim ICONSS, tt, JISHU
DIM fNAME As String

Private Sub Command1_Click()
'本按钮用来选定二进制文件
'并且调用图标个数判断和提取过程
Co1.FileName = ""
Co1.Filter = "二进制文件|*.exe;*.dll;*.ocx"
Co1.ShowOpen
If Co1.FileName = "" Then Exit Sub
fNAME = Co1.FileName'向图标提取过程传递被提取文件名参数
Lis fNAME ’图标个数判断和提取
End Sub

Private Sub Command2_Click()
'本过程生成并且保存图标文件
With Co1
.FileName = ""
.Filter = "图标文件(*.ico)|*.ico"
.ShowSave
End With
If Co1.FileName = "" Then
Exit Sub
End If
SavePicture Pic1.Picture, Co1.FileName
'利用SavePicture保存图标
End Sub

Private Sub Command3_Click()
'本按钮控制软件的退出
Unload Me
End Sub

Private Sub Form_Unload(Cancel As Integer)
End '退出程序
End Sub

Private Sub Lis(fNAME As String)
'本过程用来判断选定文件所含图标个数
'它需要一个文件名作为参数
'并且生成第一个图标
Dim I As Integer, I1 As Integer, I2 As Integer
ICONSS = ExtractIcon(1, fNAME, -1)
Check1.Caption = "选定文件(" & fNAME + ")含图标:" & ICONSS & "个"
'显示图标个数
If ICONSS < 1 Then
'如果没有图标那么退出函数
Command2.Enabled = False
Exit Sub
Else
With HS
Command2.Enabled = True
If ICONSS = 1 Then
'如果只有一个图标
.Min = 1
.Max = 1
.Value = 1
Else
'如果多于一个图标
.Min = 1
.Max = ICONSS
.Value = 1
End If
fenli fNAME, 0
'调用图标创建函数
End With
End If
End Sub

Private Sub Form_Load()
Me.Caption = App.Title &amp; "为《电脑爱好者投稿》 版本 " &amp; App.Major _
&amp; "." &amp; App.Minor &amp; "." &amp; App.Revision
'添加应用程序标题和版本号
Me.Left = (Screen.Width - Me.Width) / 2
Me.Top = (Screen.Height - Me.Height) / 2
'窗体位置居中
Check1.Caption = "!请通过浏览选择一个可执行文件或者动态链接库文件!"
Command2.Enabled = False
End Sub

Private Sub fenli(allfname As String, va As Integer)
'图标创建过程
Dim myicon As Long
Dim Y As Long
Dim oopp As IPictureDisp
Dim dddd As ICONINFO
myicon = ExtractIcon(0, allfname, va)
'读出一个图标
GetIconInfo myicon, dddd
'获得图标信息
Y = CreateIconIndirect(dddd)
Set oopp = IconToPicture(Y)
'重新创建一个图标
Pic1.Picture = oopp
'将创建完成后的图标显示到pic1
End Sub

Private Sub HS_Change()
'浏览其他的图标
fenli fNAME, HS.Value - 1
End Sub




--------------------- 2 ------------------------

Option Explicit
Public Type ICONINFO
fIcon As Long
xHotspot As Long
yHotspot As Long
hbmMask As Long
hbmColor As Long
End Type　'图标信息类型定义

Public Type TypeIcon
cbSize As Long
picType As PictureTypeConstants
hIcon As Long
End Type

Public Type CLSID
ID(16) As Byte
End Type　'图标创建id

Public Declare Function ExtractIcon Lib "shell32.dll" Alias "ExtractIconA" (ByVal hInst As Long, ByVal lpszExeFileName As String, ByVal nIconIndex As Long) As Long　'判断一个可执行文件或DLL中是否有图标存在，并将其提取出来，nIconIndex返回lpszExeFileName指定文件图标的个数'hinst=1表示需要返回的个数
Public Declare Function DrawIcon Lib "user32" (ByVal hdc As Long, ByVal X As Long, ByVal Y As Long, ByVal hIcon As Long) As Long '在指定的位置画一个图标
Public Declare Function CreateIconIndirect Lib "user32" (piconinfo As ICONINFO) As Long
'创建一个766字节的windows标准图标
Public Declare Function OleCreatePictureIndirect Lib "oleaut32.dll" (pDicDesc As TypeIcon, riid As CLSID, ByVal fown As Long, lpUnk As Object) As Long'生成图标
Public Declare Function GetIconInfo Lib "user32" (ByVal hIcon As Long, piconinfo As ICONINFO) As Long '取得与图标有关的信息

Public Function IconToPicture(hIcon As Long) As IPictureDisp
'图标文件生成过程
Dim ID As CLSID
Dim hR As Long
Dim Nicon As TypeIcon
Dim LP As IUnknown
With Nicon
.cbSize = Len(Nicon)
.picType = vbPicTypeIcon
.hIcon = hIcon
End With
With ID
.ID(8) = 192
.ID(15) = 70
End With
'以上参数是必须的，它表示将要从内存中创建图标
hR = OleCreatePictureIndirect(Nicon, ID, 1, LP)
'完成创建，hr=0表示创建失败
If hR = 0 Then
Set IconToPicture = LP
Else
MsgBox "提取出错!文件内部图标已经不可用!", vbOKOnly + vbExclamation
End If
End Function'结束

下面是对上篇文章的补充。

升级“图标提取器”
Private Sub fenli(allfname As String, va As Integer)
'图标创建过程
Dim myicon As Long
myicon = ExtractIcon(0, allfname, va) '读出一个图标
pic1.Picture = IconToPicture(myicon) '将创建完成后的图标显示到pic1
End Sub

--------------------------------------------------------------------------
Public Function IconToPicture(hIcon As Long) As IPictureDisp
Dim ID As CLSID
Dim hR As Long
Dim Nicon As TypeIcon
Dim LP As IUnknown
With Nicon
.cbSize = Len(Nicon)
.picType = vbPicTypeIcon
.hIcon = hIcon
End With
With ID
.ID(8) = 192
.ID(15) = 70
End With
hR = OleCreatePictureIndirect(Nicon, ID, 1, LP)
DestroyIcon hIcon '释放图标占用的内存及资源
If hR = 0 Then
Set IconToPicture = LP
Else
MsgBox "提取出错！文件内部图标已经不可用！", vbOKOnly + vbExclamation
End If
End Function

这里有一个讨论，给出了ICO的文件数据结构，当时还是不够彻底：
其实Image能够显示16位6以上的图标，但是就是Save的时候不行。
http://www.csdn.net/expert/topic/239/239268.shtm

type
LogPal = record
lpal : TLogPalette;
dummy:Array[0..255] of TPaletteEntry;
end;

procedure TForm1.SaveAsBmpClick(Sender: TObject);
var
Source: TComponent;
SysPal : LogPal;
tempCanvas: TCanvas;
sourceRect, destRect: TRect;
image2save: TImage;
notUsed: HWND;
begin
Source := FindComponent(Edit1.Text);
if (not Source is TControl) or
((not Source is TWinControl) and ((Source as TControl).Parent = nil)) then

begin
Beep;
ShowMessage(Edit1.Text + ' is not a valid control.');
Exit;

end;

tempCanvas := TCanvas.Create;
try
with Source as TControl do
tempCanvas.Handle := GetDeviceContext(notUsed);
image2save:=TImage.create(self);
try
with image2save do
begin
Height := (Source as TControl).Height;
Width := (Source as TControl).Width;
destRect := Rect(0,0,Width,Height);
if Source is TWinControl then

sourceRect := destRect;
else
sourceRect := (Source as TControl).BoundsRect;
Canvas.CopyRect(destRect,tempCanvas,sourceRect);
SysPal.lPal.palVersion:=$300;
SysPal.lPal.palNumEntries:=256;
GetSystemPaletteEntries(tempCanvas.Handle,0,256,SysPal.lpal.PalpalEntry);
Picture.Bitmap.Palette:= CreatePalette(Syspal.lpal);
end;
if SaveDialog1.Execute then

image2save.Picture.SaveToFile(SaveDialog1.FileName);
finally
image2save.Free;
end;
finally
tempCanvas.Free;
end;
end;
看看这个例子也许会对你有帮助的
Icon.Palette

老弟：你看看（跟踪） VCL 源代码就知道了。

这个问题我一切说过的。

如果使用Delphi的自带组件，就没有办法解决这个问题，因为TICON类只能输出最多16色的
图标，

如果只使用自带组件，又要保证更高的色彩深度，就只能输出Bitmap与Jpeg格式了

尘莽兄，好久不见了。

用 bitmap 也有问题啊，我制作了 256 色的 bitmap 资源，
程序中用如下代码：

FDefaultImages:= TCustomImageList.Create(Self);
FDefaultImages.ResourceLoad(rtBitmap, 'BMP_IMAGES256', clFuchsia);

唉，眼睁睁的看着 Delphi 把我的 256 bitmap 转换成了 16 色显示出来，特难看，
我那个气啊。

请问各位高手有没有好方法解决？

难道没有人能够解决这个问题吗?

学习

我也想知道

我说了，你跟踪下 VCL 源代码就可以了，不然还说什么？

稍微修改了就可以处理 256等色的了

GZ

没有人能给一个完整的例子吗?我还是个初学者,不懂跟踪vcl,调色板什么的.

好了，我可以给你源代码！Delphi的。请到这里下载：
http://kingron.myetang.com/soft/Iconhuntsrc.zip

抱歉，ETANG限制了我的主页的空间，我现在没有办法上载了，你可以到这里下载：
http://snailsoft.myetang.com/Downloads/IconHunt10Src.zip

我昨晚刚刚搞定我的问题，

不过方法对你不适用，我想你可以不用 ICON, 用 bitmap

image1.picture.bitmap.Handle:=ExtractIcon(hInstance,'c:/windows/system/shell32.dll',4);
image1.picture.bitmap.savetofile('C:/1.ico');

实际上 bitmap 和 ICon 的格式是一样的

To 940801：
你的方法，不是一个真正的ICO，不过可以达到那样的效果，但是如果用Delphi来用的话，
会出现问题的。
其实这个问题我也考虑了很久了，以前对照MSDN翻译过一个Icons.C文件，但是总是最后一步
通不过，昨天看了IconHunt的源代码，发现它的Icon.pas和我的寄几乎一模一样！哎，惭愧啊！
我只看了她的两三行的代码，就明白我最后那个地方出现错误了！于是修改了我原来的Icons.pas
现在发布出来，大家共享一下吧，我测试过了，没有问题！不过不支持ICL文件。

其实我这个Icons.pas不能根据一个hIcon来保存，必须是作为资源的，就是说，必须是DLL或者EXE等
类似文件里面，才能提取和保存，并且能够保存成真彩色，并且可以包含多个图标的。

因为文件比较长，需要这个Icons.pas的朋友，请写信给我，因为ETANG不让我修改主页了，不然我上载
倒我的主页去了，我会把这个文件收留倒我的猛料包里面，等eTANG弄好之后，上载达到我的主页取得。

///函数原型
function ExtractIconFromFile(ResFileName: string; IcoFileName: string; nIndex: string): Boolean;

///调用举例：
ExtractIconFromFile('shell32.dll','c:/test.ico','4');

P.S：特别感谢IconHunter的作者 严启阳

iconhunter打不开大多数的dll，都是“库文件错误”，根本就不能显示出图标，
但这些dll在其它图标软件下都能正常打开。不信你试一试windows/system/cool.dll，
现在我发现这个软件只可以打开shell32.dll和exe：（

To hlsoft：
没有啊，我用IconHunt可以打开其他的DLL啊。

不信你试一试windows/system/cool.dll!

我用的是Win200没有这个DLL，：（