TBitmap.SaveToFile меняет растровое изображение - PullRequest
Новая
       31

TBitmap.SaveToFile меняет растровое изображение

3 голосов
/ 19 апреля 2020

Я использую Delphi 10.3.

Этот код работает просто отлично. Он загружает 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;

Вывод этой функции отличается от входного файла. Кажется, здесь изменяется альфа-канал: 

Self.AlphaFormat := afDefined;

Так что, похоже, это не меняет способ отображения растрового изображения, но фактически изменяет растровое изображение и пересчитывает пиксели. Можно ли этого избежать? Я хочу растровое изображение, которое отображается с альфа-прозрачностью, но я хочу, чтобы все пиксели оставались неизменными, как они есть в файле.

1 Ответ

0 голосов
/ 20 апреля 2020

В документации Embarcadero для Vcl.Graphics.TBitmap.TransparentColor прозрачный цвет устанавливается для первого пикселя в данных растрового изображения. Может быть проблема в этом. Программа перезагружает картинку таким образом.

Возможно, этот код поможет вам найти проблему: http://docwiki.embarcadero.com/CodeExamples/Rio/en/TGraphic_ (Delphi)

...