Оригинальный DVD-ROM: eXeL@B DVD !
eXeL@B ВИДЕОКУРС !

Видеокурс программиста и крэкера 5D 2O17
(актуальность: октябрь 2O17)
Свежие инструменты, новые видеоуроки!

  • 400+ видеоуроков
  • 800 инструментов
  • 100+ свежих книг и статей

УЗНАТЬ БОЛЬШЕ >>
Домой | Статьи | RAR-cтатьи | FAQ | Форум | Скачать | Видеокурс
Новичку | Ссылки | Программирование | Интервью | Архив | Связь

БОЛЬШОЙ FAQ ПО DELPHI



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

Автор: Mike Scott

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




<< ВЕРНУТЬСЯ В ОГЛАВЛЕНИЕ



Материалы находятся на сайте https://exelab.ru/pro/



Оригинальный DVD-ROM: eXeL@B DVD !


Вы находитесь на EXELAB.rU
Проект ReactOS