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

Question

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 functions destroy 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.

Pleading

Create a bitmap with dimensions cx=ImageCount*ImageWidth and cy=ImageHeight. Then draw the icons one by one onto that bitmap, at the obvious locations. – Frambesia

Perhaps TImageList.GetImageBitmap can help here. – Hehre

@UweRaabe, I have tried that, but I get an "out of resources" exception. – Pleading

That returns the bitmap that the image list control is using. You need to copy it. If you assign it to TBitmap.Handle, then both the bitmap and the image list think that they own the same bitmap. – Frambesia

@DavidHeffernan, How do I copy it then? – Pleading

You need to select it into a DC and then call BitBlt. Old school GDI programming. – Frambesia

@David, So you think you can post some code please? I've seen this: #5687763 but not sure how to translate. – Pleading

Translating that is easy. You just call the exact same functions, passing the same parameters. – Frambesia

Does Delphi 5 bitmap component support alpha? Some how I doubt it. – Frambesia

@DavidHeffernan, yes it does. Bummies code worked for me in Delphi 5 with a little effort, but the output bitmap becomes anti-aliased, which is no good. I don't mind a Delphi7 solution either. – Pleading

@Pleading I can't judge finally, from my point of view the the difference still remains between icons loaded from file and icons loaded from the imagelist. But if you found it as your solution you should add it as answer and accept it instead of mine. :) – Firewood

@bummi, yes indeed there is a difference. ImageList_GetIcon does changes the RBG very slightly. I played with all the flags and could not get a 100% result. I think it's better to manage your icons from disk, create the output bitmap, and later use it with ImageList_LoadImage. – Pleading

@bummi, The only 100% accurate way to export an existing imagelist is to use ImageList_Write/ImageList_Read which is how Delphi streams the imagelist in DFM. and that is an also maybe! :) – Pleading

Answer 1

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;

Firewood

No alphaformat in D5, which I suspected was the key to this problem in the first place :( – Pleading

Why would you go and "copy" each image/icon that image list contains seperately to one bitmap in order to compose them all together into one image when ImageList si already storing all its images in one big bitmap whose handle you can retrieve using ImageList1.GetImageBitmap? – Maiocco

I've hacked the AlphaFormat from D2009. Tried both PreMultiplyAlpha and UnPreMultiplyAlpha. The Opacity/Alpha channel/palette (maybe?) is not the same as the ICON. the bitmap is transparent with alpha channel but looks really bad after I load it into the image list via ImageList_LoadImage from the EXE resource. – Pleading

@Maiocco because the bitmap reachable via GetImageBitmap does not contain Alpha informations. – Firewood

@Pleading I'm just experimenting with Windows.AlphaBlend on D7, but here already the Bitmap seems to be in troubles. – Firewood

@bummi, Try to save that bitmap into the EXE resource and load it via ImageList1.DrawingStyle := dsTransparent; ImageList1.Handle := ImageList_LoadImage(MainInstance, 'MyBitmap32', 16, ImageList1.AllocBy, CLR_NONE, IMAGE_BITMAP, LR_CREATEDIBSECTION or LR_LOADTRANSPARENT); You will notice a difference from the original Icons. – Pleading

@zig, I will delete this answer, I did not recognize Delphi 5 early enough, sorry. – Firewood

@bummi, in all your cases (newer Sytems, Delphi5+7) the icon is drawing anti-aliased against the background color (rgb(0,0,0) or clFuchsia) on the transparent bitmap. your test is wrong (drawing the bitmap on the canvas). you should test with ImageList_LoadImage after you created the output bitmap, get an icon from that list, draw it on the canvas, and compare with the original icon. you will notice the difference. – Pleading

and I used D2009 sources (I don't have the compiler) only to implement alphaformat := afDefined which is not available in Delphi5/7. if I read the code correctly I implemented PreMultiplyAlpha to work with older versions. – Pleading

@Pleading example for usage and displaying with your icons is now contained. – Firewood

@Bummi, Thanks for your patience, but i'm afraid your output bitmap is anti-aliased. compare it with the original icons. (see my edit with the last picture) I can even see it clearly in your screenshot i.sstatic.net/mL2XI.png – Pleading

@Pleading , nice puzzle, the error is definitely caused by the imagelist, if you do the painting from the Icon loaded from the file ` //Imagelist1.GetIcon(i,ICO); ICO.LoadFromFile(Format('Z:\sepa\ico\Icon_%d.ico',[i+1])); BMP.Canvas.Draw(i * Imagelist1.Width, 0, ico); ` anything is fine. From Icon: imgur.com/IMiRcWH from imagelist: imgur.com/IeP5tkP – Firewood

@Bummy, maybe try hico := ImageList_GetIcon and DrawIconEx(BMP.Canvas.Handle, i * 16, 0, hico, 0, 0, 0, 0, DI_NORMAL); – Pleading

BTW, Does the alphaformat := afDefined even needed here? – Pleading

@Pleading tried different variants of loading and painting with API functions and different combinations of getting an imagelist handle, no success till no. afdefined will not be needed here, the bitmap is not the problem, it's the extracted icon, the effects of afdefined are shown here https://mcmap.net/q/1625197/-how-to-display-a-tbitmap-with-alpha-channel-on-timage-correctly – Firewood

I think I finally got it, please tell me if you have any comments on my solution. Thank you for all your help. could not have done it without you. – Pleading

Answer 2

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;

Maiocco

That's an HBITMAP that you must not call DeleteObject on. So it takes a little effort to use that bitmap without calling DeleteObject. You should expand on that. – Frambesia

When I use bmp := TBitmap.Create; bmp.Handle := ImageList10.GetImageBitmap; bmp.SaveToFile('1.bmp'); I get an exception Out of system resources – Pleading

@Silver It's more complicated than you say. You need to do more. – Frambesia

I have used this in the past, but I can't seem to find the full code that I used then. I abandoned the use of this becouse I switched to another component which offered me more features that I required. – Maiocco

What do you do with the HBITMAP? – Frambesia

@DavidHeffernan, even if you do manage to use GetImageBitmap (I did with 24bit imagelist), the output bitmap is vertical and cannot be loaded via ImageList_LoadImage. – Pleading

@Maiocco Are you following this? – Frambesia

@DavidHeffernan, and funny enough the imagelist stream ImageList_Write/ImageList_Read holds the bitmaps in the same vertical way (there is a IL header but the bitmap is there). bitmap is also anti-aliased. as if there is an extra mask bitmap in any case... I don't think Silver ever used it with ImageList_LoadImage – Pleading

I don't think SilverWarrior seems interested in the fine details which make all the difference here. This answer should be a comment. – Frambesia

I'm still folowing this. Today I'll try to redo the approach I used in the past and post more details about it here – Maiocco

The same error Out of system resources. Have you tried this code with 32bit icons? – Pleading

Maybe newer versions do not destroy the HBITMAP handle. I could copy this handle like this: ImageList_GetImageInfo(ImageList1.Handle, 0, Info); h_Bitmap := CopyImage... but in any case it is not usable later with ImageList_LoadImage – Pleading

Answer 3

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.

Scaife