1. 技术文章
  2. How to export Image list of 32bit icons into single 32bit bitmap file?

How to export Image list of 32bit icons into single 32bit bitmap file?

由 馋奶兔 提交于 2019-12-03 03:21:36

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 icons and 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;

ImageList component that ships with Delphi internally already stores all its Images in one large bitmap. You can access this bitmap though it's handle wihch you can retrieve by calling 

ImageList1.GetImageBitmap

EDIT: After some thinking and trying I must admit that the approach I recomended is not good. Why? Accesing internal bitmap of ImageList is probably not the best idea as there seems to be some inconsistencies how image list treats its images between different Delphi versions. This means that any such code that works in current version of Delphi may no longer work in future versions.

Now if I only check the difference between Delphi 7 where ImageList images are stored in multiple lines and Delphi XE3 where ImageList images are stored in a single column it means that your code needs to take this into account.

Anywhay this is the approach I used for expoting the ImageList internal image contents to a file if anybody wants to further work on this approach:

var Bitmap: TBitmap;
begin
  Bitmap := TBitmap.Create;
  Bitmap.Handle := ImageList1.GetImageBitmap;
  Bitmap.SaveToFile('D:\Proba.bmp');
  Bitmap.ReleaseHandle;
  Bitmap.Free;
end;

I created the GDI+ version that saves to a Bitmap or PNG.

The first trick is converting the ImageList to a GDI+ Bitmap:

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;

Once it's a Bitmap, you can save it to whatever format you prefer. I prefer image/png, but you can just as well save it to an 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.
标签
Delphi
delphi-7
delphi-5
易学教程内所有资源均来自网络或用户发布的内容，如有违反法律规定的内容欢迎反馈！
该文章没有解决你所遇到的问题?点击提问,说说你的问题,让更多的人一起探讨吧!