Советы по Delphi
Создание 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 ) ; beginBitmapInfo := NIL ;InfoSize := 0 ;Bits := NIL ;BitsSize := 0 ;if not Bitmap.Empty then tryGetDIBSizes( Bitmap.Handle, InfoSize, BitsSize ) ;GetMem( BitmapInfo, InfoSize ) ;Bits := GlobalAllocPtr( GMEM_MOVEABLE, BitsSize ) ;if Bits = NIL then RaiseEOutOfMemory.Create( 'Не хватает памяти для пикселей изображения' ) ;if not GetDIB( Bitmap.Handle, Bitmap.Palette, BitmapInfo^, Bits^ ) thenRaise Exception.Create( 'Не могу создать DIB' ) ;exceptif 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 ) ; beginif 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);beginBitmapToDIB( Image1.Picture.Bitmap, BitmapInfo, InfoSize,Bits, BitsSize ) ;end; procedure TForm1.FormDestroy(Sender: TObject);beginFreeDIB( BitmapInfo, InfoSize, Bits, BitsSize ) ;end; procedure TForm1.PaintBox1Paint(Sender: TObject);var OldPalette : HPalette ;beginif Assigned( BitmapInfo ) and Assigned( Bits ) thenwith BitmapInfo^.bmiHeader, PaintBox1.Canvas dobeginOldPalette := SelectPalette( Handle,Image1.Picture.Bitmap.Palette,false ) ;tryRealizePalette( Handle ) ;StretchDIBits( Handle, 0, 0, PaintBox1.Width, PaintBox1.Height,0, 0, biWidth, biHeight, Bits,BitmapInfo^, DIB_RGB_COLORS,SRCCOPY ) ;finallySelectPalette( Handle, OldPalette, true ) ;end ;end ;end; |
Это поможет вам сделать первый шаг. Единственное, что вы можете захотеть, это создание собственного HPalette на основе DIB, вместо использования TBitmap и своей палитры. Функция с именем PaletteFromW3DIB из GRAPHICS.PAS как раз этим и занимается, но она не объявлена в качестве экспортируемой, поэтому для ее использования необходимо скопировать ее исходный код и вставить его в ваш модуль.
- Mike Scott [000785]
