Delphi DIB مع DIB Header في tbitmap

Question

أنا أتفضل أن تساعدني في هذه المشكلة:

هناك مجموعة بايت (data: PByte) تحتوي على بيانات DIB و 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;

كيفية تحويل DIB إلى tbitmap مع الحفاظ على استخدام وحدة المعالجة المركزية منخفضة؟

لقد حاولت http://files.codes-sources.com/fichier.aspx؟id=43989&f=gdipapi.pas بدون نجاح.

لقد قمت بتعيين DIB لدفق الذاكرة:

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

أفترض أنه يجب أن يكون هناك رأس DIB مكتوبة في مكان ما قبل bitmap.loadfrommystream (Dibmemstream). لست متأكدا من أين.

أي أفكار من فضلك؟

شكرًا لك !

Answer 1

لقد استخدمت المخطط التالي لتحويل الصور في الذاكرة إلى tbitmap:

1) ملء بنية tbmpheader

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

2) اكتب BMPheader + بيانات الصورة إلى MemoryStream

3) تحميل tbitmap من الذاكرة باستخدام tbitmap.loadfromstream

يبدو أن لديك هيكل مؤشر كتلة الجسم ممتلئ بالفعل. أضف 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;

Answer 2

لقد مر وقت طويل منذ أن قمت بأي ترميز Delphi ولم أتمكن من اختبار هذا ، ولكن إذا تمكنت من تقديم مقبض لـ DIB ، فهناك وظيفة - hdibtotbitmap1 () - يجب أن تفعل الخدعة في هذا الرابط:

http://www.efg2.com/lab/library/delphi/graphics/leadtoolsconversions.txt