Конвертирование графических форматов
С помощью 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;Вот и всё, Удачи!
No results found.