delphi - TBitmap.SaveToFile 正在更改位图

标签 delphi delphi-10.3-rio

我使用Delphi 10.3。

这段代码工作得很好。它加载带有 Alpha channel 的 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 channel 正在更改:

Self.AlphaFormat := afDefined;

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

最佳答案

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

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

关于delphi - TBitmap.SaveToFile 正在更改位图,我们在Stack Overflow上找到一个类似的问题: https://stackoverflow.com/questions/61309826/

相关文章:

delphi - 在ADOQuery中更改当前记录之前会触发哪个事件,以及如何不更改当前记录?

delphi - TCameraComponent 和 TVideoCaptureDevice 未在 Win32 中初始化

delphi - 字符串加密问题

date - 如何获取dll文件的编译日期?

delphi - Delphi中自动取消选中按钮的执行操作

android - 如何生成Android设备的唯一ID?

delphi - 具有 TFormClass 的运算符 IS

delphi - 如何获取方法链接泛型类型的 TRTTIType

delphi - 禁用编辑器选项卡上的关闭图标?

sockets - TServerSocket : How check if a specific client on ListView still is connected before send message?