В Delphi как TBitmap.Monochrome и .PixelFormat влияют на формат .ScanLine? - PullRequest
0 голосов
/ 27 июня 2018

Я хочу назначить данный буфер с битовой картой в формате Mono8 (Monochrome 8 Bits) для битовой карты. Затем я назначаю полученное растровое изображение компоненту TImage, чтобы отобразить его. Изображения являются скриншотами полученного изображения.

Следующий код работает, но кажется немного расточительным:

procedure CopyToBitmapMono824(_Buffer: PByte; _Bmp: TBitmap);
var
  y: Integer;
  x: Integer;
  ScanLine: PdzRgbTripleArray;
begin
  for y := 0 to _Bmp.Height - 1 do begin
    ScanLine := _Bmp.ScanLine[y];
    for x := 0 to _Bmp.Width - 1 do begin
      // monochrome: all 3 colors set to the same value
      ScanLine[x].Red := _Buffer^;
      ScanLine[x].Green := _Buffer^;
      ScanLine[x].Blue := _Buffer^;
      Inc(_Buffer);
    end;
  end;
end;

// [...]
fBmp.PixelFormat := pf24Bit;
FBmp.Monochrome := False;
CopyToBitmap(Buffer, fBmp);

correct gray scale image

Я бы предпочел использовать растровое изображение в формате pf8Bit, которое я пробовал:

procedure CopyToBitmapMono8(_Buffer: PByte; _Bmp: TBitmap);
var
  y: Integer;
  x: Integer;
  ScanLine: PByteArray;
begin
  for y := 0 to _Bmp.Height - 1 do begin
    ScanLine := _Bmp.ScanLine[y];
    for x := 0 to _Bmp.Width - 1 do begin
      ScanLine[x] := _Buffer^;
      Inc(_Buffer);
    end;
  end;
end;

// [...]
FBmp.PixelFormat := pf8bit;
FBmp.Monochrome := False; // I also tried Monochrome := true
CopyToBitmapMono8(Buffer, FBmp)

Если MonoChrome имеет значение true, изображение имеет только около 1/4 ожидаемой ширины, остальное - белый.

Mono + white

Если MonoChrome имеет значение false, изображение имеет ожидаемую ширину, но левая 1/4 - монохромная, остальные содержат ложные цвета.

Mono+false colors

Я явно что-то упускаю, но что?

РЕДАКТИРОВАТЬ: Эффект, что растровое изображение составляет только 1/4 от ожидаемого размера, по-видимому, был побочным эффектом преобразования его в JPEG для сохранения перед его отображением (код, который я не показывал выше, mea culpa). Поэтому проблема была в том, что я не установил монохромную палитру для растрового изображения.

1 Ответ

0 голосов
/ 27 июня 2018

Monochrome имеет смысл для pf1bit растровых изображений.

В противном случае Monochrome := True изменяет формат растрового изображения на DDB (pfDevice). Ваш экран 32-битный, поэтому вызов Scanline вызвал DibNeeded вызов и преобразование в 32-битный, а использование функции CopyToBitmapMono8 (предназначено для 8-бит) заполнило только 1/4 экрана.

Для правильного использования 8-битных растровых изображений вы должны изменить стандартную странную палитру (используется в правой части последнего изображения) на серую.

procedure CopyToBitmapMono8(_Buffer: PByte; _Bmp: TBitmap);
var
  y: Integer;
  x: Integer;
  ScanLine: PByteArray;
begin
  for y := 0 to _Bmp.Height - 1 do begin
    ScanLine := _Bmp.ScanLine[y];
    for x := 0 to _Bmp.Width - 1 do begin
      ScanLine[x] := _Buffer^;
      Inc(_Buffer);
    end;
  end;
end;

var
   FBmp: TBitmap;
   Buffer: PbyteArray;
   i: integer;
begin
  GetMem(Buffer, 512 * 100);
  for i := 0 to 512 * 100 - 1 do
     Buffer[i] := (i and 511) div 2; // gray gradient

  FBmp := Tbitmap.Create;
  FBmp.Width := 512;
  FBmp.Height := 100;
  FBmp.PixelFormat := pf8bit;
  CopyToBitmapMono8(PByte(Buffer), FBmp);
  Canvas.Draw(0, 0, FBmp);

  //now right approach
  FBmp.Palette := MakeGrayPalette; // try to comment
  CopyToBitmapMono8(PByte(Buffer), FBmp);
  Canvas.Draw(0, 110, FBmp);

end;

function TForm1.MakeGrayPalette: HPalette;
var
  i: integer;
  lp:  TMaxLogPalette;
begin
  lp.palVersion    := $300;
  lp.palNumEntries := 256;
  for i := 0 TO 255 do begin
     lp.palPalEntry[i].peRed   := i;
     lp.palPalEntry[i].peGreen := i;
     lp.palPalEntry[i].peBlue  := i;
     lp.palPalEntry[i].peFlags := PC_RESERVED;
   end;
   Result := CreatePalette(pLogPalette(@lp)^);
end;

enter image description here

И пример на странице efg2

...