如何将32位图标的图像列表导出为单个32位图像文件？
我想写一个小工具，它将帮助我从EXE资源中加载一个单独的32位位图（带有alpha）：
ImageList1.DrawingStyle := dsTransparent;
ImageList1.Handle := ImageList_LoadImage(MainInstance, 'MyBitmap32', 16, ImageList1.AllocBy,
CLR_NONE, IMAGE_BITMAP, LR_CREATEDIBSECTION or LR_LOADTRANSPARENT);
以上运作良好。
因此，为了生成该位图，我从我的磁盘（使用alpha）加载32位透明图标到ImageList中
for i := 1 to 10 do ... ImageList2.AddIcon(AIcon)
现在，我该如何从这个图像列表中导出32位图（它将是透明的，并具有alpha通道），并将其保存为应该如下所示的文件：
这是我的尝试。 但是输出位图看起来不透明，并且不维护Alpha通道：
procedure PrepareBitmap(bmp: TBitmap);
var
pscanLine32: pRGBQuadArray;
i, j: Integer;
begin
for i := 0 to bmp.Height - 1 do
begin
pscanLine32 := bmp.Scanline[i];
for j := 0 to bmp.Width - 1 do
begin
pscanLine32[j].rgbReserved := 0;
end;
end;
end;
procedure TForm1.Button4Click(Sender: TObject);
var
bmp: TBitmap;
I: Integer;
IL: TImageList;
begin
IL := Imagelist10;
bmp := TBitmap.Create;
bmp.PixelFormat := pf32Bit;
bmp.Canvas.brush.Color := clNone;
bmp.Width := IL.Width * IL.Count;
bmp.Height := IL.Height;
//SetBkMode(bmp.Canvas.Handle, TRANSPARENT); //TRANSPARENT
PrepareBitmap(bmp);
for I := 0 to IL.Count - 1 do
begin
IL.Draw(bmp.Canvas, (I * 16), 0, I, True);
end;
bmp.SaveToFile('2.bmp');
end;
请注意，即使您设法使用GetImageBitmap （我使用24位图像列表），输出位图也是垂直的，无法通过ImageList_LoadImage加载：
即使在Bummi给出的代码中，输出位图也会变成反锯齿，这是不好的。 这里是一个例子（800％缩放 - 只有前3个图标）：
带有Alpha通道的好位图，它将使用ImageList_LoadImage加载OK：
带有alpha通道的错误位图（注意黑色的反锯齿）：
唯一可以得到完美结果的方法是使用GDI +并直接从磁盘文件（而不是 ImageList）读取图标。
这只适用于Vista NOT XP（在旧版本的GDI + GdipCreateBitmapFromHICON和GdipCreateBitmapFromHBITMAP函数中销毁alpha通道 - 它们为每个像素编写alpha = 255）。
procedure TForm1.Button3Click(Sender: TObject);
var
i, num_icons: Integer;
ico: TIcon;
icon: HICON;
encoderClsid: TGUID;
g: TGPGraphics;
in_img: TGPBitmap;
out_img: TGPImage;
begin
num_icons := 24;
out_img := TGPBitmap.Create(16 * num_icons , 16, PixelFormat32bppARGB);
for i := 1 to num_icons do
begin
// does not produce correct bitmap:
//ico := TIcon.Create;
//ImageList1.GetIcon(i - 1, ico);
//in_img := TGPBitmap.Create(ico.Handle);
in_img := TGPBitmap.Create('D:DelphiProjectsIconsIcon_' + inttostr(i) + '.ico');
g := TGPGraphics.Create(out_img);
g.DrawImage(in_img, (i - 1) * 16, 0);
g.Free;
in_img.Free;
end;
GetEncoderClsid('image/bmp', encoderClsid);
out_img.Save('output.bmp', encoderClsid);
out_img.Free;
ImageList2.DrawingStyle := dsTransparent;
// Load from file:
ImageList2.Handle := ImageList_LoadImage(0, 'output.bmp', 16, ImageList2.AllocBy,
CLR_NONE, IMAGE_BITMAP, LR_CREATEDIBSECTION or LR_LOADTRANSPARENT
or LR_LOADFROMFILE);
end;
我所有尝试从图像列表直接加载图标失败并导致消除锯齿的位图。
这里是一个链接，下载我正在使用的图标
下面是另一张图片来说明输出位图结果：
我想我终于做到了。 仍然需要缠绕，但它适用于我。 关键是将图标位图复制到目标扫描线，而不是将图标绘制到目标画布。
procedure CopyBitmapChannels(Src, Dst: TBitMap; DstOffset: Integer);
var
pscanLine32Src, pscanLine32Dst: pRGBQuadArray;
nScanLineCount, nPixelCount: Integer;
begin
with Src do
begin
for nScanLineCount := 0 to Height - 1 do
begin
pscanLine32Src := Scanline[nScanLineCount];
pscanLine32Dst := Dst.Scanline[nScanLineCount];
for nPixelCount := 0 to Width - 1 do
with pscanLine32Src[nPixelCount] do
begin
pscanLine32Dst[nPixelCount + DstOffset].rgbReserved := rgbReserved;
pscanLine32Dst[nPixelCount + DstOffset].rgbRed := rgbRed;
pscanLine32Dst[nPixelCount + DstOffset].rgbGreen := rgbGreen;
pscanLine32Dst[nPixelCount + DstOffset].rgbBlue := rgbBlue;
end;
end;
end;
end;
procedure TForm1.Button2Click(Sender: TObject);
var
h_Bitmap, h_Mask: HBITMAP;
bm_out, bm_ico: TBitmap;
hico : HICON;
icoInfo: TIconInfo;
i, icon_size, num_icons: Integer;
in_IL: TImageList;
begin
// in_IL := ImageList1; // imagelist ready with 32 bit icons
in_IL := nil; // from files
icon_size := 16;
num_icons := 24;
bm_out := TBitmap.Create;
bm_out.Width := icon_size * num_icons;
bm_out.Height := icon_size;
SetBitmapAlpha(bm_out, 0, 0, 0, 0); // no need to actually modify ScanLines but anyway
for i := 0 to num_icons - 1 do
begin
if in_IL = nil then
hico := LoadImage(0, PChar('D:DelphiProjectsIconsIcon_' + inttostr(i + 1) + '.ico'), IMAGE_ICON, 0, 0,
LR_LOADFROMFILE or LR_LOADTRANSPARENT or LR_CREATEDIBSECTION)
else
hico := ImageList_GetIcon(in_IL.Handle, i, ILD_TRANSPARENT); // RGB is slightly changed - not 100% perfect but close enough!
// get icon info (hbmColor -> bitmap)
GetIconInfo(hico, icoInfo);
bm_ico := TBitmap.Create;
h_Bitmap := CopyImage(icoInfo.hbmColor, IMAGE_BITMAP, 0, 0, {LR_COPYDELETEORG or} LR_COPYRETURNORG or LR_CREATEDIBSECTION);
bm_ico.Handle := h_Bitmap;
CopyBitmapChannels(bm_ico, bm_out, i * icon_size);
DestroyIcon(hico);
DeleteObject(h_Bitmap);
bm_ico.Free;
end;
bm_out.SaveToFile('output.bmp');
bm_out.Free;
// output.bmp is now ready to load with ImageList_LoadImage
end;
顺便说一句，我可以像这样复制GetImageBitmap句柄： ImageList_GetImageInfo(ImageList1.Handle, 0, Info); h_Bitmap := CopyImage(Info.hbmImage, IMAGE_BITMAP, 0, 0, LR_COPYRETURNORG) ImageList_GetImageInfo(ImageList1.Handle, 0, Info); h_Bitmap := CopyImage(Info.hbmImage, IMAGE_BITMAP, 0, 0, LR_COPYRETURNORG)但在任何情况下， ImageList_LoadImage都不能使用它。
使用32位DIB部分创建您的图像列表。
ImageList1.Handle :=ImageList_Create(16, 16, ILC_COLOR32 ,4, 4);
要显示包含alpha通道信息的位图，您可以使用AlphaBlend函数或GDI +函数。
uses CommCtrl;
Procedure DisplayAlphaChanelBitmap(BMP:TBitmap;C:TCanvas;X,Y:Integer);
var
BF:TBlendFunction;
begin
BF.BlendOp := AC_SRC_OVER;
BF.BlendFlags := 0;
BF.SourceConstantAlpha := 255;
BF.AlphaFormat := AC_SRC_ALPHA;
Windows.AlphaBlend(C.Handle, x, y, BMP.Width, BMP.Height, BMP.Canvas.Handle
, 0, 0, BMP.Width, BMP.Height, BF)
end;
您将不得不提供适当的句柄类型和字母格式（在较新的Delphiversions上）
对于你的位图，你将不得不清理扫描线，之后绘图将工作预期。
type
pRGBQuadArray = ^TRGBQuadArray;
TRGBQuadArray = ARRAY [0 .. 0] OF TRGBQuad;
TRefChanel=(rcBlue,rcRed,rcGreen);
procedure SetBitmapAlpha(ABitmap: TBitMap; Alpha, ARed, Green, Blue: Byte);
var
pscanLine32: pRGBQuadArray;
nScanLineCount, nPixelCount : Integer;
begin
with ABitmap do
begin
PixelFormat := pf32Bit;
HandleType := bmDIB;
ignorepalette := true;
// alphaformat := afDefined; not available with D5 and D7
for nScanLineCount := 0 to Height - 1 do
begin
pscanLine32 := Scanline[nScanLineCount];
for nPixelCount := 0 to Width - 1 do
with pscanLine32[nPixelCount] do begin
rgbReserved := Alpha;
rgbBlue := Blue;
rgbRed := ARed;
rgbGreen := Green;
end;
end;
end;
end;
提取图标并将它们绘制成透明的位图
procedure TForm1.Button3Click(Sender: TObject);
var
BMP:TBitMap;
ICO:TIcon;
I: Integer;
begin
BMP:=TBitMap.Create;
BMP.Width := Imagelist1.Width * Imagelist1.Count;
BMP.Height := Imagelist1.Height;
try
SetBitmapAlpha(BMP,0,0,0,0);
for I := 0 to Imagelist1.Count-1 do
begin
ICO:=TIcon.Create;
try
Imagelist1.GetIcon(i,ICO);
BMP.Canvas.Draw(i * Imagelist1.Width, 0, ico);
finally
ICO.Free;
end;
end;
BMP.SaveToFile('C:TempTransparent.bmp');
Canvas.Pen.Width := 3;
Canvas.Pen.Color := clRed;
Canvas.MoveTo(10,15);
Canvas.LineTo(24*16+10,15);
DisplayAlphaChanelBitmap( BMP, Canvas , 10 , 10)
finally
BMP.Free;
end;
end;
使用带有非透明图标的Delphi 5或Delphi 7
如果您正在加载ICO，如图所示
ImageList1.Handle := ImageList_LoadImage(MainInstance, 'MyBitmap32', 16, ImageList1.AllocBy,
CLR_NONE, IMAGE_BITMAP, LR_CREATEDIBSECTION or LR_LOADTRANSPARENT);
图标本身不包含透明度信息，所有的绘画都是由蒙版完成的。 所以你可以在这里用一个“神奇”的颜色来填充你的位图clFuchsia（C_R，C_G，C_B），绘制你的图标，并为所有不包含“魔术”颜色的像素设置Alpha通道为255。
const
C_R=255;
C_G=0;
C_B=255;
procedure AdaptBitmapAlphaByColor(ABitmap: TBitMap; ARed, AGreen, ABlue: Byte);
var
pscanLine32: pRGBQuadArray;
nScanLineCount, nPixelCount : Integer;
begin
with ABitmap do
begin
for nScanLineCount := 0 to Height - 1 do
begin
pscanLine32 := Scanline[nScanLineCount];
for nPixelCount := 0 to Width - 1 do
with pscanLine32[nPixelCount] do
begin
if NOT (
(rgbBlue = ABlue)
AND (rgbRed = ARed)
AND (rgbGreen = AGreen)
) then rgbReserved := 255;
end;
end;
end;
end;
procedure TForm1.Button3Click(Sender: TObject);
var
BMP:TBitMap;
ICO:TIcon;
I: Integer;
begin
BMP:=TBitMap.Create;
BMP.Width := Imagelist1.Width * Imagelist1.Count;
BMP.Height := Imagelist1.Height;
try
SetBitmapAlpha(BMP,0,C_R,C_G,C_B);
for I := 0 to Imagelist1.Count-1 do
begin
ICO:=TIcon.Create;
try
Imagelist1.GetIcon(i,ICO);
BMP.Canvas.Draw(i * Imagelist1.Width, 0, ico);
finally
ICO.Free;
end;
end;
AdaptBitmapAlphaByColor(BMP, C_R, C_G, C_B);
BMP.SaveToFile('C:TempTransparent.bmp');
finally
BMP.Free;
end;
end;
Delphi内部附带的ImageList组件已经将其所有图像存储在一个大的位图中。 你可以访问这个位图，尽管它可以通过调用来检索
ImageList1.GetImageBitmap
编辑：经过一番思考和尝试，我必须承认，我推荐的方法并不好。 为什么？ 访问ImageList的内部位图可能不是最好的想法，因为图像列表在不同的Delphi版本中如何处理图像列表似乎存在一些不一致。 这意味着任何在Delphi当前版本中工作的代码在将来的版本中都可能不再适用。
现在，如果我只检查Delphi 7中ImageList图像存储在多行中的区别和Delphi XE3中ImageList图像存储在单个列中的区别，这意味着您的代码需要考虑到这一点。
如果有人想进一步研究这种方法，那么这是我用于将ImageList内部图像内容展示给文件的方法：
var Bitmap: TBitmap;
begin
Bitmap := TBitmap.Create;
Bitmap.Handle := ImageList1.GetImageBitmap;
Bitmap.SaveToFile('D:Proba.bmp');
Bitmap.ReleaseHandle;
Bitmap.Free;
end;
我创建了保存为位图或PNG的GDI +版本。
第一个技巧是将ImageList转换为GDI +位图：
function ImageListToGPBitmap(SourceImageList: TImageList): TGPBitmap;
var
bmp: TGPBitmap;
g: TGPGraphics;
dc: HDC;
i: Integer;
x: Integer;
procedure GdipCheck(Status: Winapi.GDIPAPI.TStatus);
begin
if Status <> Ok then
raise Exception.CreateFmt('%s', [GetStatus(Status)]);
end;
begin
//Note: Code is public domain. No attribution required.
bmp := TGPBitmap.Create(SourceImageList.Width*SourceImageList.Count, SourceImageList.Height);
GdipCheck(bmp.GetLastStatus);
g := TGPGraphics.Create(bmp);
GdipCheck(g.GetLastStatus);
g.Clear($00000000);
GdipCheck(g.GetLastStatus);
dc := g.GetHDC;
for i := 0 to dmGlobal.imgImages.Count-1 do
begin
x := i*dmGlobal.imgImages.Width;
ImageList_DrawEx(dmGlobal.imgImages.Handle, i, dc,
x, 0, dmGlobal.imgImages.Width, dmGlobal.imgImages.Height,
CLR_NONE, CLR_DEFAULT,
ILD_TRANSPARENT);
end;
g.ReleaseHDC(dc);
g.Free;
Result := bmp;
end;
一旦它是一个位图 ，您可以将其保存为您喜欢的任何格式。 我更喜欢image/png ，但您可以将它保存为image/bmp ：
var
bmp: TGPBitmap;
filename: string;
encoder: TGUID;
begin
if not IsDebuggerPresent then
Exit;
//Get GDI+ Bitmap of the imageList
bmp := ImageListToGPBitmap(dmGlobal.imgImages);
//Save the image to a file
filename := ChangeFileExt(GetTemporaryFilename('imgl', False), '.bmp');
Winapi.GDIPUtil.GetEncoderClsid('image/bmp', {out}encoder);
bmp.Save(filename, encoder);
filename := ChangeFileExt(GetTemporaryFilename('imgl', False), '.png');
Winapi.GDIPUtil.GetEncoderClsid('image/png', {out}encoder);
bmp.Save(filename, encoder);
//Note: Code is public domain. No attribution required.
上一篇: How to export Image list of 32bit icons into single 32bit bitmap file?