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

问题描述

我想编写一个小实用程序，可以帮助我从EXE资源加载单个32位位图（带有alpha）：

  ImageList1.DrawingStyle：= dsTransparent; 
 ImageList1.Handle：= ImageList_LoadImage（MainInstance，'MyBitmap32'，16，ImageList1.AllocBy，
 CLR_NONE，IMAGE_BITMAP，LR_CREATEDIBSECTION或LR_LOADTRANSPARENT）; 
  

上面的方法效果很好。

因此，要生成该位图，我需要从磁盘（带有alpha）将32位透明图标加载到ImageList中。

  for i：= 1到10做... ImageList2.AddIcon（AIcon）
  

现在，如何从该图像列表中导出32位图（将是透明的并具有alpha通道）并将其保存为如下所示的文件：

这是我的尝试。但是输出的位图看起来不透明，并且不维护Alpha通道：

 过程PrepareBitmap（bmp：TBitmap）; 
 var 
 pscanLine32：pRGBQuadArray; 
 i，j：整数； 
 for i开始
：= 0到bmp.Height-1做
开始
 pscanLine32：= bmp.Scanline [i]; 
 for j：= 0到bmp.Width-1 
开始
 pscanLine32 [j] .rgbReserved：= 0; 
结尾； 
结尾； 
结尾； 
 
过程TForm1.Button4Click（Sender：TObject）; 
 var 
 bmp：TBitmap； 
 I：整数； 
 IL：TImageList； 
开始
 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）; //透明
 PrepareBitmap（bmp）; I的
：= 0到IL.Count-1做
开始
 IL.Draw（bmp.Canvas，（I * 16），0，I，True）; 
结尾； 
 bmp.SaveToFile（'2.bmp'）; 
结尾； 
  

请注意，即使您设法使用 GetImageBitmap （我对24bit imagelist进行过处理），输出位图是垂直的，无法通过 ImageList_LoadImage 加载：

即使在给定的代码中通过Bummi，输出位图变得抗锯齿，这是不好的。这是一个示例（缩放比例为800％-仅前3个图标）：

Good 具有Alpha通道的位图，将使用<$加载OK c $ c> ImageList_LoadImage ：

不良具有Alpha通道的位图（注意黑色的抗锯齿）：

我能获得完美的唯一方法结果是使用GDI +并直接从磁盘文件（否 ImageList）中读取图标。

这仅在Vista 否 XP（旧版本）上有效版本的GDI + GdipCreateBitmapFromHICON 和 GdipCreateBitmapFromHBITMAP 版本
销毁alpha通道-它们为每个像素写alpha = 255

 过程TForm1.Button3Click（Sender：TObject）; 
 var 
 i，num_icons：整数; 
 ico：TIcon； 
图标：HICON； 
 
编码器Clsid：TGUID; 
 g：TGPGraphics； 
 in_img：TGPBitmap； 
 out_img：TGPImage; 
开始
 num_icons：= 24; 
 out_img：= TGPBitmap.Create（16 * num_icons，16，PixelFormat32bppARGB）; 
 
 for i：= 1到num_icons会执行
开始
 //不产生正确的位图：
 // 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。免费； 
 in_img。免费； 
结尾； 
 
 GetEncoderClsid（’image / bmp’，encoderClsid）； 
 out_img.Save（’output.bmp’，encodedClsid）； 
 out_img。免费； 
 
 ImageList2.DrawingStyle：= dsTransparent; 
 //从文件加载：
 ImageList2.Handle：= ImageList_LoadImage（0，'output.bmp'，16，ImageList2.AllocBy，
 CLR_NONE，IMAGE_BITMAP，LR_CREATEDIBSECTION或LR_LOADTRANSPARENT 
或LR_LOADFROMFILE）; 
结尾； 
  

我所有直接从Imagelist加载图标的尝试都失败了，并导致了抗锯齿位图。

  ImageList1.Handle：= ImageList_Create（16，16，ILC_COLOR32，4，4）; 
  

要显示包含Alpha通道信息的位图，可以使用或GDI +函​​数。

 使用CommCtrl; 
 
