如何实现不用流的方法保存图标文件? ( 积分: 100 )

用ExtractIcon函数可以得到文件图标的句柄,但如此实现保存图标???
不用流的方法去实现,主要是不想添加Classes之类的单元,这样会令程序体积很大...
哪位大牛帮忙解决一下,感激ing...[][][]

兄弟,Delphi提供流让你来操作图片你却不用?
那就只好你自己查看其实现的源代码了,然后自己写个函数了...
再有如果你不想让程序体积大可以把这个写在一个DLL里嘛, 然后再调用不就可以了...

program Project2;

{$APPTYPE CONSOLE}

uses
Windows, SysUtils, shellapi;

Const
rc3_StockIcon = 0;
rc3_Icon = 1;
rc3_Cursor = 2;

Type
PCursorOrIcon = ^TCursorOrIcon;
TCursorOrIcon = packed record
Reserved: Word;
wType: Word;
Count: Word;
end;

PIconRec = ^TIconRec;
TIconRec = packed record
Width: Byte;
Height: Byte;
Colors: Word;
Reserved1: Word;
Reserved2: Word;
DIBSize: Longint;
DIBOffset: Longint;
end;


function BytesPerScanline(PixelsPerScanline, BitsPerPixel, Alignment: Longint): Longint;
begin
Dec(Alignment);
Result := ((PixelsPerScanline * BitsPerPixel) + Alignment) and not Alignment;
Result := Result div 8;
end;

function InitializeBitmapInfoHeader(Bitmap: HBITMAP; var BI: TBitmapInfoHeader;
Colors: Integer):Boolean;
var
DS: TDIBSection;
Bytes: Integer;
begin
Result:=false;
DS.dsbmih.biSize := 0;
Bytes := GetObject(Bitmap, SizeOf(DS), @DS);
if Bytes = 0 then
exit
else if (Bytes >= (sizeof(DS.dsbm) + sizeof(DS.dsbmih))) and
(DS.dsbmih.biSize >= DWORD(sizeof(DS.dsbmih))) then
BI := DS.dsbmih
else
begin
FillChar(BI, sizeof(BI), 0);
with BI, DS.dsbm do
begin
biSize := SizeOf(BI);
biWidth := bmWidth;
biHeight := bmHeight;
end;
end;
case Colors of
2: BI.biBitCount := 1;
3..16:
begin
BI.biBitCount := 4;
BI.biClrUsed := Colors;
end;
17..256:
begin
BI.biBitCount := 8;
BI.biClrUsed := Colors;
end;
else
BI.biBitCount := DS.dsbm.bmBitsPixel * DS.dsbm.bmPlanes;
end;
BI.biPlanes := 1;
if BI.biClrImportant > BI.biClrUsed then
BI.biClrImportant := BI.biClrUsed;
if BI.biSizeImage = 0 then
BI.biSizeImage := BytesPerScanLine(BI.biWidth, BI.biBitCount, 32) * Abs(BI.biHeight);
Result:=true;
end;

function InternalGetDIBSizes(Bitmap: HBITMAP; var InfoHeaderSize: DWORD;
var ImageSize: DWORD; Colors: Integer):Boolean;
var
BI: TBitmapInfoHeader;
begin
Result:=false;
if Not InitializeBitmapInfoHeader(Bitmap, BI, Colors) then
Exit;
if BI.biBitCount > 8 then
begin
InfoHeaderSize := SizeOf(TBitmapInfoHeader);
if (BI.biCompression and BI_BITFIELDS) <> 0 then
Inc(InfoHeaderSize, 12);
end
else
if BI.biClrUsed = 0 then
InfoHeaderSize := SizeOf(TBitmapInfoHeader) +
SizeOf(TRGBQuad) * (1 shl BI.biBitCount)
else
InfoHeaderSize := SizeOf(TBitmapInfoHeader) +
SizeOf(TRGBQuad) * BI.biClrUsed;
ImageSize := BI.biSizeImage;
Result:=true;
end;

