首页
学习
活动
专区
圈层
工具
发布
社区首页 >问答首页 >在Delphi中,TBitmap.Monochrome和.PixelFormat是如何影响.ScanLine格式的?

在Delphi中,TBitmap.Monochrome和.PixelFormat是如何影响.ScanLine格式的?
EN

Stack Overflow用户
提问于 2018-06-27 16:24:13
回答 1查看 2.1K关注 0票数 8

我希望为位图分配一个具有Mono8格式(单色8位)位图的给定缓冲区。然后,我将结果位图分配给一个TImage组件来显示它。这些图片是结果显示的屏幕截图。

以下代码工作正常,但似乎有点浪费:

代码语言:javascript
复制
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);

我宁愿使用pf8Bit格式的位图,我试过这样做:

代码语言:javascript
复制
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为真,则图片只有预期宽度的1/4左右,其余为白色。

如果monochrome是假的,则图片具有预期的宽度,但左边的1/4是单色,其余的则包含假颜色。

我显然遗漏了什么,但是什么?

编辑:位图仅为预期大小的1/4,这显然是将其转换为JPEG以在显示之前保存的副作用(我上面没有显示的代码,意味着过失)。所以问题很简单,我没有为位图设置单色调色板。

EN

回答 1

Stack Overflow用户

回答已采纳

发布于 2018-06-27 17:38:20

Monochromepf1bit位图有意义。

否则,Monochrome := True将位图格式更改为DDB (pfDevice)。您的屏幕是32位,所以对Scanline的调用导致DibNeeded调用并转换为32位,而使用函数CopyToBitmapMono8 (用于8位)只填充了屏幕的1/4。

为了正确使用8位位图,您必须将标准的怪异调色板(在上一张图像的右侧)更改为灰色调色板。

代码语言:javascript
复制
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;

以及efg2页面上的示例

票数 8
EN
页面原文内容由Stack Overflow提供。腾讯云小微IT领域专用引擎提供翻译支持
原文链接:

https://stackoverflow.com/questions/51067460

复制
相关文章

相似问题

领券
问题归档专栏文章快讯文章归档关键词归档开发者手册归档开发者手册 Section 归档