Добавил:
Upload Опубликованный материал нарушает ваши авторские права? Сообщите нам.
Вуз: Предмет: Файл:
otchet__fortunovoy_moy.doc
Скачиваний:
0
Добавлен:
01.05.2025
Размер:
10.62 Mб
Скачать

Практическая работа №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.

Соседние файлы в предмете [НЕСОРТИРОВАННОЕ]