How to use correctly TBitmap object to save a file with transparency?

Question

Below is my sample code:

var    lBitmap: TBitmap;
begin
    lBitmap := TBitmap.Create;
    lBitmap.PixelFormat := TPixelFormat.pf32bit;
    lBitmap.Transparent := TRUE; // !

    lBitmap.LoadFromFile( 'd:\temp\bmp32b_300dpi_transparent_400x250.bmp' ); 
    // Bitmap RGB+Alpha created with GIMP  

    // modifications on pixels

    Canvas.Draw(100, 0, lBitmap);
    // Up to this point it is correct, the drawing is painted with transparency

    lBitmap.SaveToFile( 'd:\tmp\after.bmp' ); // after this -> I have lost transparency

    lBitmap.Free;
end;

How to use correctly TBitmap object to save a file with transparency?

Answer 1

It seems to me like TBitmap doesn't support saving bitmaps with alpha channels. And maybe we shouldn't blame the VCL for this, because BMPs with alpha transparency are uncommon. Many applications don't support transparent BMPs.

This being said, I "reverse-engineered" a BMP with alpha channel created in GIMP and wrote the following Delphi routine to produce the very same bitmap:

procedure SaveTransparentBitmap(ABitmap: TBitmap; const AFileName: string);
var
  FS: TFileStream;
  BFH: TBitmapFileHeader;
  BIH: TBitmapV5Header;
  y: Integer;
  sl: PUInt64;
begin

  // ABitmap MUST have the GIMP BGRA format.

  FS := TFileStream.Create(AFileName, fmOpenWrite);
  try

    // Bitmap file header
    FillChar(BFH, SizeOf(BFH), 0);
    BFH.bfType := $4D42;  // BM
    BFH.bfSize := 4 * ABitmap.Width * ABitmap.Height + SizeOf(BFH) + SizeOf(BIH);
    BFH.bfOffBits := SizeOf(BFH) + SizeOf(BIH);
    FS.Write(BFH, SizeOf(BFH));

    // Bitmap info header
    FillChar(BIH, SizeOf(BIH), 0);
    BIH.bV5Size := SizeOf(BIH);
    BIH.bV5Width := ABitmap.Width;
    BIH.bV5Height := ABitmap.Height;
    BIH.bV5Planes := 1;
    BIH.bV5BitCount := 32;
    BIH.bV5Compression := BI_BITFIELDS;
    BIH.bV5SizeImage := 4 * ABitmap.Width * ABitmap.Height;
    BIH.bV5XPelsPerMeter := 11811;
    BIH.bV5YPelsPerMeter := 11811;
    BIH.bV5ClrUsed := 0;
    BIH.bV5ClrImportant := 0;
    BIH.bV5RedMask :=   $00FF0000;
    BIH.bV5GreenMask := $0000FF00;
    BIH.bV5BlueMask :=  $000000FF;
    BIH.bV5AlphaMask := $FF000000;
    BIH.bV5CSType := $73524742; // BGRs
    BIH.bV5Intent := LCS_GM_GRAPHICS;
    FS.Write(BIH, SizeOf(BIH));

    // Pixels
    for y := ABitmap.Height - 1 downto 0 do
    begin
      sl := ABitmap.ScanLine[y];
      FS.Write(sl^, 4 * ABitmap.Width);
    end;

  finally
    FS.Free;
  end;

end;

This write a BITMAPFILEHEADER followed by a BITMAPV5HEADER and the pixel data in BGRA format.

I omit all kinds of error checking. For instance, I don't verify that ABitmap actually has the required format.

Test:

procedure TForm1.FormCreate(Sender: TObject);
var
  bm: TBitmap;
begin
  bm := TBitmap.Create;
  try
    bm.LoadFromFile('C:\Users\Andreas Rejbrand\Desktop\Test.bmp');
    SaveTransparentBitmap(bm, 'C:\Users\Andreas Rejbrand\Desktop\Test2.bmp');
  finally
    bm.Free;
  end;
end;

After this, Test.bmp and Test2.bmp are binary equal.