Лабораторна робота №6

СТВОРЕННЯ ДОДАТКУ «ФОТОРОБОТ»

У роботі приведені основні фрагменти початкового коду для створення додатку по підбору зовнішності – «фоторобот».

var

Form1: TForm1;

dow:boolean;

ох,oy,X1,Y1:integer;

implementation

{$R *.dfm}

procedure TForm1.RadioGroup1Click(Sender: TObject);

begin

case RadioGroup1.ItemIndex of

0 :

begin

Image8.Visible:=false;

Image9.Visible:=true;

end;

1: begin

Image8.Visible:=true;

Image9.Visible:=false;

end;end;end;

Процедури вибору частин лиця першого персонажа

procedure TForm1.RadioGroup2Click(Sender: TObject);

begin

case RadioGroup2.ItemIndex of

0 : begin

Image7.Visible:=false;

Image6.Visible:=true;

end;

1 : begin

Image7.Visible:=true;

Image6.Visible:=false;

end;end;end;

procedure TForm1.RadioGroup3Click(Sender: TObject);

begin

case RadioGroup3.ItemIndex of

0 : begin

Image5.Visible:=false;

Image4.Visible:=true;

end;

1 : begin

Image5.Visible:=true;

Image4.Visible:=false;

end; end;end;

procedure TForm1.RadioGroup4Click(Sender: TObject);

begin

case RadioGroup4.ItemIndex of

0 :

begin

Image3.Visible:=true;

Image2.Visible:=false;

end;

1 : begin

Image3.Visible:=false;

Image2.Visible:=true;

end;end;end;

procedure TForm1.RadioGroup5Click(Sender: TObject);

begin

case RadioGroup5.ItemIndex of

0 :

begin

Image16.Visible:=false;

Image17.Visible:=true;

end;

1: begin

Image16.Visible:=true;

Image17.Visible:=false;

end;end;end;

procedure TForm1.RadioGroup6Click(Sender: TObject);

begin

case RadioGroup6.ItemIndex of

0 :

begin

Image14.Visible:=false;

Image15.Visible:=true;

end;

1: begin

Image14.Visible:=true;

Image15.Visible:=false;

end;end;end;

procedure TForm1.RadioGroup7Click(Sender: TObject);

begin

case RadioGroup7.ItemIndex of

0 :

begin

Image12.Visible:=false;

Image13.Visible:=true;

end;

1: begin

Image12.Visible:=true;

Image13.Visible:=false;

end;end;end;

procedure TForm1.RadioGroup8Click(Sender: TObject);

begin

case RadioGroup8.ItemIndex of

0 :

begin

Image10.Visible:=false;

Image11.Visible:=true;

end;

1: begin

Image10.Visible:=true;

Image11.Visible:=false;

end;end;end;

Залежно від вибору (перший або другий персонажі) показуються потрібні компоненти Image

procedure TForm1.Button1Click(Sender: TObject);

begin

if (RadioButton1.Checked=true) then

begin

GroupBox1.Visible:=false;

Button1.Visible:=false;

RadioGroup5.Visible:=true;

RadioGroup6.Visible:=true;

RadioGroup7.Visible:=true;

RadioGroup8.Visible:=true;

end;

if (RadioButton2.Checked=true) then Panel1.Visible:=false;

N6.Enabled:=true;

end;

При виборі пункту меню "Наново" все повертається в початковий стан

procedure TForm1.N2Click(Sender: TObject);

begin

Panel1.Visible:=true;

Image2.Visible:=false;

Image3.Visible:=false;

Image4.Visible:=false;

Image5.Visible:=false;

Image6.Visible:=false;

Image7.Visible:=false;

Image8.Visible:=false;

Image9.Visible:=false;

Image10.Visible:=false;

Image11.Visible:=false;

Image12.Visible:=false;

Image13.Visible:=false;

Image14.Visible:=false;

Image15.Visible:=false;