过程DisplayAlphaChanelBitmap（BMP：TBitmap; C：TCanvas; X，Y：Integer）; 
 var 
 BF：TBlendFunction; 
开始
 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）
结尾； 
  

您将必须提供适当的句柄类型和alphaformat（在较新的Delphiversions上）

作为位图，您将必须清洁Scanlines，之后绘图才能正常工作。

  type 
 pRGBQuadArray = ^ TRGBQuadArray; 
 TRGBQuadArray = TRGBQuad的数组[0 .. 0]； 
 TRefChanel =（rcBlue，rcRed，rcGreen）; 
 
过程SetBitmapAlpha（ABitmap：TBitMap; Alpha，ARed，Green，Blue：Byte）; 
 var 
 pscanLine32：pRGBQuadArray; 
 nScanLineCount，nPixelCount：整数; 
以ABitmap开始
做
开始
 PixelFormat：= pf32Bit; 
 HandleType：= bmDIB; 
 ignorepalette：= true; 
 // alphaformat：= afDefined;不适用于D5和D7 nScanLineCount的
：= 0到高度-1做
开始
 pscanLine32：= Scanline [nScanLineCount]; 
 for nPixelCount：= 0到宽度-1用pscanLine32 [nPixelCount]做
开始
 rgbReserved：= Alpha; 
 rgbBlue：=蓝色; 
 rgbRed：= ARed; 
 rgbGreen：=绿色; 
结尾； 
结尾； 
结尾； 
结尾； 
  

提取图标并将其绘制为透明位图

 程序TForm1.Button3Click（Sender：TObject）; 
 var 
 BMP：TBitMap; 
 ICO：TIcon； 
 I：整数； 
开始
 BMP：= TBitMap.Create; 
 BMP.Width：= Imagelist1.Width * Imagelist1.Count; 
 BMP.Height：= Imagelist1.Height; 
试试
 SetBitmapAlpha（BMP，0,0,0,0）; 
 for I：= 0到Imagelist1.Count-1做
开始
 ICO：= TIcon.Create; 
试试
 Imagelist1.GetIcon（i，ICO）; 
 BMP.Canvas.Draw（i * Imagelist1.Width，0，ico）;复制代码
最终
 ICO。免费; 
结尾； 
结尾； 
 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）
最后
 BMP.Free; 
结尾； 
结尾； 
  

使用带有非透明图标的Delphi 5或Delphi 7

如果正在加载ICO，如图所示

  ImageList1.Handle：= ImageList_LoadImage（MainInstance，'MyBitmap32'，16，ImageList1.AllocBy，
 CLR_NONE，IMAGE_BITMAP，LR_CREATEDIBSECTION或LR_LOADTRANSPARENT）； 
  

图标本身不包含透明度信息，所有绘画均由遮罩完成。
因此，您可以在此处用魔术颜色填充位图clFuchsia（C_R，C_G，C_B），绘制图标
并将所有不包含魔术颜色的像素的Alpha通道设置为255

  const 
 C_R = 255; 
 C_G = 0; 
 C_B = 255; 
 
 
 
程序AdaptBitmapAlphaByColor（ABitmap：TBitMap; ARed，AGreen，ABlue：Byte）; 
 var 
 pscanLine32：pRGBQuadArray; 
 nScanLineCount，nPixelCount：整数; 
以ABitmap开始
进行
 nScanLineCount开始
：= 0到Height-1 
开始
开始
 pscanLine32：= Scanline [nScanLineCount]; 
 for nPixelCount：= 0到宽度-1用pscanLine32 [nPixelCount]做
如果不是（
（rgbBlue = ABlue）
 AND （rgbRed = ARed）
 AND（rgbGreen = AGreen）
）然后rgbReserved：= 255; 
结尾； 
结尾； 
结尾； 
结尾； 
 
过程TForm1.Button3Click（Sender：TObject）; 
 var 
 BMP：TBitMap; 
 ICO：TIcon； 
 I：整数； 
开始
 BMP：= TBitMap.Create; 
 BMP.Width：= Imagelist1.Width * Imagelist1.Count; 
 BMP.Height：= Imagelist1.Height; 