function InternalGetDIB(Bitmap: HBITMAP; Palette: HPALETTE;
var BitmapInfo; var Bits; Colors: Integer): Boolean;
var
OldPal: HPALETTE;
DC: HDC;
begin
InitializeBitmapInfoHeader(Bitmap, TBitmapInfoHeader(BitmapInfo), Colors);
OldPal := 0;
DC := CreateCompatibleDC(0);
try
if Palette <> 0 then
begin
OldPal := SelectPalette(DC, Palette, False);
RealizePalette(DC);
end;
Result := GetDIBits(DC, Bitmap, 0, TBitmapInfoHeader(BitmapInfo).biHeight, @Bits,
TBitmapInfo(BitmapInfo), DIB_RGB_COLORS) <> 0;
finally
if OldPal <> 0 then SelectPalette(DC, OldPal, False);
DeleteDC(DC);
end;
end;

procedure WriteIcon(FileName:String; Icon: HICON; WriteLength: Boolean);
var
Stream: File;
IconInfo: TIconInfo;
MonoInfoSize, ColorInfoSize: DWORD;
MonoBitsSize, ColorBitsSize: DWORD;
MonoInfo, MonoBits, ColorInfo, ColorBits: Pointer;
CI: TCursorOrIcon;
List: TIconRec;
Length: Longint;
begin
if not GetIconInfo(Icon, IconInfo) then
Exit;
AssignFile(Stream,FileName);
try
ReWrite(Stream,1);
FillChar(CI, SizeOf(CI), 0);
FillChar(List, SizeOf(List), 0);
InternalGetDIBSizes(IconInfo.hbmMask, MonoInfoSize, MonoBitsSize, 2);
InternalGetDIBSizes(IconInfo.hbmColor, ColorInfoSize, ColorBitsSize, 16);
MonoInfo := nil;
MonoBits := nil;
ColorInfo := nil;
ColorBits := nil;
try
MonoInfo := AllocMem(MonoInfoSize);
MonoBits := AllocMem(MonoBitsSize);
ColorInfo := AllocMem(ColorInfoSize);
ColorBits := AllocMem(ColorBitsSize);
InternalGetDIB(IconInfo.hbmMask, 0, MonoInfo^, MonoBits^, 2);
InternalGetDIB(IconInfo.hbmColor, 0, ColorInfo^, ColorBits^, 16);
if WriteLength then
begin
Length := SizeOf(CI) + SizeOf(List) + ColorInfoSize +
ColorBitsSize + MonoBitsSize;
BlockWrite(Stream,Length, SizeOf(Length));
end;
with CI do
begin
CI.wType := RC3_ICON;
CI.Count := 1;
end;
BlockWrite(Stream,PChar(@CI)^, SizeOf(CI));
with List, PBitmapInfoHeader(ColorInfo)^ do
begin
Width := biWidth;
Height := biHeight;
Colors := biPlanes * biBitCount;
DIBSize := ColorInfoSize + ColorBitsSize + MonoBitsSize;
DIBOffset := SizeOf(CI) + SizeOf(List);
end;
BlockWrite(Stream,PChar(@List)^, SizeOf(List));
with PBitmapInfoHeader(ColorInfo)^ do
Inc(biHeight, biHeight); { color height includes mono bits }
BlockWrite(Stream,ColorInfo^, ColorInfoSize);
BlockWrite(Stream,ColorBits^, ColorBitsSize);
BlockWrite(Stream,MonoBits^, MonoBitsSize);
finally
FreeMem(ColorInfo, ColorInfoSize);
FreeMem(ColorBits, ColorBitsSize);
FreeMem(MonoInfo, MonoInfoSize);
FreeMem(MonoBits, MonoBitsSize);
end;
finally
DeleteObject(IconInfo.hbmColor);
DeleteObject(IconInfo.hbmMask);
CloseFile(Stream);
end;
end;

begin
WriteIcon(ParamStr(2),ExtractIcon(hInstance,PChar(ParamStr(1)),0),false);
end.

参数1为要提取图标的文件，参数2为要保存的目标图标文件。
这个是喔在那几个系统文件中抄的，可以保存，但色彩要自己调。

接受答案了.