Конвертирование графических форматов

С помощью Delphi можно полноценно конвертировать графические форматы один в другой. Для работы с изображениями существует несколько предопределённых классов. Рассмотрим некоторые варианты конвертирования.

1. Конвертирование BMP в EMF

Следующая несложная процедура конвертирует bmp-файл SourceFileName в emf-файл и располагает его в той же директории, что и исходный файл.

function bmp2emf( const SourceFileName: TFileName): Boolean; 
var Metafile: TMetafile; MetaCanvas: TMetafileCanvas; Bitmap: TBitmap; 
begin 
  Metafile := TMetaFile.Create; 
  try 
    Bitmap := TBitmap.Create; 
    try 
      Bitmap.LoadFromFile(SourceFileName); 
      Metafile.Height := Bitmap.Height; 
      Metafile.Width := Bitmap.Width; 
      MetaCanvas := TMetafileCanvas.Create(Metafile, 0); 
      try 
        MetaCanvas.Draw(0, 0, Bitmap); 
      finally 
        MetaCanvas.Free; 
      end; 
    finally 
      Bitmap.Free; 
    end; 
    Metafile.SaveToFile(ChangeFileExt(SourceFileName, '.emf')); 
  finally 
    Metafile.Free;
  end; 
end;

Пример вызова:

procedure TForm1.Button1Click(Sender: TObject); 
begin 
  bmp2emf('C:\TestBitmap.bmp');
end;

2. Конвертирование BMP в JPG

Данная процедура выполняет такое конвертирование:

procedure TfrmMain.ConvertBMP2JPEG; 
var 
  jpgImg: TJPEGImage; 
begin 
  chrtOutputSingle.CopyToClipboardBitmap; 
  Image1.Picture.Bitmap.LoadFromClipboardFormat(cf_BitMap, ClipBoard.GetAsHandle(cf_Bitmap), 0); 
  jpgImg := TJPEGImage.Create; 
  jpgImg.Assign(Image1.Picture.Bitmap); 
  jpgImg.SaveToFile('TChartExample.jpg'); 
end;

В Uses необходимо добавить модули Jpeg и Clipbrd. В данном примере chrtOutputSingle - это объект TChart (страница Additional). Перед вызовом функции в буфере обмена должен находиться объект типа TBitmap.

3. Конвертирование BMP в WMF

Данное конвертирование также не составляет труда:

procedure ConvertBMP2WMF (const BMPFileName, WMFFileName: TFileName); 
var 
  MetaFile : TMetafile; 
  Bitmap : TBitmap; 
begin 
  Metafile := TMetaFile.Create; 
  Bitmap := TBitmap.Create; 
  try 
    Bitmap.LoadFromFile(BMPFileName); 
    with MetaFile do 
    begin 
      Height := Bitmap.Height; 
      Width := Bitmap.Width; 
      Canvas.Draw( 0 , 0 , Bitmap); 
      SaveToFile(WMFFileName); 
    end; 
  finally 
    Bitmap.Free; 
    MetaFile.Free; 
  end;
end;

Пример использования:

ConvertBMP2WMF('c:\mypic.bmp','c:\mypic.wmf');

4. Обратное конвертирование: WMF в BMP

Обратное конвертирование мало чем отличается от предыдущего:

procedure ConvertWMF2BMP (const WMFFileName, BMPFileName: TFileName); 
var 
  MetaFile : TMetafile; 
  Bitmap : TBitmap; 
begin 
  Metafile := TMetaFile.Create; 
  Bitmap := TBitmap.Create; 
  try 
    MetaFile.LoadFromFile(WMFFileName); 
    with Bitmap do 
    begin 
      Height := Metafile.Height; 
      Width := Metafile.Width; 
      Canvas.Draw( 0 , 0 , MetaFile); 
      SaveToFile(BMPFileName); 
    end; 
  finally 
    Bitmap.Free; 
    MetaFile.Free; 
  end;
end;

Использование:

ConvertWMF2BMP('c:\mypic.wmf','c:\mypic.bmp');

5. Конвертирование BMP в DIB

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

