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);
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.
If MonoChrome is false, the picture has the expected width, but the left 1/4 of it is monochrome, the rest contains 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.
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;
And example at efg2 page
If you love us? You can donate to us via Paypal or buy me a coffee so we can maintain and grow! Thank you!
Donate Us With