|
|
|
|
Delphi 1
Создание DIB из BMP
Это не тривиально, но помочь нам смогут функции 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]
|
|
|
|
|