In Delphi, how does TBitmap.Monochrome and .PixelFormat influcence the format of .ScanLine?
Asked Answered
Z

1

8

I want to assign a given buffer with a bitmap in Mono8 format (Monochrome 8 Bits) to a bitmap. I then assign the resulting bitmap to a TImage component to display it. The pictures are screenshots of the resulting display.

The following code works but seems a bit wasteful:

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

I would rather use a bitmap in pf8Bit format which I tried:

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)

If MonoChrome is true, the picture only has about 1/4 of the expected width, the rest is white.

Mono + white

If MonoChrome is false, the picture has the expected width, but the left 1/4 of it is monochrome, the rest contains false colors.

Mono+false colors

I'm obviously missing something, but what?

EDIT: The effect that the bitmap is only 1/4 of the expected size apparently was a side effect of converting it to a JPEG for saving prior to displaying it (code that I did not show above, mea culpa). So the problem was simply that I did not set a monochrome palette for the bitmap.

Zootechnics answered 27/6, 2018 at 16:24 Comment(2)
Some guesswork only: The BITMAPINFO docs may be helpful. Look at the biBitCount and biCompression fields. Looks like 8-bit (grayscale; for black and white Windows bitmaps this is not "monochrome", that's 1-bit only) can be RGB using various bitfields; or RLE-encoded grayscale; or you should fill out the bmiColors table. My guess is one of these (probably the last) is what you want and the table is not set up correctly. The size difference could be because of the monochrome setting, expecting 1bit per pixel.Stunning
Again a downvote without comment. @downvoter: What's your problem with this question, so I can learn?Zootechnics
B
9

Monochrome has sense for pf1bit bitmaps.

Otherwise Monochrome := True changes bitmap format to DDB (pfDevice). Your screen is 32-bit, so call to Scanline caused DibNeeded call and transformation to 32bit, and using of function CopyToBitmapMono8 (intended for 8-bit) filled only 1/4 of screen.

For proper usage of 8-bit bitmaps you have to change standard weird palette (used in the right part of last image) to gray one.

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

And example at efg2 page

Battles answered 27/6, 2018 at 17:38 Comment(1)
Today is a sad day. EFG2 website is not online anymore (domain acquired by scrapyard). I would offer myself to re-host the content of the website but I don't know how to contact the author of the website.Potto

© 2022 - 2024 — McMap. All rights reserved.