Search code examples
delphiwinapibitmapdelphi-xe5dib

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


from a third party component I am receiving a PBitmap which is a pointer to Windows.tagBitmap record.

{ 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}

I would like to convert data contained in this pointer to a regular DIB and save this data to a stream. Just as Graphics.TBitmap.SaveToStream does. So preferably I would like to have a procedure like:

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

I've tried to find information about this structure on MSDN, but none of the headers described there (BITMAPFILEHEADER, BITMAPINFOHEADER etc.) seems to conform tagBITMAP.

Could someone experienced in the matter could help me?

edited: An example in in C \ C++ would also be fine for me.


Solution

  • Here is a draft of the solution. It should help someone to built a proper one with error handling / prettier code etc.

    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 := $4d42;
        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;
    

    Thanks Remy for help and thanks for downvotes to my question. Keep them pouring! :)