如何把一个真彩32×32的（bmp）图片，保存成256色的图标（icon）文件？（成功代码给分300） ( 积分: 0 )

var
Icon: TIcon;
begin
imagelist1.Width := 32;
imagelist1.Height := 32;
imagelist1.Add(image4.Picture.Bitmap,nil);
Icon := TIcon.Create;
imagelist1.GetIcon(0,icon,dsTransparent,itImage);
Icon.SaveToFile('d:/list.ico');
Icon.Free;
＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝
这是网上最经典的作法。这样做后。保存成的ico文件是16色的。
不能保存256色格式。

谁解决了。。。

你要自已写保存代码我可以给你一段
procedure TjvIcon.SaveAsIconXP(ABitmap: TBitMap32; Afile: string; w, h: integer);
var
TempBitmap: TBitmap;
ic: TIcon;
color :TColor32;
msss,fs: TmemoryStream;
tt, icondate, xx: Integer;
ttt: SmallInt;
str, a, r, g, b: string;
BitMapByteWidth, BitMapBytes, num, numnew, numh, ii: Integer;

procedure SaveJvIcon(SourBmp: TBitMap32; Width, Height: integer);
var
X, Y, a, R, g, b: integer;
color: TColor32;
begin
TempBitmap := TBitmap.Create;
TempBitmap.PixelFormat := pf24bit;
TempBitmap.Width := Width;
TempBitmap.Height := Height;
for X := 0 to SourBmp.Width - 1 do
for Y := 0 to SourBmp.Height - 1 do
begin
a := TColor32Entry(SourBmp.Pixel[X, Y]).a;
R := TColor32Entry(SourBmp.Pixel[X, Y]).R;
g := TColor32Entry(SourBmp.Pixel[X, Y]).g;
b := TColor32Entry(SourBmp.Pixel[X, Y]).b;
if a = 0 then
TempBitmap.canvas.Pixels[X, Y] := $FF00D2
else
TempBitmap.canvas.Pixels[X, Y] := $FF0000;
end;
ic :=CreateIcon(TempBitmap,w,h);
fs :=TmemoryStream.Create;
WriteIcon(fs,ic.Handle,false,24);
ic.Free;
TempBitmap.Free;
end;
begin
SaveJvIcon(ABitmap, w,h);
msss := TmemoryStream.Create;
msss.Size := 0;
msss.Position := 0;
//icon头数据
{1段}
tt := $00010000; //二进制是0000,0100
msss.Write(tt, sizeof(tt));
{2段}
str := '$' + inttohex(48, 2) + inttohex(48, 2) + '0001';
tt := strtoint(str); //图标个数 与图标宽高度 0001表是只有一个图标,3030代表是48*48位的图标
msss.Write(tt, sizeof(tt));
{3段}
tt := $00010000; //二进制是0000,0100
msss.Write(tt, sizeof(tt));
{4段}
str := '$FFFF0020'; //二进制是0020是代表是32位图标,前面是指图标大小
tt := strtoint(str);
msss.Write(tt, sizeof(tt));
{5段}
tt := $00160000; //图标数据开始偏移量
msss.Write(tt, sizeof(tt));
{6段}
tt := $00280000; //图标数据bitmap位图头大小
msss.Write(tt, sizeof(tt));
{7段}
str := '$00' + inttohex(w, 2) + '0000';
tt := strtoint(str); //bitmap位图宽度
msss.Write(tt, sizeof(tt));
{8段}
str := '$00' + inttohex(h * 2, 2) + '0000';
tt := strtoint(str); //bitmap位图高度* 2
msss.Write(tt, sizeof(tt));
{9段}
tt := $00010000; //bitmap位图头
msss.Write(tt, sizeof(tt));
{10段}
tt := $00000020; //bitmap位图颜色深度$20是32位色
msss.Write(tt, sizeof(tt));
{12段}
tt := $25800000; //bitmap位图数据大小
msss.Write(tt, sizeof(tt));

for xx := 1 to 5 do begin
if xx = 5 then begin
ttt := $0000;
msss.Write(ttt, sizeof(ttt));
end else begin
tt := $00000000; //bitmap位图头
msss.Write(tt, sizeof(tt));
end;
end;
//-------------------------

BitMapByteWidth := round(((w + 1) * 4 + 4) / 4) * 4; //'=IWidth * 4 BitMapBytes := round(BitMapByteWidth * (h + 1) / 2);

num := w - 1;
numnew := w- 1;
numh := H - 1;
for xx := 62 to BitMapBytes div 2 + 2000 do begin
ii := 62 + (xx - 61) * 4 - 1;
if numnew < 0 then begin
numnew := w - 1;
numh := numh - 1;
if numh < 0 then begin
break;
end;
end;
color := ABitmap.Pixel[num - numnew, numh];
a := inttohex(TColor32Entry(color).a, 2);
r := inttohex(TColor32Entry(color).r, 2);
g := inttohex(TColor32Entry(color).g, 2);
b := inttohex(TColor32Entry(color).b, 2);
str := '$' + a + r + g + b;
icondate := strtoint(str);
msss.Write(icondate, sizeof(icondate));
if (numh = 0) and (numnew = 0) then break;
numnew := numnew - 1;
end;

fs.Position := fs.Size - 4 * Trunc(((w + 7) / 8 + 3) / 4) * H;
msss.CopyFrom(fs, fs.Size - fs.Position);
fs.Free;
//----------------
msss.Position := 12;
{4段}
str := '$' + inttohex((msss.Size - 22), 2) + '0020'; if length(str) > 9 then begin
a := '$0016' + inttohex(strtoint(copy(str, 1, length(str) - 8)), 4);
str := '$' + copy(str, 3, 8);
tt := strtoint(str);
msss.Write(tt, sizeof(tt));
tt := strtoint(a);
msss.Write(tt, sizeof(tt));
end else begin
tt := strtoint(str);
msss.Write(tt, sizeof(tt));
end;
msss.SaveToFile(Afile);
msss.Free;
end;

tbitmap32是什么类型或结构。。能发上来吗

你自已找一下是Graphics32

谢谢，我先去试。我已另开贴给分。请去接一下

都是Graphics32中的类你如果用BITMAP可以改一下只是他不支持ALPHI通道

接受答案了.