Создание DIB из BMP

Если файл хранится в формате 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 ;

Создаем форму с TImage Image1 и загружаем в него 256-цветное изображение, затем рядом размещаем TPaintBox. Добавляем следующие строчки к private-объявлениям вашей формы:

{ Private declarations } 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;

Это поможет вам сделать первый шаг. Единственное, что вы можете захотеть, это создание собственного HPalette на основе DIB, вместо использования TBitmap и своей палитры. Функция с именем PaletteFromW3DIB из GRAPHICS.PAS как раз этим и занимается, но она не объявлена в качестве экспортируемой, поэтому для ее использования необходимо скопировать ее исходный код и вставить его в ваш модуль.

- Mike Scott [000785]

Содержание раздела