Delphi DIB 将 DIB 标头插入 TBitmap

发布于 2024-08-19 23:53:28 字数 921 浏览 6 评论 0原文

我恳请您帮助我解决这个问题:

有一个包含 DIB 数据和 DIBHeader 的字节数组 (data: PByte):


  TDibHeader = record
    size: Cardinal;
    width: Integer;
    height: Integer;
    planes: Word;
    bits: Word;
    compression: Cardinal;
    image_size: Cardinal;
    x_res: Integer;
    y_res: Integer;
    n_colors: Cardinal;
    important_colors: Cardinal;
  end;

如何将 DIB 转换为 TBitmap,同时保持较低的 CPU 使用率?

我试过 http://files.codes- resources.com/fichier.aspx?id=43989&f=GdipApi.pas 没有成功。

我已将 DIB 分配给内存流:


  DibMemStream.Clear;
  DibMemStream.SetSize(header.image_size);
  MoveMemory(DibMemStream.Memory,DibBuffer,header.image_size);

我想应该在 Bitmap.LoadFromMemoryStream(DibMemStream) 之前写入 DIB 标头。不知道在哪里。

有什么想法吗?

谢谢 !

I'm kindly asking you to help me with this problem:

There's a byte array (data: PByte) containing DIB data AND DIBHeader:


  TDibHeader = record
    size: Cardinal;
    width: Integer;
    height: Integer;
    planes: Word;
    bits: Word;
    compression: Cardinal;
    image_size: Cardinal;
    x_res: Integer;
    y_res: Integer;
    n_colors: Cardinal;
    important_colors: Cardinal;
  end;

How to convert DIB to TBitmap while keeping the CPU usage low ?

I've tried http://files.codes-sources.com/fichier.aspx?id=43989&f=GdipApi.pas with no success.

I've assigned DIB to an Memory Stream:


  DibMemStream.Clear;
  DibMemStream.SetSize(header.image_size);
  MoveMemory(DibMemStream.Memory,DibBuffer,header.image_size);

I suppose there should be DIB header written somewhere before Bitmap.LoadFromMemoryStream(DibMemStream). Not sure where.

Any ideas please ?

Thank you !

如果你对这篇内容有疑问,欢迎到本站社区发帖提问 参与讨论,获取更多帮助,或者扫码二维码加入 Web 技术交流群。

扫码二维码加入Web技术交流群

发布评论

需要 登录 才能够评论, 你可以免费 注册 一个本站的账号。

评论(2

み格子的夏天 2024-08-26 23:53:28

我使用以下方案将内存中的图像转换为 TBitmap:

1)填充 TBMPHeader 结构

  TBMPHeader = packed record
    bmfHeader: TBitmapFileHeader;
    bmiHeader: TBitmapInfoHeader;
    bmiColors: {depends on image format, may be absent};
  end;

2)将 BMPHeader + 图像数据写入 MemoryStream

3)使用 TBitmap.LoadFromStream 从 MemoryStream 加载 TBitmap

您似乎已经填充了 bmiHeader 结构。添加 bmfHeader 和(也许)bmiColors。

这是我用来将 256 色灰度内存图像转换为 TBitmap 的代码(很多年前,抱歉,所以没有详细信息):

procedure TksImage.CopyToBitmap(Bitmap: TBitmap);
var
  Stream: TStream;

begin
  Stream:= TMemoryStream.Create;
  try
    SaveToStream(Stream);
    Stream.Position:= 0;
    Bitmap.LoadFromStream(Stream);
  finally
    Stream.Free;
  end;
end;

procedure TksImage.SaveToStream(Stream: TStream);
type
  TBMPHeader = packed record
    bmfHeader: TBitmapFileHeader;
    bmiHeader: TBitmapInfoHeader;
    bmiColors: array[0..255] of TRGBQuad;
  end;

var
  BMPHeader: TBMPHeader;
  N: LongWord;
  I: Integer;

