Search code examples
delphibitmapdib

Delphi DIB with DIB Header into TBitmap


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 !


Solution

  • 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;