TBitmap.SaveToFile 正在更改位图

Posted 2023-02-22

【中文标题】TBitmap.SaveToFile 正在更改位图

【英文标题】：TBitmap.SaveToFile is changing a bitmap

【发布时间】：2020-08-02 05:02:00

【问题描述】：

我使用的是 Delphi 10.3。

这段代码运行良好。它加载带有 alpha 通道的 32 位 BMP 并以适当的透明度显示：

Bmp := TBitmap.Create;
Bmp.AlphaFormat := afDefined;
Bmp.LoadFromFile('bbb.bmp');    

Image1.Picture.Assign(Bmp);

Bmp.SaveToFile('uuu.bmp');

但是这段代码消除了透明度：

Bmp := TBitmap.Create;
Bmp.AlphaFormat := afDefined;
Bmp.LoadFromFile('bbb.bmp');

Bmp.SaveToFile('uuu.bmp'); 
Image1.Picture.Assign(Bmp);

为什么？

我什至为 pf32 编写了自己的保护程序：

type TBitmap = class(Vcl.Graphics.TBitmap)
       procedure SaveToFile2(Filename: String);
       procedure LoadFromFile2(Filename: String);
     end;
     PCardinalArray = ^TCardinalArray;
     TCardinalArray = array[0..32767] of Cardinal;

...

procedure TBitmap.SaveToFile2(Filename: String);
var Head: array[0..53] of Byte;
    F: TFileStream;
    Size: Integer;
    P: PCardinalArray;
    y: Integer;
begin
  Size := Width*Height*4 + 54;

  FillChar(Head, 54, 0);

  Head[0] := $42;
  Head[1] := $4D;

  Head[2] := Size and $FF;
  Head[3] := (Size shr 8) and $FF;
  Head[4] := (Size shr 16) and $FF;
  Head[5] := Size shr 24;

  Head[6] := 0;
  Head[7] := 0;
  Head[8] := 0;
  Head[9] := 0;

  Head[10] := 54;
  Head[11] := 0;
  Head[12] := 0;
  Head[13] := 0;

  Head[14] := 40;
  Head[15] := 0;
  Head[16] := 0;
  Head[17] := 0;

  Head[18] := Width and $FF;
  Head[19] := (Width shr 8) and $FF;
  Head[20] := (Width shr 16) and $FF;
  Head[21] :=  Width shr 24;

  Head[22] := Height and $FF;
  Head[23] := (Height shr 8) and $FF;
  Head[24] := (Height shr 16) and $FF;
  Head[25] := Height shr 24;

  Head[26] := 1;
  Head[27] := 0;

  Head[28] := 32;
  Head[29] := 0;

  Head[38] := $12;
  Head[39] := $0B;
  Head[40] := 0;
  Head[41] := 0;

  Head[42] := $12;
  Head[43] := $0B;
  Head[44] := 0;
  Head[45] := 0;

  F := TFileStream.Create(Filename, fmCreate or fmShareDenyWrite);
  F.Write(Head[0], 54);

  for y:=Self.Height-1 downto 0 do begin
    P := Self.ScanLine[y];
    F.Write(P[0], Self.Width*4);
  end;

  F.Free;
end;

我还为 pf32bit 编写了自己的加载器：

procedure TBitmap.LoadFromFile2(Filename: String);
var Head: array[0..53] of Byte;
    F: TFileStream;
    P: PCardinalArray;
    y: Integer;
begin
  F := TFileStream.Create(Filename, fmOpenRead or fmShareDenyWrite);

  FillChar(Head, 54, 0);
  F.Read(Head[0], 54);

  if (F.Size < 54) or (Head[0] <> $42) or (Head[1] <> $4D) or (Head[10] <> 54) or (Head[28] <> 32) then begin
    F.Free;
    Exit;
  end;

  Self.Width := Head[18] + (Head[19] shl 8) + (Head[20] shl 16) + (Head[21] shl 24);
  Self.Height := Head[22] + (Head[23] shl 8) + (Head[24] shl 16) + (Head[25] shl 24);
  Self.PixelFormat := pf32bit;
  Self.AlphaFormat := afIgnored;

  for y:=Self.Height-1 downto 0 do begin
    P := Self.ScanLine[y];
    F.Read(P[0], Self.Width*4);
  end;

  Self.AlphaFormat := afDefined;
  F.Free;
end;

此函数的输出与输入文件不同。似乎这里的 alpha 通道正在更改：

Self.AlphaFormat := afDefined;

所以看起来这并没有改变位图的渲染方式，但它实际上改变了位图并重新计算像素。这可以避免吗？我想要一个以 alpha 透明度显示的位图，但我希望所有像素都保持完整，就像它们在文件中一样。

【问题讨论】：

也许PixelFormat 在保存过程中被更改了？您需要保存的文件来保持透明度，还是只需要TImage？

@RemyLebeau 基本上我想要一个可靠的位图，并且在没有我说的情况下不会进行任何转换。

【参考方案1】：

在 Vcl.Graphics.TBitmap.TransparentColor 的 Embarcadero 文档中，透明颜色设置为位图图像数据中的第一个像素。也许问题就在那里。程序以这种方式重新加载图片。

也许这段代码会帮助你找到问题： http://docwiki.embarcadero.com/CodeExamples/Rio/en/TGraphic_(Delphi)

【讨论】：

TransparentColor 用于非 alpha 透明度。