procedure BitmapToDIB(Bitmap: TBitmap; 
var
  BitmapInfo: PBitmapInfo; 
  InfoSize: integer; 
  Bits: pointer; 
  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 как раз этим и занимается, но она не объявлена в качестве экспортируемой, поэтому для ее использования необходимо скопировать ее исходный код и вставить его в модуль.

6. Конвертирование BMP в ICO

Вам необходимо создать два битмапа, битмап маски (назовём его "AND" bitmap) и битмап изображения (назовём его XOR bitmap). Вы можете пропустить обработчики для "AND" и "XOR" битмапов в Windows API функции CreateIconIndirect() и использовать обработчик возвращённой иконки в Вашем приложении.

procedure TForm1.Button1Click(Sender: TObject); 
var 
  IconSizeX : integer; 
  IconSizeY : integer; 
  AndMask : TBitmap; 
  XOrMask : TBitmap; 
  IconInfo : TIconInfo; 
  Icon : TIcon; 
begin 
  {Получаем размер иконки} 
  IconSizeX := GetSystemMetrics(SM_CXICON); 
  IconSizeY := GetSystemMetrics(SM_CYICON); 
 
  {Создаём маску "And"} 
  AndMask := TBitmap.Create; 
  AndMask.Monochrome := true; 
  AndMask.Width := IconSizeX; 
  AndMask.Height := IconSizeY; 
 
  {Рисуем на маске "And"} 
  AndMask.Canvas.Brush.Color := clWhite; 
  AndMask.Canvas.FillRect(Rect( 0 , 0 , IconSizeX, IconSizeY)); 
  AndMask.Canvas.Brush.Color := clBlack; 
  AndMask.Canvas.Ellipse( 4 , 4 , IconSizeX - 4 , IconSizeY - 4 ); 
 
  {Рисуем для теста}
  Form1.Canvas.Draw(IconSizeX * 2 , IconSizeY, AndMask);
 
  {Создаём маску "XOr"}
  XOrMask := TBitmap.Create;
  XOrMask.Width := IconSizeX;
  XOrMask.Height := IconSizeY;
 
  {Рисуем на маске "XOr"}
  XOrMask.Canvas.Brush.Color := ClBlack;
  XOrMask.Canvas.FillRect(Rect( 0 , 0 , IconSizeX, IconSizeY));
  XOrMask.Canvas.Pen.Color := clRed;
  XOrMask.Canvas.Brush.Color := clRed;
  XOrMask.Canvas.Ellipse( 4 , 4 , IconSizeX - 4 , IconSizeY - 4 );
 
  {Рисуем в качестве теста}
  Form1.Canvas.Draw(IconSizeX * 4 , IconSizeY, XOrMask);
 
  {Создаём иконку}
  Icon := TIcon.Create; 
  IconInfo.fIcon := true; 
  IconInfo.xHotspot := 0 ; 
  IconInfo.yHotspot := 0 ; 
  IconInfo.hbmMask := AndMask.Handle; 
  IconInfo.hbmColor := XOrMask.Handle; 
  Icon.Handle := CreateIconIndirect(IconInfo); 
 
  {Уничтожаем временные битмапы} 
  AndMask.Free; 
  XOrMask.Free; 
 
  {Рисуем в качестве теста} 
  Form1.Canvas.Draw(IconSizeX * 6 , IconSizeY, Icon); 
 
  {Объявляем иконку в качестве иконки приложения} 
  Application.Icon := Icon; 
 
  {генерируем перерисовку} 
  InvalidateRect(Application.Handle, nil , true); 
 
  {Освобождаем иконку} 
  Icon.Free; 
end;

Способ преобразования изображения размером 32x32 в иконку:

procedure TForm1.Button1Click(Sender: TObject); 
var 
  winDC, srcdc, destdc: HDC; 
  oldBitmap: HBitmap; 
  iinfo: TICONINFO; 
begin 
  GetIconInfo(Image1.Picture.Icon.Handle, iinfo); 
 
  WinDC := getDC(handle); 
  srcDC := CreateCompatibleDC(WinDC); 
  destDC := CreateCompatibleDC(WinDC); 
  oldBitmap := SelectObject(destDC, iinfo.hbmColor); 
  oldBitmap := SelectObject(srcDC, iinfo.hbmMask); 
 
  BitBlt(destdc, 0 , 0 , Image1.Picture.Icon.Width, Image1.Picture.Icon.Height, srcdc, 0 , 0 , SRCPAINT); 
  Image2.Picture.Bitmap.Handle := SelectObject(destDC, oldBitmap); 
  DeleteDC(destDC); 
  DeleteDC(srcDC); 
  DeleteDC(WinDC); 
 
  Image2.Picture.Bitmap.savetofile(ExtractFilePath(Application.ExeName) + 'myfile.bmp' ); 
end;
 
procedure TForm1.FormCreate(Sender: TObject); 
begin 
  Image1.Picture.Icon.LoadFromFile('c:\myicon.ico');
end;

7. Конвертирование BMP в RTF

Да, и такое тоже возможно. Вот так например:

function BitmapToRTF(pict: TBitmap): string ; 
var 
  bi, bb, rtf: string ; 
  bis, bbs: Cardinal; 
  achar: ShortString; 
  hexpict: string ; 
  I: Integer; 
begin 
  GetDIBSizes(pict.Handle, bis, bbs); 
  SetLength(bi, bis); 
  SetLength(bb, bbs); 
  GetDIB(pict.Handle, pict.Palette, PChar(bi)^, PChar(bb)^); 
  rtf := '{\rtf1 {\pict\dibitmap0 ' ; 
  SetLength(hexpict, (Length(bb) + Length(bi)) * 2 ); 
  I := 2 ; 
  for bis := 1 to Length(bi) do 
  begin 
    achar := IntToHex(Integer(bi[bis]), 2 ); 
    hexpict[I - 1] := achar[ 1 ]; 
    hexpict[I] := achar[ 2 ]; 
    Inc(I, 2 ); 
  end ; 
  for bbs := 1 to Length(bb) do 
  begin 
    achar := IntToHex(Integer(bb[bbs]), 2 ); 
    hexpict[I - 1] := achar[ 1 ]; 
    hexpict[I] := achar[ 2 ]; 
    Inc(I, 2); 
  end ; 
  rtf := rtf + hexpict + ' }}'; 
  Result := rtf; 
end;

8. Конвертирование CUR в BMP

Преобразование курсора в TBitmap:

procedure TForm1.Button1Click(Sender: TObject); 
var 
  hCursor: LongInt; 
  Bitmap: TBitmap; 
begin 
  Bitmap := TBitmap.Create; 
  Bitmap.Width := 32 ; 
  Bitmap.Height := 32 ; 
  hCursor := LoadCursorFromFile( 'test.cur' ); 
  DrawIcon(Bitmap.Canvas.Handle, 0 , 0 , hCursor); 
  Bitmap.SaveToFile( 'test.bmp' ); 
  Bitmap.Free; 
end;

9. Конвертирование ICO в BMP

var
  Icon : TIcon; 
  Bitmap : TBitmap; 
begin 
  Icon := TIcon.Create; 
  Bitmap := TBitmap.Create; 
  Icon.LoadFromFile( 'c:\picture.ico' ); 
  Bitmap.Width := Icon.Width; 
  Bitmap.Height := Icon.Height; 
  Bitmap.Canvas.Draw( 0 , 0 , Icon); 
  Bitmap.SaveToFile( 'c:\picture.bmp' ); 
  Icon.Free; 
  Bitmap.Free; 
end;

Вариант 2:

var 
  MyIcon: TIcon; 
  MyBitMap: TBitmap; 
begin
  MyIcon := TIcon.Create; 
  MyBitMap := TBitmap.Create; 
 
  try
    { получаем имя файла и связанную с ним иконку} 
    strFileName := FileListBox1.Items[FileListBox1.ItemIndex]; 
    StrPCopy(cStrFileName, strFileName); 
    MyIcon.Handle := ExtractIcon(hInstance, cStrFileName, 0 ); 
 
    { рисуем иконку на bitmap в speedbutton } 
    SpeedButton1.Glyph := MyBitMap; 
    SpeedButton1.Glyph.Width := MyIcon.Width; 
    SpeedButton1.Glyph.Height := MyIcon.Height; 
    SpeedButton1.Glyph.Canvas.Draw( 0 , 0 , MyIcon); 
 
    SpeedButton1.Hint := strFileName; 
 
  finally
    MyIcon.Free;
    MyBitMap.Free;
  end; 
end;

Чтобы преобразовать Icon в Bitmap, используйте TImageList. Для обратного преобразования замените метод AddIcon на Add, и метод GetBitmap на GetIcon.

function Icon2Bitmap(Icon: TIcon): TBitmap; 
begin 
  with TImageList.Create ( nil ) do 
  begin 
    AddIcon (Icon); 
    Result := TBitmap.Create; 
    GetBitmap ( 0 , Result); 
    Free;
  end;
end;

10. Конвертирование JPG в BMP.

uses JPEG;
 
procedure JPEGtoBMP( const FileName: TFileName);
var
  jpeg: TJPEGImage;
  bmp: TBitmap;
begin 
  jpeg := TJPEGImage.Create; 
  try 
    jpeg.CompressionQuality := 100 ; {Default Value} 
    jpeg.LoadFromFile(FileName); 
    bmp := TBitmap.Create; 
    try 
      bmp.Assign(jpeg); 
      bmp.SaveTofile(ChangeFileExt(FileName, '.bmp' )); 
    finally
      bmp.Free;
    end;
  finally
    jpeg.Free;
  end;
end;

Статья добавлена: 1 июня 2005

Следующая статья: Добавляем компонент в стандартный Message Dialog »

Рейтинг статьи: 3.25 Голосов: 4

Зарегистрируйтесь/авторизируйтесь,
чтобы оценивать статьи.

Для вставки ссылки на данную статью на другом сайте используйте следующий HTML-код:
<a href="https://www.delphi-int.ru/articles/14/">Конвертирование графических форматов</a>

Ссылка для форумов (BBCode):
[url=https://www.delphi-int.ru/articles/14/]Конвертирование графических форматов[/url]

Быстрая вставка ссылки на статью в сообщениях на сайте:
{{a:14}} (буква a — латинская) — только адрес статьи (URL);
{{статья:14}} — полноценная HTML-ссылка на статью (текст ссылки — название статьи).

Поделитесь ссылкой в социальных сетях:

Комментарии читателей к данной статье

Пока нет комментариев к данной статье. Оставьте свой и он будет первым.

Оставлять комментарии к статьям могут только зарегистрированные пользователи.