Практическая работа №5.Создание универсального конвертора графических изображений
Цель работы: Создать собственный интерфейс для выполнения конвертирования файлов, используя компоненты GroupBox, ComboBox, ListBox, XPManifest.
Краткие теоретические сведения: ListBox отображает список файлов. Для ComboBox в свойстве Item выбираем нужные форматы конвертирования.
Формулировка задания: Разработать программу конвертирования изображений, используя компоненты для выбора формата конвертируемых изображений, компонент отображения списка файлов, кнопки добавления и удаления, конвертирования файлов, компонент выбора места сохранения конвертированного файла, процесс конвертирования.
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, ExtCtrls, Menus, Jpeg, Clipbrd, TeeProcs, TeEngine,
Chart;
type
TForm1 = class(TForm)
Button1: TButton;
Button3: TButton;
Button2: TButton;
Button4: TButton;
MainMenu1: TMainMenu;
N1: TMenuItem;
N2: TMenuItem;
N3: TMenuItem;
N4: TMenuItem;
OpenDialog1: TOpenDialog;
Label1: TLabel;
Button5: TButton;
Button6: TButton;
Label2: TLabel;
procedure Button1Click(Sender: TObject);
procedure Button3Click(Sender: TObject);
procedure Button2Click(Sender: TObject);
procedure N2Click(Sender: TObject);
procedure Button5Click(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
var
Form1: TForm1;
implementation
{$R *.dfm}
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('E:\пр5\TestBitmap.bmp');
end;
procedure ConvertBMP2WMF (const BMPFileName, WMFFileName: TFileName);
var
MetaFile: TMetafile;
Bitmap:TBitmap;
Canvas:TCanvas;
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
end;
end;
function bmp2wmf( 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,'.wmf'));
finally
Metafile.Free;
end;
end;
procedure TForm1.Button3Click(Sender: TObject);
begin
bmp2wmf('E:\пр5\TestBitmap.bmp');
end;
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;
procedure TForm1.Button2Click(Sender: TObject);
begin
bmp2wmf('E:\пр5\TestBitmap.wmf');
end;
procedure TForm1.N2Click(Sender: TObject);
begin
if OpenDialog1.Execute then
end;
procedure TForm1.Button5Click(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;
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:='{\rtfl{\pict\dibitmap0';
end;
end.