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

Источник получения информации: http://www.delphiworld.narod.ru