我做一个提取图标的小工具，但是保存后却严重色彩失真，希望大家的帮助！！（跟贴有分！）(200分)

原文件图标有大有小，大的有8-9k，小的
有几百字节，不一而足，但是我的保存
之后就统一变成766字节了。
TIcon.SaveToFile() ; TIcon.SaveToStream();
TImage.Picture.SaveToFile()等
我都试过,都无法解决问题。
是不是这些保存方法有问题？？？
（这些ICON都是32x32的）
//////////////////////////////////
这个问题好象已经讨论过，但我一直还
没有找到答案。请赐教！

将ICON转换为BMP保存，用时转换回来.

http://www.delphibbs.com/delphibbs/dispq.asp?lid=686939
解决你的问题了.

从文件中提取图标

首先声明一个API:
Function SHChangeIconDialog(hOwner:hwnd;szFilenamechar;Reserved:longint; var lpIconIndex:Longint):Longint;stdcall;external 'shell32' index 62;


function TForm1.GetIconFromExe(ExeName:string):HIcon;
Var ic:longint;
idx:integer;
Exechar;
begin
getmem(Exe,255);
Exe:=pchar(ExeName); //参数可以为空串,看看结果是什么?
ic:=SHChangeIconDialog(handle,Exe,0,idx);
if ic<>0 then //成功调用
result:=extracticon(0,Exe,idx);
end;

这样使用:
imgicon.Picture.Icon.Handle:=GetIconFromExe('xxx.exe');

///////////////////////////////////////////////////////////////////////////
type ThIconArray = array[0..0] of hIcon;
type PhIconArray = ^ThIconArray;

function ExtractIconExA(lpszFile: PAnsiChar;
nIconIndex: Integer;
phiconLarge : PhIconArray;
phiconSmall: PhIconArray;
nIcons: UINT): UINT; stdcall;
external 'shell32.dll' name 'ExtractIconExA';


function ExtractIconExW(lpszFile: PWideChar;
nIconIndex: Integer;
phiconLarge: PhIconArray;
phiconSmall: PhIconArray;
nIcons: UINT): UINT; stdcall;
external 'shell32.dll' name 'ExtractIconExW';

function ExtractIconEx(lpszFile: PAnsiChar;
nIconIndex: Integer;
phiconLarge : PhIconArray;
phiconSmall: PhIconArray;
nIcons: UINT): UINT; stdcall;
external 'shell32.dll' name 'ExtractIconExA';