begin
  FillChar(BMPHeader, SizeOf(BMPHeader), 0);
  with BMPHeader.bmfHeader do begin
    bfType:= $4D42; {'BM'}
    bfOffBits:= SizeOf(BMPHeader);
    if FChannels = 4 then Dec(bfOffBits, SizeOf(BMPHeader.bmiColors));
    bfSize:= bfOffBits + LongWord(FImageSize);
  end;
  with BMPHeader.bmiHeader do begin
    biSize:= SizeOf(BMPHeader.bmiHeader);
    biWidth:= FWidth;
    biHeight:= FHeight;
    biPlanes:= 1;
    biBitCount:= 8 * FChannels;
    biCompression:= BI_RGB;
    biSizeImage:= FImageSize;
    {((((biWidth * biBitCount) + 31) and not 31) shr 3) * biHeight;}
  end;
  N:= 0;
  for I:= 0 to 255 do begin
    LongWord(bmpHeader.bmiColors[I]):= N;
    Inc(N, $010101);
  end;
  Stream.Write(BMPHeader, BMPHeader.bmfHeader.bfOffBits);
  Stream.Write(FImageData^, FImageSize);
end;

I have used the following scheme to convert in-memory images to TBitmap:

1) Fill TBMPHeader structure

  TBMPHeader = packed record
    bmfHeader: TBitmapFileHeader;
    bmiHeader: TBitmapInfoHeader;
    bmiColors: {depends on image format, may be absent};
  end;

2) Write BMPHeader + Image Data to MemoryStream

3) Load TBitmap from MemoryStream using TBitmap.LoadFromStream

You seems to have bmiHeader structure filled already. Add bmfHeader and (maybe) bmiColors.

Here is the code I used to convert 256-color grayscale in-memory images to TBitmap (many years ago, sorry, so no details):

procedure TksImage.CopyToBitmap(Bitmap: TBitmap);
var
  Stream: TStream;

begin
  Stream:= TMemoryStream.Create;
  try
    SaveToStream(Stream);
    Stream.Position:= 0;
    Bitmap.LoadFromStream(Stream);
  finally
    Stream.Free;
  end;
end;

procedure TksImage.SaveToStream(Stream: TStream);
type
  TBMPHeader = packed record
    bmfHeader: TBitmapFileHeader;
    bmiHeader: TBitmapInfoHeader;
    bmiColors: array[0..255] of TRGBQuad;
  end;

var
  BMPHeader: TBMPHeader;
  N: LongWord;
  I: Integer;

begin
  FillChar(BMPHeader, SizeOf(BMPHeader), 0);
  with BMPHeader.bmfHeader do begin
    bfType:= $4D42; {'BM'}
    bfOffBits:= SizeOf(BMPHeader);
    if FChannels = 4 then Dec(bfOffBits, SizeOf(BMPHeader.bmiColors));
    bfSize:= bfOffBits + LongWord(FImageSize);
  end;
  with BMPHeader.bmiHeader do begin
    biSize:= SizeOf(BMPHeader.bmiHeader);
    biWidth:= FWidth;
    biHeight:= FHeight;
    biPlanes:= 1;
    biBitCount:= 8 * FChannels;
    biCompression:= BI_RGB;
    biSizeImage:= FImageSize;
    {((((biWidth * biBitCount) + 31) and not 31) shr 3) * biHeight;}
  end;
  N:= 0;
  for I:= 0 to 255 do begin
    LongWord(bmpHeader.bmiColors[I]):= N;
    Inc(N, $010101);
  end;
  Stream.Write(BMPHeader, BMPHeader.bmfHeader.bfOffBits);
  Stream.Write(FImageData^, FImageSize);
end;
爱已欠费 2024-08-26 23:53:28

我已经很长时间没有进行任何 Delphi 编码了,而且我还无法对此进行测试,但是如果您可以提供 DIB 的句柄,那么有一个函数 - hDIBToTBitmap1() - 应该可以在此链接中实现这一点:

http://www.efg2.com/Lab/Library/Delphi/图形/LeadToolsConversions.TXT

It's been a long time since I did any Delphi coding and I've not been able to test this, but if you can provide a handle to the DIB, there's a function - hDIBToTBitmap1() - that should do the trick in this link:

http://www.efg2.com/Lab/Library/Delphi/Graphics/LeadToolsConversions.TXT

~没有更多了~
我们使用 Cookies 和其他技术来定制您的体验包括您的登录状态等。通过阅读我们的 隐私政策 了解更多相关信息。 单击 接受 或继续使用网站,即表示您同意使用 Cookies 和您的相关数据。
原文