试试
 SetBitmapAlpha（BMP，0，C_R，C_G，C_B）; 
 for I：= 0到Imagelist1.Count-1做
开始
 ICO：= TIcon.Create; 
试试
 Imagelist1.GetIcon（i，ICO）; 
 BMP.Canvas.Draw（i * Imagelist1.Width，0，ico）;复制代码
最终
 ICO。免费; 
结尾； 
结尾； 
 AdaptBitmapAlphaByColor（BMP，C_R，C_G，C_B）; 
 BMP.SaveToFile（'C：\Temp\Transparent.bmp'）; 
最终
 BMP。免费； 
结尾； 
结尾； 
  

I want to write a small utility which will help me load a single 32bit bitmap (with alpha) from a EXE resource:

ImageList1.DrawingStyle := dsTransparent;
ImageList1.Handle := ImageList_LoadImage(MainInstance, 'MyBitmap32', 16, ImageList1.AllocBy,
    CLR_NONE, IMAGE_BITMAP, LR_CREATEDIBSECTION or LR_LOADTRANSPARENT);

The above works well.

So to generate that bitmap, I'm loading 32 bit transparent icons from my disk (with alpha) into an ImageList

for i := 1 to 10 do ... ImageList2.AddIcon(AIcon)

Now, how do I export the 32 bitmap (which will be transparent and have the alpha channel) from this image list and save it as a file which should looks like this:

Here is my attempt. But the output bitmap does NOT look transparent and does not maintain the alpha channel:

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;

Note that even if you I manage to use GetImageBitmap (I did with 24bit imagelist), the output bitmap is vertical and cannot be load via ImageList_LoadImage:

Even in the code given by Bummi the output bitmap becomes anti-aliased which is no good. here is an example (with 800% zoom - only first 3 icons):

Good bitmap with alpha channel which will load OK with ImageList_LoadImage:

Bad bitmap with alpha channel (notice the anti-alias with black):

The Only way I could get perfect results was with GDI+ and reading the icons directly from disk files (NOT the ImageList).
This Only works ok on Vista NOT XP (in older versions of GDI+ GdipCreateBitmapFromHICON and GdipCreateBitmapFromHBITMAP functionsdestroy alpha channel - they write alpha=255 for each pixel).

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;

All my attempts to load the Icons from the Imagelist directly, failed and resulted anti-aliased bitmaps.

Here is a link to download the icons I'm working with

And here is another picture to illustrate the output bitmap results:

I think I made it work finally. still needs twining but it works for me. the key is to copy the icons bitmaps to the destination scanlines, instead of drawing the icons to the destination canvas.

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;

BTW, I could copy GetImageBitmap handle like this: ImageList_GetImageInfo(ImageList1.Handle, 0, Info); h_Bitmap := CopyImage(Info.hbmImage, IMAGE_BITMAP, 0, 0, LR_COPYRETURNORG) but in any case it is not usable later with ImageList_LoadImage.

解决方案

Create your imagelist using a Use a 32-bit DIB section.

ImageList1.Handle :=ImageList_Create(16, 16, ILC_COLOR32 ,4, 4);

To display Bitmaps containing alpha channel information you may use the AlphaBlend function or GDI+ functions.

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;

You will have to provide the appropriate handle type and alphaformat (on newer Delphiversions)
for your bitmap and you will have to clean the Scanlines , afterwards drawing will work es expected.

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;

Extract the icons and paint them to thm transparent bitmap

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;

Using Delphi 5 or Delphi 7 with non transparent icons

If you are loading ICO's as shown with

ImageList1.Handle := ImageList_LoadImage(MainInstance, 'MyBitmap32', 16, ImageList1.AllocBy,
        CLR_NONE, IMAGE_BITMAP, LR_CREATEDIBSECTION or LR_LOADTRANSPARENT);

The Icons itself do not contain transparency informations, all painting is done by the mask.So you could fill your Bitmap with a "magic" color here clFuchsia (C_R, C_G, C_B), paint your iconsand set the Alpha channel for all Pixels not containg the "magic" color to 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;

这篇关于如何将32位图标的图像列表导出到单个32位位图文件中？的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持！