-
Нормирование
Процедура нормировки в моей программе norm_coord. Перед нормировкой сначала проверяется необходимость в ней при помощи функции need_norm. Эта функция просматривает массив с вершинами и если хоть одна вершина не находится в области единичного куба, то функция возвращает true, в противном случае false. Процедура нормировки выполнена по стандартному алгоритму – сначала из всех координат ищется минимум по x, y и z. После из всех координат этот минимум вычитается. Затем список вершин просматривается снова, ищется максимум по каждой координате и если он не равен нулю, то в следующем цикле все координаты делятся на соответствующие максимумы. Таким образом, происходит нормировка в единичный куб. Процесс повторяется до тех пор, пока функция need_norm не вернет false. Нормировка вызывается перед занесением информации из таблиц в динамические массивы программы, после открытия файла, перед применением трансформации и после. Необходима по нескольким причинам: во-первых для того, чтобы фигура всегда находилась в поле обзора, во-вторых все трансформации производятся в нормированных координатах и в-третьих от нормированных координат просто переходить к экранным.
-
Ограничение на ввод
Фильтр недопустимых знаков. Позволяет вводить цифры, разделитель.
case Key of
'0' .. '9','-',',':;
else Key :=#0;
end;
Все вводимы значения проверяются на корректность функциями TryStrToFloat и TryStrToInt. После изменения информации в произвольном месте таблиц ребер или вершин, их корректность проверяется функцией table_is_norm.
Тестирование
См. Приложение А
Заключение
В ходе выполнения расчетного задания по компьютерной графике была написана программа для работы с трехмерными объектами. Полученная программа удовлетворяет всем требованиям стандарта СUA. Все задачи, поставленные в техническом задании, выполнены. В ходе выполнения расчетного задания я применил на практике теорию, данную на лекциях. Научился описывать трехмерные объекты при помощи списка вершин и ребер, применять к описанным фигурам трехмерные преобразования. Узнал, в каких случаях следует применять нормировку. Научился работать с экранными координатами.
Приложение А.
Тестирование программы
Вид запущенной программы
Загрузка объекта из файла
Сохранение объекта в файл
Панель “Действие”
Применение трансформации к объекту
Изменение координат вершин после преобразований
Удаление вершины из куба
Удаление ребра из куба
Ошибка при попытке ввести нечисловое значение
Ошибка при попытке ввести отрицательное значение
Ошибка при попытке ввести номер несуществующей вершины
Ошибка при попытке ввести повторяющееся ребро
Ошибка при попытке ввести повторяющуюся вершину
Ошибка при попытке ввести отрицательный коэффициент масштаба
Ошибка при попытке ввести коэффициентом масштаба ноль
Запрос на подтверждение перед выходом
Приложение Б.
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, ComCtrls, Menus, ExtCtrls,printers, Grids, StdCtrls, Buttons,
ActnMan, ActnColorMaps;
type
info=record
sx,sy,sz:real;
tx,ty,tz:real;
rx,ry,rz:real;
end;
vector=array[1..4] of real;
matrix=array[1..4,1..4] of real;
v=record
x,y,z:real;
end;
e=record
b,e:integer;
end;
mode=(vertex,edges);
ed_mode=(rotate,scale,move);
TForm1 = class(TForm)
MainMenu1: TMainMenu;
N2: TMenuItem;
N3: TMenuItem;
N4: TMenuItem;
StatusBar1: TStatusBar;
Image1: TImage;
Image2: TImage;
Image3: TImage;
Image4: TImage;
Panel1: TPanel;
Panel2: TPanel;
Panel3: TPanel;
Panel4: TPanel;
N1: TMenuItem;
N5: TMenuItem;
N6: TMenuItem;
N7: TMenuItem;
N8: TMenuItem;
N9: TMenuItem;
vert: TStringGrid;
edge: TStringGrid;
Button1: TButton;
Button2: TButton;
Button3: TButton;
OpenDialog1: TOpenDialog;
SaveDialog1: TSaveDialog;
Panel5: TPanel;
Panel6: TPanel;
Panel7: TPanel;
Panel8: TPanel;
Panel9: TPanel;
Panel10: TPanel;
GroupBox1: TGroupBox;
Edit1: TEdit;
Edit2: TEdit;
Edit3: TEdit;
Label1: TLabel;
Label2: TLabel;
Label3: TLabel;
Panel11: TPanel;
SpeedButton1: TSpeedButton;
SpeedButton2: TSpeedButton;
SpeedButton3: TSpeedButton;
SpeedButton4: TSpeedButton;
SpeedButton5: TSpeedButton;
SpeedButton8: TSpeedButton;
Button4: TButton;
Label4: TLabel;
Label5: TLabel;
Label6: TLabel;
Label7: TLabel;
procedure Panel2Click(Sender: TObject);
procedure Panel3Click(Sender: TObject);
procedure N5Click(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure N4Click(Sender: TObject);
procedure N3Click(Sender: TObject);
procedure N6Click(Sender: TObject);
procedure N7Click(Sender: TObject);
procedure Panel9Click(Sender: TObject);
procedure Panel10Click(Sender: TObject);
procedure Panel8Click(Sender: TObject);
procedure Panel6Click(Sender: TObject);
procedure Panel7Click(Sender: TObject);
procedure N2Click(Sender: TObject);
procedure Button1Click(Sender: TObject);
procedure Button2Click(Sender: TObject);
procedure Button4Click(Sender: TObject);
procedure Button5Click(Sender: TObject);
procedure N9Click(Sender: TObject);
procedure Button3Click(Sender: TObject);
procedure XOY1Click(Sender: TObject);
procedure SpeedButton1Click(Sender: TObject);
procedure SpeedButton2Click(Sender: TObject);
procedure SpeedButton3Click(Sender: TObject);
procedure SpeedButton5Click(Sender: TObject);
procedure SpeedButton4Click(Sender: TObject);
procedure SpeedButton8Click(Sender: TObject);
procedure OpenDialog1CanClose(Sender: TObject; var CanClose: Boolean);
procedure SaveDialog1CanClose(Sender: TObject; var CanClose: Boolean);
procedure N8Click(Sender: TObject);
procedure Edit1KeyPress(Sender: TObject; var Key: Char);
procedure Edit2KeyPress(Sender: TObject; var Key: Char);
procedure edgeKeyPress(Sender: TObject; var Key: Char);
procedure vertKeyPress(Sender: TObject; var Key: Char);
procedure Edit3KeyPress(Sender: TObject; var Key: Char);
procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean);
private
{ Private declarations }
public
{ Public declarations }
close_bool:boolean;
m:mode;
ed_m: ed_mode;
v_count,e_count:integer;
v_array:array of v;
e_array:array of e;
v_s_array:array of v;
e_s_array:array of e;
row,col:integer;
chg:boolean;
procedure save;
end;
var
path:string='';
scene_info:info;
window1_points:array of tpoint;
window2_points:array of tpoint;
window3_points:array of tpoint;
window4_points:array of tpoint;
Form1: TForm1;
zoy_pr:matrix=((0,0,0,0),
(0,1,0,0),
(0,0,1,0),
(0,0,0,1));
xoz_pr:matrix=((1,0,0,0),
(0,0,0,0),
(0,0,1,0),
(0,0,0,1));
xoy_pr:matrix=((1,0,0,0),
(0,1,0,0),
(0,0,0,0),
(0,0,0,1));
iso_pr:matrix= ((0.707,0.408,0,0),
(0,0.707,0,0),
(0.707,-0.408,0,0),
(0,0,0,1));
transform:matrix=((1,0,0,0),
(0,1,0,0),
(0,0,1,0),
(0,0,0,1));
implementation
uses Unit2;
{$R *.dfm}
function table_is_right(var s:string;par:integer):boolean;
var
i,j:integer;
flag:boolean;
x:Extended;
y:integer;
o:string;
s1,s2,s3:string;
r:integer;
begin
result:=true;
if par=1 then begin
//проверка вершин
flag:=false;
for i:=0 to Form1.vert.RowCount-2
do begin
if not TryStrToFloat(form1.vert.Cells[1,i+1],x) then flag:=true;
if not TryStrToFloat(form1.vert.Cells[2,i+1],x) then flag:=true;
if not TryStrToFloat(form1.vert.Cells[3,i+1],x) then flag:=true;
end;
if flag then
begin
result:=false;
s:='Недопустимые значения координат';
end;
end;
for i:=0 to Form1.vert.RowCount-2 do
begin
s1:=Form1.vert.Cells[1,i+1];
s2:=Form1.vert.Cells[2,i+1];
s3:=Form1.vert.Cells[3,i+1];
r:=0;
for j:=0 to Form1.vert.RowCount-2 do
if ((s1=Form1.vert.Cells[1,j+1])and(s2=Form1.vert.Cells[2,j+1])and(s3=Form1.vert.Cells[3,j+1]))
then inc(r);
if r>1 then begin
result:=false;
s:='Не должно быть одинаковых вершин!';
end;
end;
if par=2 then begin
//проверка ребер
flag:=false;
for i:=0 to Form1.edge.RowCount-2
do begin
if not TryStrToInt(form1.edge.Cells[0,i+1],y) then flag:=true;
if (y<=0)or(y>form1.vert.RowCount) then flag:=true;
if not TryStrToInt(form1.edge.Cells[1,i+1],y) then flag:=true;
if (y<=0)or(y>form1.vert.RowCount) then flag:=true;
end;
if flag then
begin
result:=false;
s:='Недопустимые значения номеров вершин';
end;
for i:=0 to Form1.edge.RowCount-2 do
begin
s1:=Form1.edge.Cells[0,i+1];
s2:=Form1.edge.Cells[1,i+1];
r:=0;
for j:=0 to Form1.edge.RowCount-2 do
if (((s1=Form1.edge.Cells[0,j+1])and(s2=Form1.edge.Cells[1,j+1]))or((s1=Form1.edge.Cells[1,j+1])and(s2=Form1.edge.Cells[0,j+1])))
then inc(r);
if r>1 then begin
result:=false;
s:='Не должно быть одинаковых ребер!';
end;
end;
end;
end;
procedure show_info; //строка статуса
begin
with form1.StatusBar1 do
begin
Panels[0].Text:='Tx= '+FloatToStr(scene_info.tx);
Panels[1].Text:='Ty= '+FloatToStr(scene_info.ty);
Panels[2].Text:='Tz= '+FloatToStr(scene_info.tz);
Panels[3].Text:='Sx= '+FloatToStr(scene_info.Sx);
Panels[4].Text:='Sy= '+FloatToStr(scene_info.Sy);
Panels[5].Text:='Sz= '+FloatToStr(scene_info.Sz);
Panels[6].Text:='Rx= '+FloatToStr(scene_info.Rx);
Panels[7].Text:='Ry= '+FloatToStr(scene_info.Ry);
Panels[8].Text:='Rz= '+FloatToStr(scene_info.Rz);
end;
end;
function need_norm:boolean; //проверка на необходимость нормировки
var
i:integer;
begin
result:=false;
for i:=0 to form1.v_count-1 do
begin
if ((form1.v_array[i].x>1)or(form1.v_array[i].x<0)) then result:=true;
if ((form1.v_array[i].y>1)or(form1.v_array[i].y<0)) then result:=true;
if ((form1.v_array[i].z>1)or(form1.v_array[i].z<0)) then result:=true;
end;
end;
procedure emul(var in_,out_:vector; matr:matrix); //перемножение вектора на матрицу преобразований
begin
out_[1]:=in_[1]*matr[1,1]+in_[2]*matr[2,1]+in_[3]*matr[3,1]+in_[4]*matr[4,1];
out_[2]:=in_[1]*matr[1,2]+in_[2]*matr[2,2]+in_[3]*matr[3,2]+in_[4]*matr[4,2];
out_[3]:=in_[1]*matr[1,3]+in_[2]*matr[2,3]+in_[3]*matr[3,3]+in_[4]*matr[4,3];
out_[4]:=in_[1]*matr[1,4]+in_[2]*matr[2,4]+in_[3]*matr[3,4]+in_[4]*matr[4,4];
end;
procedure clean_matrix; //очистка матрицы преобразования
var
i,j:integer;
begin
for i:=1 to 4 do
for j:=1 to 4 do
transform[i,j]:=0;
end;
procedure transform_pr; //примение трансформации ко всем вершинам
var
i:integer;
v1,v2:vector;
begin
for i:=0 to form1.v_count-1 do
begin
v2[1]:=0;
v2[2]:=0;
v2[3]:=0;
v1[1]:=form1.v_array[i].x;
v1[2]:=form1.v_array[i].y;
v1[3]:=form1.v_array[i].z;
v1[4]:=1;
emul(v1,v2,transform);
form1.v_array[i].x:=v2[1];
form1.v_array[i].y:=v2[2];
form1.v_array[i].z:=v2[3];
end;
end;
procedure norm_coord; //нормирование координат
var
i:integer;
maxx,maxy,maxz:real;
minx,miny,minz:real;
k:real;
begin
while need_norm do begin
maxx:=-MaxInt;
maxy:=-MaxInt;
maxz:=-MaxInt;
minx:=MaxInt;
miny:=MaxInt;
minz:=MaxInt;
for i:=0 to form1.v_count-1 do begin
if form1.v_array[i].x<minx then minx:=form1.v_array[i].x;
if form1.v_array[i].y<miny then miny:=form1.v_array[i].y;
if form1.v_array[i].z<minz then minz:=form1.v_array[i].z;
end;
for i:=0 to form1.v_count-1 do
begin
form1.v_array[i].x:=(form1.v_array[i].x-minx);
form1.v_array[i].y:=(form1.v_array[i].y-miny);
form1.v_array[i].z:=(form1.v_array[i].z-minz);
end;
k:=1;
for i:=0 to form1.v_count-1 do begin
if form1.v_array[i].x>maxx then maxx:=form1.v_array[i].x;
if form1.v_array[i].y>maxy then maxy:=form1.v_array[i].y;
if form1.v_array[i].z>maxz then maxz:=form1.v_array[i].z;
end;
if ((maxx>=maxy)and(maxx>=maxz)) then k:=maxx;
if ((maxy>=maxx)and(maxy>=maxz)) then k:=maxy;
if ((maxz>=maxy)and(maxz>=maxx)) then k:=maxz;
for i:=0 to form1.v_count-1 do
begin
form1.v_array[i].x:=(form1.v_array[i].x)/k;
form1.v_array[i].y:=(form1.v_array[i].y)/k;
form1.v_array[i].z:=(form1.v_array[i].z)/k;
end;
end;
show_info;
end;
procedure draw(window:integer); //рисование
var
i:integer;
v:vector;
v1:vector;
begin
//проекция на xoy
case window of
1:
begin
form1.Image1.Canvas.Rectangle(0,0,220,220);
setlength(window1_points,Form1.v_count);
for i:=0 to Form1.v_count-1 do
begin
v[1]:=Form1.v_array[i].x;
v[2]:=Form1.v_array[i].y;
v[3]:=Form1.v_array[i].z;
v[4]:=0;
emul(v,v,xoy_pr);
window1_points[i].x:=trunc(10+200*v[1]);
window1_points[i].y:=trunc(10+200*v[2]);
end;
for i:=0 to Form1.e_count-1 do
begin
form1.Image1.Canvas.MoveTo(window1_points[form1.e_array[i].b-1].X,window1_points[form1.e_array[i].b-1].y);
form1.Image1.Canvas.LineTo(window1_points[form1.e_array[i].e-1].X,window1_points[form1.e_array[i].e-1].y);
end;
end;
2:
begin
form1.Image2.Canvas.Rectangle(0,0,220,220);
setlength(window2_points,Form1.v_count);
for i:=0 to Form1.v_count-1 do
begin
v[1]:=Form1.v_array[i].x;
v[2]:=Form1.v_array[i].y;
v[3]:=Form1.v_array[i].z;
v[4]:=0;
emul(v,v,xoz_pr);
window2_points[i].x:=trunc(10+200*v[1]);
window2_points[i].y:=trunc(10+200*v[3]);
end;
for i:=0 to Form1.e_count-1 do
begin
form1.Image2.Canvas.MoveTo(window2_points[form1.e_array[i].b-1].X,220-window2_points[form1.e_array[i].b-1].y);
form1.Image2.Canvas.LineTo(window2_points[form1.e_array[i].e-1].X,220-window2_points[form1.e_array[i].e-1].y);
end;
end;
3:
begin
setlength(window3_points,Form1.v_count);
form1.Image3.Canvas.Rectangle(0,0,220,220);
for i:=0 to Form1.v_count-1 do
begin
v[1]:=Form1.v_array[i].x;
v[2]:=Form1.v_array[i].y;
v[3]:=Form1.v_array[i].z;
v[4]:=0;
emul(v,v,zoy_pr);
window3_points[i].x:=trunc(10+200*v[2]);
window3_points[i].y:=trunc(10+200*v[3]);
end;
for i:=0 to Form1.e_count-1 do
begin
form1.Image3.Canvas.MoveTo(window3_points[form1.e_array[i].b-1].X,220-window3_points[form1.e_array[i].b-1].y);
form1.Image3.Canvas.LineTo(window3_points[form1.e_array[i].e-1].X,220-window3_points[form1.e_array[i].e-1].y);
end;
end;
4:
begin
form1.Image4.Canvas.Rectangle(0,0,220,220);
setlength(window4_points,Form1.v_count);
for i:=0 to Form1.v_count-1 do
begin
clean_matrix;
transform[1,1]:=1;
transform[2,2]:=cos(90*Pi/180);
transform[3,3]:=cos(90*pi/180);
transform[2,3]:=-sin(90*Pi/180);
transform[3,2]:=sin(90*Pi/180);
transform[4,4]:=1;
transform_pr;
v[1]:=Form1.v_array[i].x;
v[2]:=Form1.v_array[i].y;
v[3]:=Form1.v_array[i].z;
v[4]:=1;
emul(v,v1,iso_pr);
clean_matrix;
transform[1,1]:=1;
transform[2,2]:=cos(-90*Pi/180);
transform[3,3]:=cos(-90*pi/180);
transform[2,3]:=-sin(-90*Pi/180);
transform[3,2]:=sin(-90*Pi/180);
transform[4,4]:=1;
transform_pr;
if need_norm then norm_coord;
window4_points[i].x:=trunc(100+100*v1[1]);
window4_points[i].y:=trunc(50+100*v1[2]);
end;
for i:=0 to Form1.e_count-1 do
begin
form1.Image4.Canvas.MoveTo(window4_points[form1.e_array[i].b-1].X,220-window4_points[form1.e_array[i].b-1].y);
form1.Image4.Canvas.LineTo(window4_points[form1.e_array[i].e-1].X,220-window4_points[form1.e_array[i].e-1].y);
end;
end;
end;
end;
procedure copy_edge; //копирование информации о ребрах из таблицы
var i:integer;
begin
form1.e_count:=form1.edge.RowCount-1;
setlength(form1.e_array,form1.e_count);
for i:=0 to form1.e_count-1 do
begin
form1.e_array[i].b:=strtoint(form1.edge.Cells[0,i+1]);
form1.e_array[i].e:=strtoint(form1.edge.Cells[1,i+1]);
end;
end;
procedure copy_vert; //копирование информации о вершинах из таблицы
var
i:integer;
begin
form1.v_count:=form1.vert.RowCount-1;
setlength(form1.v_array,form1.v_count);
for i:=1 to form1.v_count do
begin
form1.v_array[i-1].x:=strtofloat(form1.vert.Cells[1,i]);
form1.v_array[i-1].y:=strtofloat(form1.vert.Cells[2,i]);
form1.v_array[i-1].z:=strtofloat(form1.vert.Cells[3,i]);
end;
end;
procedure load; //загрузка объекта
var
f:file of real;
i:integer;
t:real;
begin
assignfile(f,path) ;
reset(f);
read(f,t);
form1.v_count:=trunc(t);
setlength(form1.v_array,trunc(t));
setlength(form1.v_s_array,trunc(t));
form1.vert.RowCount:=trunc(t)+1;
read(f,t);
form1.e_count:=trunc(t);
setlength(form1.e_array,trunc(t));
setlength(form1.e_s_array,trunc(t));
form1.edge.RowCount:=trunc(t)+1;
for i:=1 to form1.v_count do
begin
read(f,t);
form1.vert.Cells[1,i]:=floattostr(t);
form1.v_array[i-1].x:=t;
form1.v_s_array[i-1].x:=t;
read(f,t);
form1.vert.Cells[2,i]:=floattostr(t);
form1.v_array[i-1].y:=t;
form1.v_s_array[i-1].y:=t;
read(f,t);
form1.vert.Cells[3,i]:=floattostr(t);
form1.v_array[i-1].z:=t;
form1.v_s_array[i-1].z:=t;
form1.vert.Cells[0,i]:=inttostr(i);
end;
for i:=1 to form1.e_count do
begin
read(f,t);
form1.edge.Cells[0,i]:=floattostr(t);
form1.e_array[i-1].b:=trunc(t);
form1.e_s_array[i-1].b:=trunc(t);
read(f,t);
form1.edge.Cells[1,i]:=floattostr(t);
form1.e_array[i-1].e:=trunc(t);
form1.e_s_array[i-1].e:=trunc(t);
end;
closefile(f);
norm_coord;
end;
procedure tform1.save; //сохранение объекта
var
f:file of real;
i:integer;
t:real;
begin
assignfile(f,path) ;
rewrite(f);
t:=form1.v_count;
write(f,t);
t:=form1.e_count;
write(f,t);
for i:=1 to form1.v_count do
begin
t:= strtofloat(form1.vert.Cells[1,i]);
write(f,t);
t:= strtofloat(form1.vert.Cells[2,i]);
write(f,t);
t:= strtofloat(form1.vert.Cells[3,i]);
write(f,t);
end;
for i:=1 to form1.e_count do
begin
t:= strtofloat(form1.edge.Cells[0,i]);
write(f,t);
t:= strtofloat(form1.edge.Cells[1,i]);
write(f,t);
end;
closefile(f);
end;
procedure TForm1.Panel2Click(Sender: TObject);
begin
if panel2.BevelInner=bvraised then begin
panel2.BevelInner:=bvLowered;
vert.Visible:=true;
edge.Visible:=false;
panel3.BevelInner:=bvraised;
panel3.Bevelouter:=bvraised;
m:=vertex;
end;
if panel2.Bevelouter=bvraised then begin panel2.BevelOuter:=bvLowered; exit;end;
end;
procedure TForm1.Panel3Click(Sender: TObject);
begin
if panel3.BevelInner=bvraised then begin
panel3.BevelInner:=bvLowered;
edge.Visible:=true;
vert.Visible:=false;
panel2.BevelInner:=bvraised;
panel2.Bevelouter:=bvraised;
m:=edges;
end;
if panel3.Bevelouter=bvraised then begin panel3.BevelOuter:=bvLowered; exit;end;
end;
procedure TForm1.N5Click(Sender: TObject);
begin
mainmenu1.Items[0].Items[2].Enabled:=true;
mainmenu1.Items[0].Items[3].Enabled:=true;
mainmenu1.Items[0].Items[4].Enabled:=true;
label4.Visible:=true;
label5.Visible:=true;
label6.Visible:=true;
label7.Visible:=true;
path:='';
mainmenu1.Items[1].Enabled:=true;
panel1.Visible:=true;
image1.Visible:=true;
image2.Visible:=true;
image3.Visible:=true;
image4.Visible:=true;
image1.Canvas.Rectangle(0,0,220,220);
image2.Canvas.Rectangle(0,0,220,220);
image3.Canvas.Rectangle(0,0,220,220);
image4.Canvas.Rectangle(0,0,220,220);
button1.Visible:=true;
button2.Visible:=true;
button3.Visible:=true;
panel4.Visible:=true;
vert.Visible:=true;
v_count:=0;
e_count:=0;
vert.RowCount:=2;
edge.RowCount:=2;
vert.Cells[0,1]:='1';
vert.Cells[1,1]:='';
vert.Cells[2,1]:='';
vert.Cells[3,1]:='';
edge.Cells[0,1]:='';
edge.Cells[1,1]:='';
end;
procedure TForm1.FormCreate(Sender: TObject);
begin
scene_info.sx:=1;
scene_info.sy:=1;
scene_info.sz:=1;
scene_info.tx:=0;
scene_info.ty:=0;
scene_info.tz:=0;
scene_info.rx:=0;
scene_info.ry:=0;
scene_info.rz:=0;
vert.Cells[1,0]:='x';
vert.Cells[2,0]:='y';
vert.Cells[3,0]:='z';
vert.Cells[0,1]:='1';
edge.Cells[0,0]:='Начало';
edge.Cells[1,0]:='Конец';
m:=vertex;
ed_m:=move;
end;
procedure TForm1.N4Click(Sender: TObject);
begin
if MessageDlg('Вы действительно хотите выйти?',mtConfirmation, [mbYes, mbNo], 0) = mrYes then
begin
if chg then
form2.ShowModal;
if not chg then
Application.Terminate;
end;
end;
procedure TForm1.N3Click(Sender: TObject);
var
printDialog : TPrintDialog;
myPrinter : TPrinter;
r,r1:trect;
begin
printDialog := TPrintDialog.Create(Form1);
if printDialog.Execute then
begin
r.Left:=0;
r.Top:=0;
r.Right:=300;
r.Bottom:=300;
r1.Left:=250;
r1.Top:=250;
r1.Right:=2000;
r1.Bottom:=2000;
myPrinter := Printer;
with myPrinter do
begin
BeginDoc;
canvas.CopyRect(r1,image4.Canvas,r);
EndDoc;
end;
end;
end;
procedure TForm1.N6Click(Sender: TObject);
begin
mainmenu1.Items[0].Items[2].Enabled:=true;
mainmenu1.Items[0].Items[3].Enabled:=true;
mainmenu1.Items[0].Items[4].Enabled:=true;
form1.OpenDialog1.Execute;
label4.Visible:=true;
label5.Visible:=true;
label6.Visible:=true;
label7.Visible:=true;
end;
procedure TForm1.N7Click(Sender: TObject);
begin
if path='' then
form1.SaveDialog1.Execute;
save;
end;
procedure TForm1.Panel9Click(Sender: TObject);
begin
if panel9.BevelInner=bvraised then begin
panel9.BevelInner:=bvLowered;
panel10.BevelInner:=bvraised;
panel10.Bevelouter:=bvraised;
panel11.Visible:=false;
groupbox1.Visible:=true;
button4.Visible:=true;
end;
if panel9.Bevelouter=bvraised then begin panel9.BevelOuter:=bvLowered; exit;end;
end;
procedure TForm1.Panel10Click(Sender: TObject);
begin
if panel10.BevelInner=bvraised then begin
panel10.BevelInner:=bvLowered;
panel9.BevelInner:=bvraised;
panel9.Bevelouter:=bvraised;
panel11.Visible:=true;
groupbox1.Visible:=true;
button4.Visible:=false;
end;
if panel10.Bevelouter=bvraised then begin panel10.BevelOuter:=bvLowered; exit;end;
end;
procedure TForm1.Panel8Click(Sender: TObject);
begin
if panel8.BevelInner=bvraised then begin
panel8.BevelInner:=bvLowered;
panel6.BevelInner:=bvraised;
panel6.Bevelouter:=bvraised;
panel7.BevelInner:=bvraised;
panel7.Bevelouter:=bvraised;
ed_m:=move;
end;
case ed_m of
move:groupbox1.Caption:='Сдвиг';
rotate:groupbox1.Caption:='Поворот';
scale:groupbox1.Caption:='Масштаб';
end;
if panel8.Bevelouter=bvraised then begin panel8.BevelOuter:=bvLowered; exit;end;
end;
procedure TForm1.Panel6Click(Sender: TObject);
begin
if panel6.BevelInner=bvraised then begin
panel6.BevelInner:=bvLowered;
ed_m:=rotate;
panel8.BevelInner:=bvraised;
panel8.Bevelouter:=bvraised;
panel7.BevelInner:=bvraised;
panel7.Bevelouter:=bvraised;
end;
case ed_m of
move:groupbox1.Caption:='Сдвиг';
rotate:groupbox1.Caption:='Поворот';
scale:groupbox1.Caption:='Масштаб';
end;
if panel6.Bevelouter=bvraised then begin panel6.BevelOuter:=bvLowered; exit;end;
end;
procedure TForm1.Panel7Click(Sender: TObject);
begin
ed_m:=scale;
if panel7.BevelInner=bvraised then begin
panel7.BevelInner:=bvLowered;
panel6.BevelInner:=bvraised;
panel6.Bevelouter:=bvraised;
panel8.BevelInner:=bvraised;
panel8.Bevelouter:=bvraised;
end;
case ed_m of
move:groupbox1.Caption:='Сдвиг';
rotate:groupbox1.Caption:='Поворот';
scale:groupbox1.Caption:='Масштаб';
end;
if panel7.Bevelouter=bvraised then begin panel7.BevelOuter:=bvLowered; exit;end;
end;
procedure TForm1.N2Click(Sender: TObject);
begin
panel5.Visible:=true;
end;
procedure TForm1.Button1Click(Sender: TObject);
var
x,y,z:integer;
z1:extended;
i:integer;
b:boolean;
mes:string;
begin
if m=vertex then begin
b:=false;
for i:=1 to 3 do begin
x:=i;
y:=vert.RowCount-1;
if TryStrTofloat(vert.Cells[x,y],z1)=false then
begin
b:=true;
vert.Cells[x,y]:='';
end;
end;
vert.RowCount:=vert.RowCount+1;
vert.Cells[0,y+1]:=inttostr(y+1);
if b then begin
vert.RowCount:=vert.RowCount-1;
showmessage('Недопустимые значения координат!');
end;
end;
if m=edges then begin
b:=false;
mes:='';
for i:=0 to 1 do begin
x:=i;
y:=edge.RowCount-1;
if (TryStrToInt(edge.Cells[x,y],z)=true) then
if ((z>v_count)or(z<=0)) then
begin
b:=true;
edge.Cells[x,y]:='';
mes:='Вершины с таким номером не существует!';
end;
if (TryStrToInt(edge.Cells[x,y],z)=false) then
begin
b:=true;
edge.Cells[x,y]:='';
mes:='Введенный номер вершины не является целым числом!'
end;
end;
if edge.Cells[0,edge.RowCount-1]=edge.Cells[1,edge.RowCount-1] then
begin
b:=true;
edge.Cells[0,edge.RowCount-1]:='';
edge.Cells[1,edge.RowCount-1]:='';
mes:='Начало ребра не может быть его концом!'
end;
for i:=0 to edge.RowCount-2
do if (((edge.Cells[0,edge.RowCount-1]=edge.Cells[0,i])and(edge.Cells[1,edge.RowCount-1]=edge.Cells[1,i]))or((edge.Cells[0,edge.RowCount-1]=edge.Cells[1,i])and(edge.Cells[1,edge.RowCount-1]=edge.Cells[0,i])))
then begin
b:=true;
edge.Cells[0,edge.RowCount-1]:='';
edge.Cells[1,edge.RowCount-1]:='';
mes:='Такое ребро уже существует!';
end;
edge.RowCount:=edge.RowCount+1;
if b then begin
edge.RowCount:=edge.RowCount-1;
showmessage(mes);
end;
end;
end;
procedure TForm1.Button2Click(Sender: TObject);
var
k,i,j:integer;
begin
if m=vertex then
if vert.RowCount>1 then
begin
k:=vert.Row;
for i:=k to vert.RowCount-2 do
begin
vert.Cells[1,i]:=vert.Cells[1,i+1];
vert.Cells[2,i]:=vert.Cells[2,i+1];
vert.Cells[3,i]:=vert.Cells[3,i+1];
end;
for j:=1 to e_count do
if (edge.Cells[0,j]=inttostr(k))or(edge.Cells[1,j]=inttostr(k))
then
begin
for i:=j to edge.RowCount-2 do
begin
edge.Cells[0,i]:=edge.Cells[0,i+1];
edge.Cells[1,i]:=edge.Cells[1,i+1];
end;
edge.RowCount:=edge.RowCount-1;
end;
for j:=1 to e_count do
begin
if strtoint(edge.Cells[0,j])>(k) then edge.Cells[0,j]:=inttostr(strtoint(edge.Cells[0,j])-1);
if strtoint(edge.Cells[1,j])>(k) then edge.Cells[1,j]:=inttostr(strtoint(edge.Cells[1,j])-1);
end;
vert.RowCount:=vert.RowCount-1;
end;
if m=edges then
if edge.RowCount>1 then
begin
k:=edge.Row;
for i:=k to edge.RowCount-2 do
begin
edge.Cells[0,i]:=edge.Cells[0,i+1];
edge.Cells[1,i]:=edge.Cells[1,i+1];
end;
edge.RowCount:=edge.RowCount-1;
end;
copy_vert;
copy_edge;
end;
procedure TForm1.Button4Click(Sender: TObject);
label
lab;
var
b:boolean;
l:extended;
begin
b:=false;
if not((TryStrToFloat(edit1.Text,l))and(TryStrToFloat(edit2.Text,l))and(TryStrToFloat(edit3.Text,l)))
then begin b:=true; goto lab; end;
if ed_m=scale then
begin
if (StrToFloat(edit1.Text)<0.01)or(StrToFloat(edit2.Text)<0.01)or(StrToFloat(edit3.Text)<0.01)
then b:=true;
end;
lab:if b then begin
showmessage('Ошибка ввода');
edit1.Text:='';
edit2.Text:='';
edit3.Text:='';
exit;
end;
if (panel9.BevelInner=bvLowered) and (not b) then groupbox1.Visible:=false;
if ((ed_m=move)and(panel9.BevelInner=bvlowered))
then
begin
clean_matrix;
transform[1,1]:=1;
transform[2,2]:=1;
transform[3,3]:=1;
transform[4,1]:=Strtofloat(edit1.Text);
transform[4,2]:=Strtofloat(edit2.Text);
transform[4,3]:=Strtofloat(edit3.Text);
transform_pr;
scene_info.tx:=scene_info.tx+Strtofloat(edit1.Text);
scene_info.ty:=scene_info.ty+Strtofloat(edit2.Text);
scene_info.tz:=scene_info.tz+Strtofloat(edit3.Text);
end;
if ((ed_m=scale)and(panel9.BevelInner=bvlowered))
then
begin
clean_matrix;
transform[1,1]:=StrToFloat(edit1.Text);
transform[2,2]:=StrToFloat(edit2.Text);
transform[3,3]:=StrToFloat(edit3.Text);
transform[4,4]:=0;
transform_pr;
if need_norm then norm_coord;
scene_info.sx:=scene_info.sx*StrToFloat(edit1.Text);
scene_info.sy:=scene_info.sy*StrToFloat(edit2.Text);
scene_info.sz:=scene_info.sz*StrToFloat(edit3.Text);
show_info;
groupbox1.Visible:=false;
end;
// поворот
if ((ed_m=rotate)and(panel9.BevelInner=bvlowered))
then
begin
norm_coord;
//по х
clean_matrix;
transform[1,1]:=1;
transform[2,2]:=cos(StrToFloat(edit1.Text)*Pi/180);
transform[3,3]:=cos(StrToFloat(edit1.Text)*Pi/180);
transform[2,3]:=-sin(StrToFloat(edit1.Text)*Pi/180);
transform[3,2]:=sin(StrToFloat(edit1.Text)*Pi/180);
transform[4,4]:=1;
transform_pr;
// по y
clean_matrix;
transform[1,1]:=cos(StrToFloat(edit3.Text)*Pi/180);
transform[2,2]:=cos(StrToFloat(edit3.Text)*Pi/180);
transform[1,2]:=sin(StrToFloat(edit3.Text)*Pi/180);
transform[2,1]:=-sin(StrToFloat(edit3.Text)*Pi/180);
transform[3,3]:=1;
transform[4,4]:=1;
transform_pr;
// по z
clean_matrix;
transform[1,1]:=cos(StrToFloat(edit2.Text)*Pi/180);
transform[2,2]:=1;
transform[3,3]:=cos(StrToFloat(edit2.Text)*Pi/180);
transform[4,4]:=1;
transform[3,1]:=sin(StrToFloat(edit2.Text)*Pi/180);
transform[1,3]:=-sin(StrToFloat(edit2.Text)*Pi/180);
transform_pr;
if need_norm then norm_coord;
scene_info.rx:=scene_info.rx+StrToFloat(edit1.Text);
scene_info.ry:=scene_info.ry+StrToFloat(edit2.Text);
scene_info.rz:=scene_info.rz+StrToFloat(edit3.Text);
end;
if need_norm then norm_coord;
show_info;
draw(1);
draw(2);
draw(3);
draw(4);
end;
procedure TForm1.Button5Click(Sender: TObject);
begin
form1.Close;
end;
procedure TForm1.N9Click(Sender: TObject);
begin
panel5.Visible:=false;
panel4.Visible:=true;
panel1.Visible:=true;
end;
procedure TForm1.Button3Click(Sender: TObject);
var
s:string;
begin
if m=vertex then
if table_is_right(s,1) then
copy_vert else showmessage(s);
if m=edges then
if table_is_right(s,2) then
copy_edge else ShowMessage(s);
chg:=true;
norm_coord;
draw(1);
draw(2);
draw(3);
draw(4);
//panel4.Visible:=false;
// panel1.Visible:=false;
end;
procedure TForm1.XOY1Click(Sender: TObject);
begin
norm_coord;
draw(1);
draw(2);
draw(3);
draw(4);
end;
procedure TForm1.SpeedButton1Click(Sender: TObject);
var
l:extended;
begin
if not((TryStrToFloat(edit1.Text,l))) then
begin
ShowMessage('Ошибка ввода');
exit;
end;
if ((ed_m=scale)and(panel9.BevelInner=bvraised))
then
begin
if l<0.1 then
begin
ShowMessage('Слишком маленький коэффициент!');
exit;
end;
clean_matrix;
transform[1,1]:=StrToFloat(edit1.Text);
transform[2,2]:=1;
transform[3,3]:=1;
transform_pr;
scene_info.sx:=scene_info.sx*StrToFloat(edit1.Text);
end;
if ((ed_m=move)and(panel9.BevelInner=bvraised))
then
begin
clean_matrix;
transform[1,1]:=1;
transform[2,2]:=1;
transform[3,3]:=1;
transform[4,1]:=Strtofloat(edit1.Text);
scene_info.tx:=scene_info.tx+StrToFloat(edit1.Text);
transform_pr;
end;
if ((ed_m=rotate)and(panel9.BevelInner=bvraised))
then
begin
clean_matrix;
transform[1,1]:=1;
transform[2,2]:=cos(StrToFloat(edit1.Text)*Pi/180);
transform[3,3]:=cos(StrToFloat(edit1.Text)*Pi/180);
transform[2,3]:=-sin(StrToFloat(edit1.Text)*Pi/180);
transform[3,2]:=sin(StrToFloat(edit1.Text)*Pi/180);
transform[4,4]:=1;
transform_pr;
scene_info.rx:=scene_info.rx+StrToFloat(edit1.Text);
end;
if need_norm then norm_coord;
show_info;
draw(1);
draw(2);
draw(3);
draw(4);
end;
procedure TForm1.SpeedButton2Click(Sender: TObject);
var
l:extended;
begin
if not((TryStrToFloat(edit1.Text,l))) then
begin
ShowMessage('Ошибка ввода');
exit;
end;
if ((ed_m=scale)and(panel9.BevelInner=bvraised))
then
begin
if l<0.1 then
begin
ShowMessage('Слишком маленький коэффициент!');
exit;
end;
clean_matrix;
transform[1,1]:=1/StrToFloat(edit1.Text);
transform[2,2]:=1;
transform[3,3]:=1;
transform[4,4]:=0;
transform_pr;
scene_info.sx:=scene_info.sx/StrToFloat(edit1.Text);
end;
if ((ed_m=move)and(panel9.BevelInner=bvraised))
then
begin
clean_matrix;
transform[1,1]:=1;
transform[2,2]:=1;
transform[3,3]:=1;
transform[4,1]:=-Strtofloat(edit1.Text);
transform_pr;
scene_info.tx:=scene_info.tx-StrToFloat(edit1.Text);
end;
if ((ed_m=rotate)and(panel9.BevelInner=bvraised))
then
begin
clean_matrix;
transform[1,1]:=1;
transform[2,2]:=cos(StrToFloat(edit1.Text)*Pi/180);
transform[3,3]:=cos(StrToFloat(edit1.Text)*Pi/180);
transform[2,3]:=sin(StrToFloat(edit1.Text)*Pi/180);
transform[3,2]:=-sin(StrToFloat(edit1.Text)*Pi/180);
transform[4,4]:=1;
transform_pr;
scene_info.rx:=scene_info.rx-StrToFloat(edit1.Text);
end;
if need_norm then norm_coord;
show_info;
draw(1);
draw(2);
draw(3);
draw(4);
end;
procedure TForm1.SpeedButton3Click(Sender: TObject);
var
l:extended;
begin
if not((TryStrToFloat(edit2.Text,l))) then
begin
ShowMessage('Ошибка ввода');
exit;
end;
if ((ed_m=rotate)and(panel9.BevelInner=bvraised))
then
begin
clean_matrix;
///
transform[1,1]:=cos(StrToFloat(edit2.Text)*Pi/180);
transform[2,2]:=1;
transform[3,3]:=cos(StrToFloat(edit2.Text)*Pi/180);
transform[4,4]:=1;
transform[3,1]:=sin(StrToFloat(edit2.Text)*Pi/180);
transform[1,3]:=-sin(StrToFloat(edit2.Text)*Pi/180);
//
transform_pr;
scene_info.ry:=scene_info.ry+StrToFloat(edit2.Text);
end;
if ((ed_m=scale)and(panel9.BevelInner=bvraised))
then
begin
if l<0.1 then
begin
ShowMessage('Слишком маленький коэффициент!');
exit;
end;
clean_matrix;
transform[1,1]:=1;
transform[2,2]:=StrToFloat(edit2.Text);
transform[3,3]:=1;
transform_pr;
scene_info.sy:=scene_info.sy*StrToFloat(edit2.Text);
end;
if ((ed_m=move)and(panel9.BevelInner=bvraised))
then
begin
clean_matrix;
transform[1,1]:=1;
transform[2,2]:=1;
transform[3,3]:=1;
transform[4,2]:=Strtofloat(edit2.Text);
transform_pr;
scene_info.ty:=scene_info.ty+StrToFloat(edit2.Text);
end;
if need_norm then norm_coord;
show_info;
draw(1);
draw(2);
draw(3);
draw(4);
end;
procedure TForm1.SpeedButton5Click(Sender: TObject);
var
l:extended;
begin
if not((TryStrToFloat(edit3.Text,l))) then
begin
ShowMessage('Ошибка ввода');
exit;
end;
if ((ed_m=rotate)and(panel9.BevelInner=bvraised))
then
begin
clean_matrix;
//
transform[1,1]:=cos(StrToFloat(edit3.Text)*Pi/180);
transform[2,2]:=cos(StrToFloat(edit3.Text)*Pi/180);
transform[1,2]:=sin(StrToFloat(edit3.Text)*Pi/180);
transform[2,1]:=-sin(StrToFloat(edit3.Text)*Pi/180);
transform[3,3]:=1;
transform[4,4]:=1;
//
transform_pr;
scene_info.rz:=scene_info.rz+StrToFloat(edit3.Text);
end;
if ((ed_m=scale)and(panel9.BevelInner=bvraised))
then
begin
if l<0.1 then
begin
ShowMessage('Слишком маленький коэффициент!');
exit;
end;
clean_matrix;
transform[1,1]:=1;
transform[2,2]:=1;
transform[3,3]:=StrToFloat(edit3.Text);
transform_pr;
scene_info.sz:=scene_info.sz*StrToFloat(edit3.Text);
end;
if ((ed_m=move)and(panel9.BevelInner=bvraised))
then
begin
clean_matrix;
transform[1,1]:=1;
transform[2,2]:=1;
transform[3,3]:=1;
transform[4,3]:=Strtofloat(edit3.Text);
transform_pr;
scene_info.tz:=scene_info.tz+StrToFloat(edit3.Text);
end;
if need_norm then norm_coord;
show_info;
draw(1);
draw(2);
draw(3);
draw(4);
end;
procedure TForm1.SpeedButton4Click(Sender: TObject);
var
l:extended;
begin
if not((TryStrToFloat(edit2.Text,l))) then
begin
ShowMessage('Ошибка ввода');
exit;
end;
if ((ed_m=rotate)and(panel9.BevelInner=bvraised))
then
begin
clean_matrix;
///
transform[1,1]:=cos(-StrToFloat(edit2.Text)*Pi/180);
transform[2,2]:=1;
transform[3,3]:=cos(-StrToFloat(edit2.Text)*Pi/180);
transform[4,4]:=1;
transform[3,1]:=sin(-StrToFloat(edit2.Text)*Pi/180);
transform[1,3]:=-sin(-StrToFloat(edit2.Text)*Pi/180);
//
transform_pr;
scene_info.ry:=scene_info.ry-StrToFloat(edit2.Text);
end;
if ((ed_m=scale)and(panel9.BevelInner=bvraised))
then
begin
if l<0.1 then
begin
ShowMessage('Слишком маленький коэффициент!');
exit;
end;
clean_matrix;
transform[1,1]:=1;
transform[2,2]:=1/StrToFloat(edit2.Text);
transform[3,3]:=1;
transform_pr;
scene_info.sy:=scene_info.sy/StrToFloat(edit2.Text);
end;
if ((ed_m=move)and(panel9.BevelInner=bvraised))
then
begin
clean_matrix;
transform[1,1]:=1;
transform[2,2]:=1;
transform[3,3]:=1;
transform[4,2]:=-Strtofloat(edit2.Text);
transform_pr;
scene_info.ty:=scene_info.ty-StrToFloat(edit2.Text);
end;
if need_norm then norm_coord;
show_info;
draw(1);
draw(2);
draw(3);
draw(4);
end;
procedure TForm1.SpeedButton8Click(Sender: TObject);
var
l:extended;
begin
if not((TryStrToFloat(edit3.Text,l))) then
begin
ShowMessage('Ошибка ввода');
exit;
end;
if ((ed_m=rotate)and(panel9.BevelInner=bvraised))
then
begin
clean_matrix;
//
transform[1,1]:=cos(-StrToFloat(edit3.Text)*Pi/180);
transform[2,2]:=cos(-StrToFloat(edit3.Text)*Pi/180);
transform[1,2]:=sin(-StrToFloat(edit3.Text)*Pi/180);
transform[2,1]:=-sin(-StrToFloat(edit3.Text)*Pi/180);
transform[3,3]:=1;
transform[4,4]:=1;
//
transform_pr;
scene_info.rz:=scene_info.rz-StrToFloat(edit3.Text);
end;
if ((ed_m=scale)and(panel9.BevelInner=bvraised))
then
begin
if l<0.1 then
begin
ShowMessage('Слишком маленький коэффициент!');
exit;
end;
clean_matrix;
transform[1,1]:=1;
transform[2,2]:=1;
transform[3,3]:=1/StrToFloat(edit3.Text);
transform_pr;
scene_info.sz:=scene_info.sz/StrToFloat(edit3.Text);
end;
if ((ed_m=move)and(panel9.BevelInner=bvraised))
then
begin
clean_matrix;
transform[1,1]:=1;
transform[2,2]:=1;
transform[3,3]:=1;
transform[4,3]:=-Strtofloat(edit3.Text);
transform_pr;
scene_info.tz:=scene_info.tz-StrToFloat(edit3.Text);
end;
if need_norm then norm_coord;
show_info;
draw(1);
draw(2);
draw(3);
draw(4);
end;
procedure TForm1.OpenDialog1CanClose(Sender: TObject;
var CanClose: Boolean);
begin
if opendialog1.FileName<>'' then
begin
path:=opendialog1.FileName;
mainmenu1.Items[1].Enabled:=true;
panel1.Visible:=true;
image1.Visible:=true;
image2.Visible:=true;
image3.Visible:=true;
image4.Visible:=true;
image1.Canvas.Rectangle(0,0,220,220);
image2.Canvas.Rectangle(0,0,220,220);
image3.Canvas.Rectangle(0,0,220,220);
image4.Canvas.Rectangle(0,0,220,220);
button1.Visible:=true;
button2.Visible:=true;
button3.Visible:=true;
panel4.Visible:=true;
vert.Visible:=true;
mainmenu1.Items[1].Enabled:=true;
load;
norm_coord;
draw(1) ;
draw(2) ;
draw(3) ;
draw(4) ;
end;
end;
procedure TForm1.SaveDialog1CanClose(Sender: TObject;
var CanClose: Boolean);
begin
if savedialog1.FileName<>'' then
path:=savedialog1.FileName;
end;
procedure TForm1.N8Click(Sender: TObject);
begin
savedialog1.Execute;
save;
end;
procedure TForm1.Edit1KeyPress(Sender: TObject; var Key: Char);
begin
case Key of
'0' .. '9','-',',':;
else Key :=#0;
end;
end;
procedure TForm1.Edit2KeyPress(Sender: TObject; var Key: Char);
begin
case Key of
'0' .. '9','-',',':;
else Key :=#0;
end;
end;
procedure TForm1.edgeKeyPress(Sender: TObject; var Key: Char);
begin
case Key of
'0' .. '9','-',',':;
else Key :=#0;
end;
end;
procedure TForm1.vertKeyPress(Sender: TObject; var Key: Char);
begin
case Key of
'0' .. '9','-',',':;
else Key :=#0;
end;
end;
procedure TForm1.Edit3KeyPress(Sender: TObject; var Key: Char);
begin
case Key of
'0' .. '9','-',',':;
else Key :=#0;
end;
end;
procedure TForm1.FormCloseQuery(Sender: TObject; var CanClose: Boolean);
begin
canclose:=false;
if MessageDlg('Вы действительно хотите выйти?',mtConfirmation, [mbYes, mbNo], 0) = mrYes then
begin
if chg then
form2.ShowModal;
if not chg then
Application.Terminate;
end;
end;
end.
Untit2
unit Unit2;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls;
type
TForm2 = class(TForm)
Button1: TButton;
Button2: TButton;
Button3: TButton;
Label1: TLabel;
procedure Button1Click(Sender: TObject);
procedure Button2Click(Sender: TObject);
procedure Button3Click(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
var
Form2: TForm2;
implementation
uses Unit1;
{$R *.dfm}
procedure TForm2.Button1Click(Sender: TObject);
begin
if path='' then
form1.SaveDialog1.Execute;
form1.save;
Application.Terminate;
end;
procedure TForm2.Button2Click(Sender: TObject);
begin
Application.Terminate;
end;
procedure TForm2.Button3Click(Sender: TObject);
begin
form2.Close;
end;
end.
unit Unit3;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls;
type
TForm3 = class(TForm)
Label1: TLabel;
Button2: TButton;
Button1: TButton;
procedure Button1Click(Sender: TObject);
procedure Button2Click(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
var
Form3: TForm3;
implementation
uses Unit1;
{$R *.dfm}
procedure TForm3.Button1Click(Sender: TObject);
begin
res:=1;
form3.Close;
end;
procedure TForm3.Button2Click(Sender: TObject);
begin
res:=2;
form3.Close;
end;
end.
Модульная структура программы
Связь процедур и функций
