如何将32位图标的图像列表导出到单个32位位图文件中？

Question

我想写一个小实用程序,它将帮助我从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通道的好位图,可以加载OK ImageList_LoadImage:

带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:\Delphi\Projects\Icons\Icon_' + 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:\Delphi\Projects\Icons\Icon_' + 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_LoadImage.

Answer 1

使用Use a 32-bit 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;

您必须
为您的位图提供适当的句柄类型和 alphaformat（在较新的 Delphiversions 上），并且您必须清理 Scanlines ，之后绘图将按预期工作。

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:\Temp\Transparent.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); 

Icons 本身不包含透明度信息，所有绘制都是由蒙版完成的。因此，您可以在此处用 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:\Temp\Transparent.bmp');
  finally
    BMP.Free;
  end;
end;