procedure TForm1.Button1Click(Sender: TObject);
var
NumIcons : integer;
pTheLargeIcons : phIconArray;
pTheSmallIcons : phIconArray;
LargeIconWidth : integer;
SmallIconWidth : integer;
SmallIconHeight : integer;
i : integer;
TheIcon : TIcon;
TheBitmap : TBitmap;
begin
NumIcons :=
ExtractIconEx('C:/Program Files/Borland/Delphi 3/BIN/delphi32.exe',
-1,
nil,
nil,
0);
if NumIcons > 0 then begin
LargeIconWidth := GetSystemMetrics(SM_CXICON);
SmallIconWidth := GetSystemMetrics(SM_CXSMICON);
SmallIconHeight := GetSystemMetrics(SM_CYSMICON);
GetMem(pTheLargeIcons, NumIcons * sizeof(hIcon));
GetMem(pTheSmallIcons, NumIcons * sizeof(hIcon));
FillChar(pTheLargeIcons^, NumIcons * sizeof(hIcon), #0);
FillChar(pTheSmallIcons^, NumIcons * sizeof(hIcon), #0);
ExtractIconEx('C:/Program Files/Borland/Delphi 3/BIN/delphi32.exe',
0,
pTheLargeIcons,
pTheSmallIcons,
numIcons);
{$IFOPT R+}
{$DEFINE CKRANGE}
{$R-}
{$ENDIF}
for i := 0 to (NumIcons - 1) do begin
DrawIcon(Form1.Canvas.Handle,
i * LargeIconWidth,
0,
pTheLargeIcons^);
TheIcon := TIcon. Create;
TheBitmap := TBitmap.Create;
TheIcon.Handle := pTheSmallIcons^;
TheBitmap.Width := TheIcon.Width;
TheBitmap.Height := TheIcon.Height;
TheBitmap.Canvas.Draw(0, 0, TheIcon);
TheIcon.Free;
Form1.Canvas.StretchDraw(Rect(i * SmallIconWidth,
100,
(i + 1) * SmallIconWidth,
100 + SmallIconHeight),
TheBitmap);
TheBitmap.Free;
end;
{$IFDEF CKRANGE}
{$UNDEF CKRANGE}
{$R+}
{$ENDIF}
FreeMem(pTheLargeIcons, NumIcons * sizeof(hIcon));
FreeMem(pTheSmallIcons, NumIcons * sizeof(hIcon));
end;
end;

end.
//////////////////////////////////////////////////////
var
TheIcon: TIcon;
begin
TheIcon := TIcon.Create;
TheIcon.Handle := ExtractIcon(hInstance,
'C:/SOMEPATH/SOMEPROG.EXE',
0);
{Do something with the icon}
TheIcon.Free;
end;

你的TIcon中的Icon是怎样得到的？ 看上去不应该是SaveToFile的问题，
可能是前面的操作的问题。

to：hbezwwl，这个源码我试过，
根本不起作用。

从exe，dll文件中提取的

to 爱人不在家:
http://www.delphibbs.com/delphibbs/dispq.asp?lid=302223
我对图像不怎么熟,只好当苦力找一个贴子了.
//反正爱人出差了就是不在家.呵呵.

对不起，大富翁真的很难上来。

给你一个源码：



我没有试过，看看对你有没有帮助，这个是保存合并真色彩的图标源码

///文件名：Icons.Pas
unit Icons;

interface

uses windows, sysutils;

type
PByte = ^Byte;
PBitmapInfo = ^BitmapInfo;

/// These first two structs represent how the icon information is stored
/// when it is bound into a EXE or DLL file. Structure members are WORD
/// aligned and the last member of the structure is the ID instead of
/// the imageoffset.

type
PMEMICONDIRENTRY = ^TMEMICONDIRENTRY;
TMEMICONDIRENTRY = packed record
bWidth: BYTE; /// Width of the image
bHeight: BYTE; /// Height of the image (times 2)
bColorCount: BYTE; /// Number of colors in image (0 if >=8bpp)
bReserved: BYTE; /// Reserved
wPlanes: WORD; /// Color Planes
wBitCount: WORD; /// Bits per pixel
dwBytesInRes: DWORD; /// how many bytes in this resource?
nID: WORD; /// the ID
end;

type
PMEMICONDIR = ^TMEMICONDIR;
TMEMICONDIR = packed record
idReserved: WORD; /// Reserved
idType: WORD; /// resource type (1 for icons)
idCount: WORD; /// how many images?
idEntries: array[0..10] of TMEMICONDIRENTRY; /// the entries for each image
///查看msdn，这个数组长度应该是1，但是为什么图标猎手定义的是0..10？
end;

/// These next two structs represent how the icon information is stored
/// in an ICO file.

type
PICONDIRENTRY = ^TICONDIRENTRY;
TICONDIRENTRY = packed record
bWidth: BYTE; /// Width of the image
bHeight: BYTE; /// Height of the image (times 2)
bColorCount: BYTE; /// Number of colors in image (0 if >=8bpp)
bReserved: BYTE; /// Reserved
wPlanes: WORD; /// Color Planes
wBitCount: WORD; /// Bits per pixel
dwBytesInRes: DWORD; /// how many bytes in this resource?
dwImageOffset: DWORD; /// where in the file is this image
end;

type
PICONDIR = ^TICONDIR;
TICONDIR = packed record
idReserved: WORD; /// Reserved
idType: WORD; /// resource type (1 for icons)
idCount: WORD; /// how many images?
idEntries: array[0..0] of TICONDIRENTRY; /// the entries for each image
end;

/// The following two structs are for the use of this program in
/// manipulating icons. They are more closely tied to the operation
/// of this program than the structures listed above. One of the
/// main differences is that they provide a pointer to the DIB
/// information of the masks.
type
PICONIMAGE = ^TICONIMAGE;
TICONIMAGE = packed record
Width, Height, Colors: UINT; /// Width, Height and bpp
lpBits: pointer; /// ptr to DIB bits
dwNumBytes: DWORD; /// how many bytes?
pBmpInfo: PBitmapInfo;
end;
{ ///这是原来的，上面的是对照IconHunt的
TICONIMAGE = packed record
Width, Height, Colors: UINT; /// Width, Height and bpp
lpBits: pointer; /// ptr to DIB bits
dwNumBytes: DWORD; /// how many bytes?
lpbi: PBITMAPINFO; /// ptr to header
lpXOR: LPBYTE; /// ptr to XOR image bits
lpAND: LPBYTE; /// ptr to AND image bits
end;
}
type
PICONRESOURCE = ^TICONRESOURCE;
TICONRESOURCE = packed record
nNumImages: UINT; /// How many images?
IconImages: array[0..10] of TICONIMAGE; /// Image entries
end;
{///下面是原来的，上面是对照IconHunt的
TICONRESOURCE = packed record
bHasChanged: BOOL; /// Has image changed?
szOriginalICOFileName: array[0..MAX_PATH] of char; /// Original name
szOriginalDLLFileName: array[0..MAX_PATH] of char; /// Original name
nNumImages: UINT; /// How many images?
IconImages: array[0..0] of ICONIMAGE; /// Image entries
end;
}

type
TPageInfo = packed record
Width: byte;
Height: byte;
ColorQuantity: integer;
Reserved: DWORD;
PageSize: DWORD;
PageOffSet: DWORD;
end;

type
TPageDataHeader = packed record
PageHeadSize: DWORD;
XSize: DWORD;
YSize: DWORD;
SpeDataPerPixSize: integer;
ColorDataPerPixSize: integer;
Reserved: DWORD;
DataAreaSize: DWORD;
ReservedArray: array[0..15] of char;
end;

type
TIcoFileHeader = packed record
FileFlag: array[0..3] of byte;
PageQuartity: integer;
PageInfo: TPageInfo;
end;

///function WriteIconToFile(Bitmap: hBitmap; Icon: hIcon; szFileName: string): Boolean; overload;
function ExtractIconFromFile(ResFileName: string; IcoFileName: string; nIndex: string): Boolean;
function WriteIconResourceToFile(hFile: hwnd; lpIR: PICONRESOURCE): Boolean;

implementation

function WriteICOHeader(hFile: HWND; nNumEntries: UINT): Boolean;
type
TFIcoHeader = record
wReserved: WORD;
wType: WORD;
wNumEntries: WORD;
end;
var
IcoHeader: TFIcoHeader;
/// Output: WORD;
dwBytesWritten: DWORD;
begin
Result := False;
IcoHeader.wReserved := 0;
IcoHeader.wType := 1;
IcoHeader.wNumEntries := WORD(nNumEntries);
if not WriteFile(hFile, IcoHeader, SizeOf(IcoHeader), dwBytesWritten, nil) then
begin
MessageBox(0, pchar(SysErrorMessage(GetLastError)), 'info', MB_OK);
exit;
end;
if dwBytesWritten <> SizeOf(IcoHeader) then
exit;
{
Output := 0;
/// Write 'reserved' WORD
if not WriteFile(hFile, Output, SizeOf(WORD), dwBytesWritten, nil) then
exit;
/// Did we write a WORD?
if dwBytesWritten <> SizeOf(WORD) then exit;
/// Write 'type' WORD (1)
Output := 1;
if not WriteFile(hFile, Output, SizeOf(WORD), dwBytesWritten, nil) then
exit;
if dwBytesWritten <> SizeOf(WORD) then exit;
/// Write Number of Entries
Output := WORD(nNumEntries);
if not WriteFile(hFile, Output, SizeOf(WORD), dwBytesWritten, nil) then
exit;
if dwBytesWritten <> SizeOf(WORD) then exit;
}
Result := True;
end;

function CalculateImageOffset(lpIR: PICONRESOURCE; nIndex: UINT): DWORD;
var
dwSize: DWORD;
i: integer;
begin
/// Calculate the ICO header size
dwSize := 3 * sizeof(WORD);
/// Add the ICONDIRENTRY's
inc(dwSize, lpIR.nNumImages * sizeof(TICONDIRENTRY));
/// Add the sizes of the previous images
for i := 0 to nIndex - 1 do
inc(dwSize, lpIR.IconImages.dwNumBytes);
/// we're there - return the number
Result := dwSize;
end;

function WriteIconResourceToFile(hFile: hwnd; lpIR: PICONRESOURCE): Boolean;
var
i: UINT;
dwBytesWritten: DWORD;
ide: TICONDIRENTRY;
dwTemp: DWORD;
begin
/// open the file
Result := False;
/// Write the ICONDIRENTRY's
for i := 0 to lpIR^.nNumImages - 1 do
begin
/// Convert internal format to ICONDIRENTRY
ide.bWidth := lpIR^.IconImages.Width;
ide.bHeight := lpIR^.IconImages.Height;
ide.bReserved := 0;
ide.wPlanes := lpIR^.IconImages.pBmpInfo.bmiHeader.biPlanes;
ide.wBitCount := lpIR^.IconImages.pBmpInfo.bmiHeader.biBitCount;
if ide.wPlanes * ide.wBitCount >= 8 then
ide.bColorCount := 0
else
ide.bColorCount := 1 shl (ide.wPlanes * ide.wBitCount);
ide.dwBytesInRes := lpIR^.IconImages.dwNumBytes;
ide.dwImageOffset := CalculateImageOffset(lpIR, i);
/// Write the ICONDIRENTRY out to disk
if not WriteFile(hFile, ide, sizeof(TICONDIRENTRY), dwBytesWritten, nil) then
exit;
/// Did we write a full ICONDIRENTRY ?
if dwBytesWritten <> sizeof(TICONDIRENTRY) then
exit;
end;
/// Write the image bits for each image
for i := 0 to lpIR^.nNumImages - 1 do
begin
dwTemp := lpIR^.IconImages.pBmpInfo^.bmiHeader.biSizeImage;
/// Set the sizeimage member to zero
lpIR^.IconImages.pBmpInfo^.bmiHeader.biSizeImage := 0;
/// Write the image bits to file
if not WriteFile(hFile, lpIR^.IconImages.lpBits^, lpIR^.IconImages.dwNumBytes, dwBytesWritten, nil) then
exit;
if dwBytesWritten <> lpIR^.IconImages.dwNumBytes then
exit;
/// set it back
lpIR^.IconImages.pBmpInfo^.bmiHeader.biSizeImage := dwTemp;
end;
Result := True;
end;

function AWriteIconToFile(bitmap: hBitmap; Icon: hIcon; szFileName: string): Boolean;
var
fh: file of byte;
IconInfo: _ICONINFO;
PageInfo: TPageInfo;
PageDataHeader: TPageDataHeader;
IcoFileHeader: TIcoFileHeader;
BitsInfo: tagBITMAPINFO;
p: pointer;
PageDataSize: integer;
begin
Result := False;
GetIconInfo(Icon, IconInfo);
AssignFile(fh, szFileName);
FileMode := 1;
Reset(fh);

GetDIBits(0, Icon, 0, 32, nil, BitsInfo, DIB_PAL_COLORS);
GetDIBits(0, Icon, 0, 32, p, BitsInfo, DIB_PAL_COLORS);
PageDataSize := SizeOf(PageDataHeader) + BitsInfo.bmiHeader.biBitCount;

PageInfo.Width := 32;
PageInfo.Height := 32;
PageInfo.ColorQuantity := 65535;
Pageinfo.Reserved := 0;
PageInfo.PageSize := PageDataSize;
PageInfo.PageOffSet := SizeOf(IcoFileHeader);

IcoFileHeader.FileFlag[0] := 0;
IcoFileHeader.FileFlag[1] := 0;
IcoFileHeader.FileFlag[2] := 1;
IcoFileHeader.FileFlag[3] := 0;
IcoFileHeader.PageQuartity := 1;
IcoFileHeader.PageInfo := PageInfo;

FillChar(PageDataHeader, SizeOf(PageDataHeader), 0);
PageDataHeader.XSize := 32;
PageDataHeader.YSize := 32;
PageDataHeader.SpeDataPerPixSize := 0;
PageDataHeader.ColorDataPerPixSize := 32;
PageDataHeader.PageHeadSize := SizeOf(PageDataHeader);
PageDataHeader.Reserved := 0;
PageDataHeader.DataAreaSize := BitsInfo.bmiHeader.biBitCount;

BlockWrite(fh, IcoFileHeader, SizeOf(IcoFileHeader));
BlockWrite(fh, PageDataHeader, SizeOf(PageDataHeader));
BlockWrite(fh, p, BitsInfo.bmiHeader.biBitCount);
CloseFile(fh);
end;

function AdjustIconImagePointers(lpImage: PICONIMAGE): Bool;
begin
if lpImage = nil then
begin
Result := False;
exit;
end;
lpImage.pBmpInfo := PBitMapInfo(lpImage^.lpBits);
lpImage.Width := lpImage^.pBmpInfo^.bmiHeader.biWidth;
lpImage.Height := (lpImage^.pBmpInfo^.bmiHeader.biHeight) div 2;
lpImage.Colors := lpImage^.pBmpInfo^.bmiHeader.biPlanes * lpImage^.pBmpInfo^.bmiHeader.biBitCount;
Result := true;
end;

function ExtractIconFromFile(ResFileName: string; IcoFileName: string; nIndex: string): Boolean;
var
h: HMODULE;
lpMemIcon: PMEMICONDIR;
lpIR: TICONRESOURCE;
src: HRSRC;
Global: HGLOBAL;
i: integer;
hFile: hwnd;
begin
Result := False;
hFile := CreateFile(pchar(IcoFileName), GENERIC_WRITE, 0, nil, CREATE_ALWAYS, FILE_ATTRIBUTE_NORMAL, 0);
if hFile = INVALID_HANDLE_VALUE then exit; ///Error Create File
h := LoadLibraryEx(pchar(ResFileName), 0, LOAD_LIBRARY_AS_DATAFILE);
if h = 0 then exit;
try
src := FindResource(h, pchar(nIndex), RT_GROUP_ICON);
if src = 0 then
Src := FindResource(h, Pointer(StrToInt(nIndex)), RT_GROUP_ICON);
if src <> 0 then
begin
Global := LoadResource(h, src);
if Global <> 0 then
begin
lpMemIcon := LockResource(Global);
if Global <> 0 then
begin
/// lpIR := @IR;
try
lpIR.nNumImages := lpMemIcon.idCount;
/// Write the header
for i := 0 to lpMemIcon^.idCount - 1 do
begin
src := FindResource(h, MakeIntResource(lpMemIcon^.idEntries.nID), RT_ICON);
if src <> 0 then
begin
Global := LoadResource(h, src);
if Global <> 0 then
begin
lpIR.IconImages.dwNumBytes := SizeofResource(h, src);
GetMem(lpIR.IconImages.lpBits, lpIR.IconImages.dwNumBytes);
CopyMemory(lpIR.IconImages.lpBits, LockResource(Global), lpIR.IconImages.dwNumBytes);
if not AdjustIconImagePointers(@(lpIR.IconImages)) then exit;
end;
end;
end;
if WriteICOHeader(hFile, lpIR.nNumImages) then ///No Error Write File
if WriteIconResourceToFile(hFile, @lpIR) then
Result := True;
finally
for i := 0 to lpIR.nNumImages - 1 do
if assigned(lpIR.IconImages.lpBits) then
FreeMem(lpIR.IconImages.lpBits);
end;
end;
end;
end;
finally
FreeLibrary(h);
end;
CloseHandle(hFile);
end;

end.

我也碰到过这种问题 从EXE或DLL文件提取图标 保存后发现严重失真，大侠们给点建议！

学习。

上面朋友给的答案都试过了，解决不了问题啊。

to laohe：
这个方法保存出来的图标不是真正的图标啊。

其实我对这个问题很有兴趣。
TICON只支持16色的图标，而且图标的颜色表是死的，所以保存出来的图标文件只是16色的
，因而失真了。
我这里也没有代码，建议看一下图标文件的文件格式，然后用写文件的方式保存文件。

试验一下先把图标资源读入到一个图像控件，然后save 看看

Image1.picture.loadfromFile(xx.ico);
Image1.picture.SaveToFile(xxx.ico);
没问题。
或者在设计期调入，运行时保存也没问题。

据我看资料！icon是用点阵画出来的，大体思路是：32*32就是行32列32的矩阵，你可以用二维数组将没一格的颜色数取出来，然后在类似于模拟打印的方式将矩阵输出到bmp文件中！
这个思路你可试一下，做好给我一个回复！谢谢！

to 爱人出差了
用真彩色保存文件！！！！！！！！！！！！

to etoo_pop
这么底层的东西做不出来啊。
没有这方面的资料。再说，icon没有您想的这么
简单啊。他还要包括一个很复杂头文件呢