如何将 Windows.tagBitmap 保存为完整的 DIB 流式传输？

Question

我收到来自第三方组件的 PBitmap，它是指向 Windows.tagBitmap 记录的指针。

{ Bitmap Header Definition }
  PBitmap = ^TBitmap;
  {$EXTERNALSYM tagBITMAP}
  tagBITMAP = record
    bmType: Longint;
    bmWidth: Longint;
    bmHeight: Longint;
    bmWidthBytes: Longint;
    bmPlanes: Word;
    bmBitsPixel: Word;
    bmBits: Pointer;
  end;
  TBitmap = tagBITMAP;
  {$EXTERNALSYM TBitmap}
  BITMAP = tagBITMAP;
  {$EXTERNALSYM BITMAP}

我想将此指针中包含的数据转换为常规 DIB 并将此数据保存到流中。正如 Graphics.TBitmap.SaveToStream 所做的那样。所以最好我想要一个像这样的程序：

procedure SavetagBitmapAsDIBToStream(const ABitmap: PBitmap; var AStream: TStream);

我试图在 MSDN 上找到有关此结构的信息，但那里描述了 headers 的 none（BITMAPFILEHEADER、BITMAPINFOHEADER 等.) 似乎符合 tagBITMAP.

有这方面经验的人可以帮助我吗？

已编辑： C \ C++ 中的示例对我来说也很好。

Answer 1

使用 Win32 API CreateBitmapIndirect() 函数从您的 tagBITMAP 结构创建 DDB HBITMAP 句柄，然后将 HBITMAP 分配给 [= VCL TBitmap 对象的 15=] 属性并将该对象保存到您的 TStream （它将保存为 DIB）。

uses
  Winapi.Windows, Vcl.Graphics;

procedure SavetagBitmapAsDIBToStream(const ABitmap: PBitmap; var AStream: TStream);
var
  Bmp: Vcl.Graphics.TBitmap;
begin
  Bmp := Vcl.Graphics.TBitmap.Create;
  try
    Bmp.Handle := CreateBitmapIndirect(ABitmap);
    Bmp.HandleType := bmDIB; // optional
    Bmp.SaveToStream(AStream);
  finally
    Bmp.Free;
  end;
end;

Answer 2

这是解决方案的草稿。它应该可以帮助某人构建一个具有错误处理/更漂亮代码等的合适的。

function CreateBitmapInfoStruct(pBmp: PBitmap): TBitmapInfo;
var
  bmi: TBitmapInfo;
  cClrBits: Word;
begin
  cClrBits := pBmp.bmPlanes * pBmp.bmBitsPixel;
  if (cClrBits = 1) then
      cClrBits := 1
  else if (cClrBits <= 4) then
      cClrBits := 4
  else if (cClrBits <= 8) then
      cClrBits := 8
  else if (cClrBits <= 16) then
      cClrBits := 16
  else if (cClrBits <= 24) then
      cClrBits := 24
  else cClrBits := 32;

  bmi.bmiHeader.biSize := sizeof(BITMAPINFOHEADER);
  bmi.bmiHeader.biWidth := pBmp.bmWidth;
  bmi.bmiHeader.biHeight := pBmp.bmHeight;
  bmi.bmiHeader.biPlanes := pBmp.bmPlanes;
  bmi.bmiHeader.biBitCount := pBmp.bmBitsPixel;
  if (cClrBits < 24) then
      bmi.bmiHeader.biClrUsed := (1 shl cClrBits)
  else
    bmi.bmiHeader.biClrUsed := 0;

  bmi.bmiHeader.biCompression := BI_RGB;
  bmi.bmiHeader.biSizeImage := ((bmi.bmiHeader.biWidth * cClrBits + 31) and (not 31)) div 8
      * bmi.bmiHeader.biHeight;
  bmi.bmiHeader.biClrImportant := 0;
  Result := bmi;
end;

procedure SavetagBitmapAsDIBToStream(const ABitmap: PBitmap; AStream: TStream);
var
  pbi: TBitmapInfo;
  lHDC: HDC;
  pbih: BITMAPINFOHEADER ;
  hdr: BITMAPFILEHEADER;
  lpBits: PByte;
  hBMP: HBITMAP;
begin
  pbi := CreateBitmapInfoStruct(ABitmap);
  lHDC := CreateCompatibleDC(0);
  GetMem(lpBits, pbih.biSizeImage);
  hBmp := CreateBitmapIndirect(ABitmap^);
  try
    pbih := pbi.bmiHeader;
    GetDIBits(lHDC, hBMP, 0, pbih.biHeight, lpBits, pbi, DIB_RGB_COLORS);
    hdr.bfType := d42;
    hdr.bfSize := sizeof(BITMAPFILEHEADER) + pbih.biSize + pbih.biClrUsed
          * sizeof(RGBQUAD) + pbih.biSizeImage;
    hdr.bfReserved1 := 0;
    hdr.bfReserved2 := 0;
    hdr.bfOffBits := sizeof(BITMAPFILEHEADER) +
        pbih.biSize + pbih.biClrUsed
        * sizeof (RGBQUAD);

    AStream.Write(hdr, SizeOf(BITMAPFILEHEADER));
    AStream.Write(pbih, SizeOf(BITMAPINFOHEADER) + pbih.biClrUsed * SizeOf(RGBQUAD));
    AStream.Write(lpBits^, pbih.biSizeImage);
  finally
    FreeMem(lpBits);
    DeleteObject(hBMP);
    ReleaseDC(0, lHDC);
  end;
end;

感谢 Remy 的帮助并感谢对我的问题投反对票。让他们倾盆大雨！ :)

如何将 Windows.tagBitmap 保存为完整的 DIB 流式传输？

How to save Windows.tagBitmap to stream as a full DIB?

delphi

winapi

bitmap

delphi-xe5

dib