Delphi Dib com cabeçalho DIB em Tbitmap
Pergunta
Estou pedindo que você me ajude com esse problema:
Há uma matriz de byte (data: PByte
) contendo dados DIB e 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;
Como converter o DIB em TBITMAP, mantendo o uso da CPU baixo?
eu tentei http://files.codes-sources.com/fichier.aspx?id=43989&f=gdipapi.pas sem sucesso.
Eu atribuí DIB a um fluxo de memória:
DibMemStream.Clear;
DibMemStream.SetSize(header.image_size);
MoveMemory(DibMemStream.Memory,DibBuffer,header.image_size);
Suponho que deva haver cabeçalho DIB escrito em algum lugar antes do bitmap.loadFromMemoryStream (DiBMemStream). Não tenho certeza de onde.
Alguma idéia, por favor?
Obrigada !
Solução
Eu usei o seguinte esquema para converter imagens na memória no TBBITMAP:
1) Preencha a estrutura tbmpheader
TBMPHeader = packed record
bmfHeader: TBitmapFileHeader;
bmiHeader: TBitmapInfoHeader;
bmiColors: {depends on image format, may be absent};
end;
2) Escreva Bmpheader + Dados da imagem para MemoryStream
3) Carregue o Tbitmap de MemoryStream usando tbitmap.loadFromStream
Você parece ter a estrutura do BMIheader já preenchida. Adicione BMFHeader e (talvez) Bmicolors.
Aqui está o código que eu costumava converter imagens na memória em escala de 256 cores em TBBITMAP (muitos anos atrás, desculpe, então não há detalhes):
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;
Outras dicas
Faz muito tempo que eu fiz alguma codificação Delphi e não consegui testar isso, mas se você puder fornecer uma alça ao DIB, há uma função - hdibtotbitmap1 () - que deve fazer o truque neste link:
http://www.efg2.com/lab/library/delphi/graphics/leadtoolsconversions.txt