如何正确使用 TBitmap 对象来保存具有透明度的文件？

Question

下面是我的示例代码：

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;

如何正确使用 TBitmap 对象来保存具有透明度的文件？

Answer 1

在我看来，TBitmap不支持使用 alpha 通道保存位图。也许我们不应该为此责怪 VCL，因为具有 alpha 透明度的 BMP 并不常见。许多应用程序不支持透明 BMP。

话虽如此，我“逆向工程”了一个在 GIMP 中创建的带有 alpha 通道的 BMP，并编写了以下 Delphi 例程来生成完全相同的位图：

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;

此写入 aBITMAPFILEHEADER后跟 aBITMAPV5HEADER和 BGRA 格式的像素数据。

我省略了各种错误检查。例如，我不验证ABitmap实际上是否具有所需的格式。

测试：

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;

在此之后，Test.bmp和Test2.bmp是二进制相等的。