BMP ---> DIB
Falk0ner, вс, 06/07/2008 - 15:35.
Если файл хранится в формате BMP, как мне преобразовать его в DIB и как затем отобразить?
Это не тривиально, но помочь нам смогут функции GetDIBSizes и GetDIB из модуля GRAPHICS.PAS. Приведу две процедуры: одну для создания DIB из TBitmap и вторую для его освобождения:
{ Преобразование TBitmap в DIB }
procedure BitmapToDIB(Bitmap: TBitmap;
var BitmapInfo: PBitmapInfo;
var InfoSize: integer;
var Bits: pointer;
var BitsSize: longint);
begin
BitmapInfo := nil;
InfoSize := 0;
Bits := nil;
BitsSize := 0;
if not Bitmap.Empty then
try
GetDIBSizes(Bitmap.Handle, InfoSize, BitsSize);
GetMem(BitmapInfo, InfoSize);
Bits := GlobalAllocPtr(GMEM_MOVEABLE, BitsSize);
if Bits = nil then
raise
EOutOfMemory.Create('Не хватает памяти для пикселей изображения');
if not GetDIB(Bitmap.Handle, Bitmap.Palette, BitmapInfo^, Bits^) then
raise Exception.Create('Не могу создать DIB');
except
if BitmapInfo <> nil then
FreeMem(BitmapInfo, InfoSize);
if Bits <> nil then
GlobalFreePtr(Bits);
BitmapInfo := nil;
Bits := nil;
raise;
end;
end;
{ используйте FreeDIB для освобождения информации об изображении и битовых указателей }
procedure FreeDIB(BitmapInfo: PBitmapInfo;
InfoSize: integer;
Bits: pointer;
BitsSize: longint);
begin
if BitmapInfo <> nil then
FreeMem(BitmapInfo, InfoSize);
if Bits <> nil then
GlobalFreePtr(Bits);
end;
procedure BitmapToDIB(Bitmap: TBitmap;
var BitmapInfo: PBitmapInfo;
var InfoSize: integer;
var Bits: pointer;
var BitsSize: longint);
begin
BitmapInfo := nil;
InfoSize := 0;
Bits := nil;
BitsSize := 0;
if not Bitmap.Empty then
try
GetDIBSizes(Bitmap.Handle, InfoSize, BitsSize);
GetMem(BitmapInfo, InfoSize);
Bits := GlobalAllocPtr(GMEM_MOVEABLE, BitsSize);
if Bits = nil then
raise
EOutOfMemory.Create('Не хватает памяти для пикселей изображения');
if not GetDIB(Bitmap.Handle, Bitmap.Palette, BitmapInfo^, Bits^) then
raise Exception.Create('Не могу создать DIB');
except
if BitmapInfo <> nil then
FreeMem(BitmapInfo, InfoSize);
if Bits <> nil then
GlobalFreePtr(Bits);
BitmapInfo := nil;
Bits := nil;
raise;
end;
end;
{ используйте FreeDIB для освобождения информации об изображении и битовых указателей }
procedure FreeDIB(BitmapInfo: PBitmapInfo;
InfoSize: integer;
Bits: pointer;
BitsSize: longint);
begin
if BitmapInfo <> nil then
FreeMem(BitmapInfo, InfoSize);
if Bits <> nil then
GlobalFreePtr(Bits);
end;
Создаем форму с TImage Image1 и загружаем в него 256-цветное изображение, затем рядом размещаем TPaintBox. Добавляем следующие строчки к private-объявлениям вашей формы:
{ Private declarations }
BitmapInfo : PBitmapInfo ;
InfoSize : integer ;
Bits : pointer ;
BitsSize : longint ;
BitmapInfo : PBitmapInfo ;
InfoSize : integer ;
Bits : pointer ;
BitsSize : longint ;
Создаем нижеприведенные обработчики событий, которые демонстрируют процесс отрисовки DIB:
procedure TForm1.FormCreate(Sender: TObject);
begin
BitmapToDIB(Image1.Picture.Bitmap, BitmapInfo, InfoSize,
Bits, BitsSize);
end;
procedure TForm1.FormDestroy(Sender: TObject);
begin
FreeDIB(BitmapInfo, InfoSize, Bits, BitsSize);
end;
procedure TForm1.PaintBox1Paint(Sender: TObject);
var
OldPalette: HPalette;
begin
if Assigned(BitmapInfo) and Assigned(Bits) then
with BitmapInfo^.bmiHeader, PaintBox1.Canvas do
begin
OldPalette := SelectPalette(Handle,
Image1.Picture.Bitmap.Palette,
false);
try
RealizePalette(Handle);
StretchDIBits(Handle, 0, 0, PaintBox1.Width, PaintBox1.Height,
0, 0, biWidth, biHeight, Bits,
BitmapInfo^, DIB_RGB_COLORS,
SRCCOPY);
finally
SelectPalette(Handle, OldPalette, true);
end;
end;
end;
begin
BitmapToDIB(Image1.Picture.Bitmap, BitmapInfo, InfoSize,
Bits, BitsSize);
end;
procedure TForm1.FormDestroy(Sender: TObject);
begin
FreeDIB(BitmapInfo, InfoSize, Bits, BitsSize);
end;
procedure TForm1.PaintBox1Paint(Sender: TObject);
var
OldPalette: HPalette;
begin
if Assigned(BitmapInfo) and Assigned(Bits) then
with BitmapInfo^.bmiHeader, PaintBox1.Canvas do
begin
OldPalette := SelectPalette(Handle,
Image1.Picture.Bitmap.Palette,
false);
try
RealizePalette(Handle);
StretchDIBits(Handle, 0, 0, PaintBox1.Width, PaintBox1.Height,
0, 0, biWidth, biHeight, Bits,
BitmapInfo^, DIB_RGB_COLORS,
SRCCOPY);
finally
SelectPalette(Handle, OldPalette, true);
end;
end;
end;
Это поможет вам сделать первый шаг. Единственное, что вы можете захотеть, это создание собственного HPalette на основе DIB, вместо использования TBitmap и своей палитры. Функция с именем PaletteFromW3DIB из GRAPHICS.PAS как раз этим и занимается, но она не объявлена в качестве экспортируемой, поэтому для ее использования необходимо скопировать ее исходный код и вставить его в ваш модуль.
Взято с http://delphiworld.narod.ru
Отправить комментарий