Image16.Visible:=false;

Image17.Visible:=false;

RadioGroup5.Visible:=false;

RadioGroup6.Visible:=false;

RadioGroup7.Visible:=false;

RadioGroup8.Visible:=false;

GroupBox1.Visible:=true;

Button1.Visible:=true;

end;

При натисненні пункту меню "Очистити" ховаються потрібні Images

procedure TForm1.N3Click(Sender: TObject);

begin

if (Panel1.Visible=true) then

begin

Image10.Visible:=false;

Image11.Visible:=false;

Image12.Visible:=false;

Image13.Visible:=false;

Image14.Visible:=false;

Image15.Visible:=false;

Image16.Visible:=false;

Image17.Visible:=false;

end;

if (Panel1.Visible=false) then

begin

Image2.Visible:=false;

Image3.Visible:=false;

Image4.Visible:=false;

Image5.Visible:=false;

Image6.Visible:=false;

Image7.Visible:=false;

Image8.Visible:=false;

Image9.Visible:=false;

end;end;

Процедура вибору кольору форми

procedure TForm1.N4Click(Sender: TObject);

begin

if ColorDialog1.Execute then begin

if Panel1.Visible=true then Panel1.Color:=ColorDialog1.Color

else Form1.Color:=ColorDialog1.Color;

end;end;

Закриття форми

procedure TForm1.N5Click(Sender: TObject);

begin

Close;

end;

Збереження малюнка у файл *.jpg

procedure TForm1.N6Click(Sender: TObject);

begin

if SaveDialog1.Execute then

begin

Ховаємо зайві компоненти на формі

RadioGroup1.Visible:=false;

RadioGroup2.Visible:=false;

RadioGroup3.Visible:=false;

RadioGroup4.Visible:=false;

RadioGroup5.Visible:=false;

RadioGroup6.Visible:=false;

RadioGroup7.Visible:=false;

RadioGroup8.Visible:=false;

Створюється screenshot форми і зберігається у файл

Form1.GetFormImage.SaveToFile(ChangeFileExt(SaveDialog1.FileName,'.jpg'));

Повертаємо видимість компонентів

if (Panel1.Visible=true) then

begin

RadioGroup5.Visible:=true;

RadioGroup6.Visible:=true;

RadioGroup7.Visible:=true;

RadioGroup8.Visible:=true;

end;

RadioGroup1.Visible:=true;

RadioGroup2.Visible:=true;

RadioGroup3.Visible:=true;

RadioGroup4.Visible:=true;

end;

end;

Пересування зображень

procedure TForm1.Image10MouseDown(Sender: TObject; Button: TMouseButton;

Shift: TShiftState; X, Y: Integer);

begin

dow:=true; //флаг пересування об'єкту. Якщо на зображенні натиснути мишкою, то воно вважається "узятим"

ox:=x; //текущие координати

oy:=y;

DoubleBuffered := true; //подвійнабуферизація для зменшення мерехтіння під час пересування

end;

procedure TForm1.Image10MouseMove(Sender: TObject; Shift: TShiftState; X

Y: Integer);

begin

if dow=true then //если об'єкт "узятий"

begin

//визначаються нові координати

image10.Top:=image10.Top-(oy-y);

image10.Left:=image10.Left-(ox-x);

//обчислюється положення мишки щодо форми

X1:=Image10.Left+X;

Y1:=Image10.Top+Y;

//виводяться координати мишки

StatusBar1.SimpleText:='X='+ inttostr(X1)+ ', Y='+INTTOSTR(Y1);

end;end;

procedure TForm1.Image10MouseUp(Sender: TObject; Button: TMouseButton;

Shift: TShiftState; X, Y: Integer);

begin

dow:=false; //при відпуску кнопки миші, об'єкт вважається "кинутим" і більше не рухається

DoubleBuffered := false;

end;

