BMP ---> DIB

Previous  Top  Next

    
 

 

 

Если файл хранится в формате BMP, как мне преобразовать его в DIB и как затем отобразить?

 

Это не тривиально, но помочь нам смогут функции GetDIBSizes и GetDIB из модуля GRAPHICS.PAS. Приведу две процедуры: одну для создания DIB из TBitmap и вторую для его освобождения:

Code:

{ Преобразование 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-объявлениям вашей формы:

Code:

 

{ Private declarations }

BitmapInfo : PBitmapInfo ;

InfoSize   : integer ;

Bits       : pointer ;

BitsSize   : longint ;

 

 

 

 

 

 

 

Создаем нижеприведенные обработчики событий, которые демонстрируют процесс отрисовки DIB:

 

Code:

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 как раз этим и занимается, но она не объявлена в качестве экспортируемой, поэтому для ее использования необходимо скопировать ее исходный код и вставить его в ваш модуль.

©Drkb::04266

       

Взято с http://delphiworld.narod.ru