Delphi XE8中pf32bit格式TBitmap设置透明后保存失效问题

问题描述 #

升级Delphi应用按钮图片时，现有多个以clFuchsia标记透明区域的位图。编写MakeTransparent过程将对应像素设为透明（转为pf32bit格式），同时通过ExtractImages拆分包含16x16、32x32图标的长位图，但执行bmp.SaveToFile后透明效果丢失。使用Delphi XE8，相关代码如下：

procedure TForm6.MakeTransparent(bmp: TBitmap);
type
  PRGBQuadArray = ^TRGBQuadArray;
  TRGBQuadArray = array[Word] of TRGBQuad;
var
  x: Integer;
  y: Integer;
  line: PRGBQuadArray;
  Alpha : TRGBQuad;
begin
  Alpha.rgbBlue := $FF;
  Alpha.rgbGreen := $FF;
  Alpha.rgbRed := $FF;
  Alpha.rgbReserved := $00;
  bmp.PixelFormat := pf32bit;
  for x := 0 to bmp.Width-1 do
  begin
    for y := 0 to bmp.Height-1 do
    begin
      if bmp.Canvas.Pixels[x, y] = clFuchsia then
      begin
        line := bmp.ScanLine[y];
        line[x] := Alpha;
      end;
    end;
  end;
end;

procedure TForm6.ExtractImages(x: TBitmap);
var
  SourceRect: TRect;
  I: Integer;
  bmp: TBitmap;
  DestinationRect: TRect;
  wh: integer; //width, height
  FileName: string;
begin
  wh := x.Height;
  SourceRect := Rect(0, 0, wh, wh);
  for I := 0 to x.Width div wh do
  begin
    bmp := TBitmap.Create;
    bmp.Width := wh;
    bmp.Height := wh;
    bmp.PixelFormat := Images16bmp.PixelFormat;

    DestinationRect := Rect(i * wh, 0, (i + 1) * wh - 1, wh - 1);
    bmp.Canvas.CopyRect(SourceRect, x.Canvas, DestinationRect);

    MakeTransparent(bmp);
    FileName := Format('%d\%d.bmp', [wh, i]);
    bmp.SaveToFile('D:\Temp\SplitImages\' + FileName);
    bmp.Free;
  end;
end;

// 调用代码
ExtractImages(Images16BMP); //2500x16位图
ExtractImages(Images32BMP); //5000x32位图

问题根源 #

• BMP格式限制：标准BMP不支持Alpha通道透明，仅带调色板的BMP可通过指定透明色实现单色透明。转为pf32bit后，Delphi的SaveToFile不会保留Alpha通道信息，导致透明效果丢失。
• Canvas.Pixels的缺陷：循环中频繁调用bmp.Canvas.Pixels[x,y]会创建临时对象，效率极低，还可能因像素格式转换导致颜色判断错误。
• 像素格式设置错误：新创建位图的PixelFormat继承自Images16bmp.PixelFormat，若原位图不是pf32bit，后续格式转换会引发颜色偏差，影响透明色判断。
• 循环边界错误：for I := 0 to x.Width div wh会多循环一次（整数除法取整后，循环到该值会超出原位图宽度），导致越界操作。

修复方案 #

1. 改用PNG格式保存：PNG原生支持Alpha通道，Delphi XE8自带TPngImage，可将32位位图转为PNG保存，完整保留透明效果。
2. 优化透明色处理：直接通过ScanLine遍历像素，避免使用Canvas.Pixels，并在转为pf32bit后再进行颜色对比。
3. 修正像素格式与循环边界：新位图直接设为pf32bit，调整循环范围避免越界。

修正后的代码 #

procedure TForm6.MakeTransparent(bmp: TBitmap);
type
  PRGBQuadArray = ^TRGBQuadArray;
  TRGBQuadArray = array[Word] of TRGBQuad;
var
  x: Integer;
  y: Integer;
  line: PRGBQuadArray;
  FuchsiaRGB: TRGBQuad;
begin
  // 先将位图转为32位格式
  bmp.PixelFormat := pf32bit;
  // 获取clFuchsia对应的RGB值
  FuchsiaRGB.rgbRed := GetRValue(clFuchsia);
  FuchsiaRGB.rgbGreen := GetGValue(clFuchsia);
  FuchsiaRGB.rgbBlue := GetBValue(clFuchsia);

  // 按行遍历像素，效率更高
  for y := 0 to bmp.Height - 1 do
  begin
    line := bmp.ScanLine[y];
    for x := 0 to bmp.Width - 1 do
    begin
      // 对比RGB值判断是否为透明色
      if (line[x].rgbRed = FuchsiaRGB.rgbRed) and
         (line[x].rgbGreen = FuchsiaRGB.rgbGreen) and
         (line[x].rgbBlue = FuchsiaRGB.rgbBlue) then
      begin
        // 设置Alpha通道为0（完全透明）
        line[x].rgbReserved := 0;
      end;
    end;
  end;
end;

procedure TForm6.ExtractImages(x: TBitmap);
var
  I: Integer;
  bmp: TBitmap;
  DestinationRect: TRect;
  wh: Integer;
  FileName: string;
  png: TPngImage;
begin
  wh := x.Height;
  // 修正循环边界，避免越界
  for I := 0 to (x.Width div wh) - 1 do
  begin
    bmp := TBitmap.Create;
    try
      bmp.Width := wh;
      bmp.Height := wh;
      bmp.PixelFormat := pf32bit; // 直接使用32位格式

      // 定义原位图中要截取的区域
      DestinationRect := Rect(I * wh, 0, (I + 1) * wh, wh);
      // 复制像素到新位图
      bmp.Canvas.CopyRect(Rect(0, 0, wh, wh), x.Canvas, DestinationRect);

      // 处理透明效果
      MakeTransparent(bmp);

      // 使用PNG保存以保留Alpha通道
      png := TPngImage.Create;
      try
        png.Assign(bmp);
        FileName := Format('%d\%d.png', [wh, I]);
        png.SaveToFile('D:\Temp\SplitImages\' + FileName);
      finally
        png.Free;
      end;
    finally
      bmp.Free;
    end;
  end;
end;

内容的提问来源于stack exchange，提问作者Alister