procedure TForm1.Image2MouseMove(Sender: TObject; Shift: TShiftState; X

Y: Integer);

begin

if dow=true then

begin

image2.Top:=image2.Top-(oy-y);

image2.Left:=image2.Left-(ox-x);

X1:=Image2.Left+X;

Y1:=Image2.Top+Y;

StatusBar1.SimpleText:='X='+ inttostr(X1)+ ', Y='+INTTOSTR(Y1);

end;end;

procedure TForm1.Image3MouseMove(Sender: TObject; Shift: TShiftState; X

Y: Integer);

begin

if dow=true then

begin

image3.Top:=image3.Top-(oy-y);

image3.Left:=image3.Left-(ox-x);

X1:=Image3.Left+X;

Y1:=Image3.Top+Y;

StatusBar1.SimpleText:='X='+ inttostr(X1)+ ', Y='+INTTOSTR(Y1);

end;end;

procedure TForm1.Image4MouseMove(Sender: TObject; Shift: TShiftState; X

Y: Integer);

begin

if dow=true then

begin

image4.Top:=image4.Top-(oy-y);

image4.Left:=image4.Left-(ox-x);

X1:=Image4.Left+X;

Y1:=Image4.Top+Y;

StatusBar1.SimpleText:='X='+ inttostr(X1)+ ', Y='+INTTOSTR(Y1);

end;end;

procedure TForm1.Image5MouseMove(Sender: TObject; Shift: TShiftState; X

Y: Integer);

begin

if dow=true then

begin

image5.Top:=image5.Top-(oy-y);

image5.Left:=image5.Left-(ox-x);

X1:=Image5.Left+X;

Y1:=Image5.Top+Y;

StatusBar1.SimpleText:='X='+ inttostr(X1)+ ', Y='+INTTOSTR(Y1);

end;end;

procedure TForm1.Image6MouseMove(Sender: TObject; Shift: TShiftState; X

Y: Integer);

begin

if dow=true then

begin

image6.Top:=image6.Top-(oy-y);

image6.Left:=image6.Left-(ox-x);

X1:=Image6.Left+X;

Y1:=Image6.Top+Y;

StatusBar1.SimpleText:='X='+ inttostr(X1)+ ', Y='+INTTOSTR(Y1);

end;end;

procedure TForm1.Image7MouseMove(Sender: TObject; Shift: TShiftState; X

Y: Integer);

begin

if dow=true then

begin

image7.Top:=image7.Top-(oy-y);

image7.Left:=image7.Left-(ox-x);

X1:=Image7.Left+X;

Y1:=Image7.Top+Y;

StatusBar1.SimpleText:='X='+ inttostr(X1)+ ', Y='+INTTOSTR(Y1);

end;end;

procedure TForm1.Image8MouseMove(Sender: TObject; Shift: TShiftState; X

Y: Integer);

begin

if dow=true then

begin

image8.Top:=image8.Top-(oy-y);

image8.Left:=image8.Left-(ox-x);

X1:=Image8.Left+X;

Y1:=Image8.Top+Y;

StatusBar1.SimpleText:='X='+ inttostr(X1)+ ', Y='+INTTOSTR(Y1);

end;end;

procedure TForm1.Image9MouseMove(Sender: TObject; Shift: TShiftState; X

Y: Integer);

begin

if dow=true then

begin

image9.Top:=image9.Top-(oy-y);

image9.Left:=image9.Left-(ox-x);

X1:=Image9.Left+X;

Y1:=Image9.Top+Y;

StatusBar1.SimpleText:='X='+ inttostr(X1)+ ', Y='+INTTOSTR(Y1);

end;end;

procedure TForm1.Image11MouseMove(Sender: TObject; Shift: TShiftState; X

Y: Integer);

begin

if dow=true then

begin

image11.Top:=image11.Top-(oy-y);

image11.Left:=image11.Left-(ox-x);

X1:=Image11.Left+X;

Y1:=Image11.Top+Y;

