С помощью 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;

Получить ссылку на материал