StatusBar1.SimpleText:='X='+ inttostr(X1)+ ', Y='+INTTOSTR(Y1);

end;end;

procedure TForm1.Image12MouseMove(Sender: TObject; Shift: TShiftState; X

Y: Integer);

begin

if dow=true then

begin

image12.Top:=image12.Top-(oy-y);

image12.Left:=image12.Left-(ox-x);

X1:=Image12.Left+X;

Y1:=Image12.Top+Y;

StatusBar1.SimpleText:='X='+ inttostr(X1)+ ', Y='+INTTOSTR(Y1);

end;end;

procedure TForm1.Image13MouseMove(Sender: TObject; Shift: TShiftState; X

Y: Integer);

begin

if dow=true then

begin

image13.Top:=image13.Top-(oy-y);

image13.Left:=image13.Left-(ox-x);

X1:=Image13.Left+X;

Y1:=Image13.Top+Y;

StatusBar1.SimpleText:='X='+ inttostr(X1)+ ', Y='+INTTOSTR(Y1);

end;end;

procedure TForm1.Image14MouseMove(Sender: TObject; Shift: TShiftState; X

Y: Integer);

begin

if dow=true then

begin

image14.Top:=image14.Top-(oy-y);

image14.Left:=image14.Left-(ox-x);

X1:=Image14.Left+X;

Y1:=Image14.Top+Y;

StatusBar1.SimpleText:='X='+ inttostr(X1)+ ', Y='+INTTOSTR(Y1);

end;end;

procedure TForm1.Image15MouseMove(Sender: TObject; Shift: TShiftState; X

Y: Integer);

begin

if dow=true then

begin

image15.Top:=image15.Top-(oy-y);

image15.Left:=image15.Left-(ox-x);

X1:=Image15.Left+X;

Y1:=Image15.Top+Y;

StatusBar1.SimpleText:='X='+ inttostr(X1)+ ', Y='+INTTOSTR(Y1);

end;end;

procedure TForm1.Image16MouseMove(Sender: TObject; Shift: TShiftState; X

Y: Integer);

begin

if dow=true then

begin

image16.Top:=image16.Top-(oy-y);

image16.Left:=image16.Left-(ox-x);

X1:=Image16.Left+X;

Y1:=Image16.Top+Y;

StatusBar1.SimpleText:='X='+ inttostr(X1)+ ', Y='+INTTOSTR(Y1);

end;end;

procedure TForm1.Image17MouseMove(Sender: TObject; Shift: TShiftState; X

Y: Integer);

begin

if dow=true then

begin

image17.Top:=image17.Top-(oy-y);

image17.Left:=image17.Left-(ox-x);

X1:=Image17.Left+X;

Y1:=Image17.Top+Y;

StatusBar1.SimpleText:='X='+ inttostr(X1)+ ', Y='+INTTOSTR(Y1);

end;end;

//збереження проекту

procedure TForm1.N7Click(Sender: TObject);

var

F:textfile;

begin

if SaveDialog1.Execute then

begin

//створення текстового файлу

assignfile (F,ChangeFileExt(SaveDialog1.FileName,'.txt'));

rewrite(F);

Якщо панель видима, то першим числом у файл записується прапор 1, інакше 0

if Panel1.Visible=true then

begin

writeln(F,'1');

//якщо даний Image видимий, то у файл записується 1, інакше 0

if Image10.Visible=true then writeln(F,'1') else writeln(F,'0');

if Image11.Visible=true then writeln(F,'1') else writeln(F,'0');

if Image12.Visible=true then writeln(F,'1') else writeln(F,'0');

if Image13.Visible=true then writeln(F,'1') else writeln(F,'0');

if Image14.Visible=true then writeln(F,'1') else writeln(F,'0');

if Image15.Visible=true then writeln(F,'1') else writeln(F,'0');

if Image16.Visible=true then writeln(F,'1') else writeln(F,'0');

if Image17.Visible=true then writeln(F,'1') else writeln(F,'0');

end;

if Panel1.Visible=false then

begin

writeln(F,'0');

if Image2.Visible=true then writeln(F,'1') else writeln(F,'0');

if Image3.Visible=true then writeln(F,'1') else writeln(F,'0');

if Image4.Visible=true then writeln(F,'1') else writeln(F,'0');

if Image5.Visible=true then writeln(F,'1') else writeln(F,'0');

if Image6.Visible=true then writeln(F,'1') else writeln(F,'0');

if Image7.Visible=true then writeln(F,'1') else writeln(F,'0');

if Image8.Visible=true then writeln(F,'1') else writeln(F,'0');

if Image9.Visible=true then writeln(F,'1') else writeln(F,'0');

end;

closefile(F);

end;end;

//відкриття проекту з файлу

procedure TForm1.N8Click(Sender: TObject);

var

F:textfile;

s:string;

i:integer;

begin

if OpenDialog1.Execute then

begin

assignfile(F,ChangeFileExt(OpenDialog1.FileName,'.txt'));

reset(F);

readln(F,s);

//якщо прапор має значення 1, то панель видима, якщо 0 - ні

if s='1' then Panel1.Visible:=true else Panel1.Visible:=false;

for i:=2 to 9 do

begin

//якщо подальші числа 1, то відповідний компонет Тimage видимий, якщо 0 - ні

case i of

2: begin

readln(f,s);

if s='1' then begin Image2.Visible:=true; Image10.Visible:=true; end;

if s='0' then begin Image2.Visible:=false; Image10.Visible:=false; end;

end;

3: begin

readln(f,s);

if s='1' then begin Image3.Visible:=true; Image11.Visible:=true; end;

if s='0' then begin Image3.Visible:=false; Image11.Visible:=false; end;

end;

4:begin

readln(f,s);

if s='1' then begin Image4.Visible:=true; Image12.Visible:=true; end;

if s='0' then begin Image4.Visible:=false; Image12.Visible:=false; end;

end;

5: begin

readln(f,s);

if s='1' then begin Image5.Visible:=true; Image13.Visible:=true; end;

if s='0' then begin Image5.Visible:=false; Image13.Visible:=false; end;

end;

6: begin

readln(f,s);

if s='1' then begin Image6.Visible:=true; Image14.Visible:=true; end;

if s='0' then begin Image6.Visible:=false; Image14.Visible:=false; end;

end;

7: begin

readln(f,s);

if s='1' then begin Image7.Visible:=true; Image15.Visible:=true; end;

if s='0' then begin Image7.Visible:=false; Image15.Visible:=false; end;

end;

8: begin

readln(f,s);

if s='1' then begin Image8.Visible:=true; Image16.Visible:=true; end;

if s='0' then begin Image8.Visible:=false; Image16.Visible:=false; end;

end;

9: begin

readln(f,s);

if s='1' then begin Image9.Visible:=true; Image17.Visible:=true; end;

if s='0' then begin Image9.Visible:=false; Image17.Visible:=false; end;

end;

end;

end;

end;

GroupBox1.Visible:=false;

Button1.Visible:=false;

RadioGroup5.Visible:=true;

RadioGroup6.Visible:=true;

RadioGroup7.Visible:=true;

RadioGroup8.Visible:=true;

end;

//координати мишки при русі формою

procedure TForm1.FormMouseMove(Sender: TObject; Shift: TShiftState; X

Y: Integer);

begin

StatusBar1.SimpleText:='X='+ inttostr(X)+ ', Y='+INTTOSTR(Y);

end;

procedure TForm1.Panel1MouseMove(Sender: TObject; Shift: TShiftState; X

Y: Integer);

begin

StatusBar1.SimpleText:='X='+ inttostr(X)+ ', Y='+INTTOSTR(Y);

end;

end.