unit
Unit1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, Math;
type
TForm1 =
class
(TForm)
Edit1: TEdit;
procedure
FormMouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y:
Integer
);
procedure
FormCreate(Sender: TObject);
procedure
FormMouseUp(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y:
Integer
);
procedure
FormMouseMove(Sender: TObject; Shift: TShiftState; X,
Y:
Integer
);
private
public
end
;
var
Form1: TForm1;
f,f1,f2:
boolean
;
xx,yy:
array
of
integer
;
i,j,k,n:
integer
;
rasst1,rasst2:
real
;
implementation
{$R *.dfm}
procedure
figure(xxx,yyy:
array
of
integer
);
var
i,l:
integer
;
begin
with
form1
.
Canvas
do
begin
l:=length(xxx)-
2
;
pen
.
Color:=clwhite;
rectangle(
0
,
0
,form1
.
Width,form1
.
Height);
moveto(xxx[
0
],yyy[
0
]);
pen
.
Color:=clblack;
for
i:=
0
to
l
do
lineto(xxx[i],yyy[i]);
if
f=
true
then
lineto(xxx[
0
],yyy[
0
]);
pen
.
Width:=
1
;
end
;
end
;
procedure
TForm1
.
FormMouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y:
Integer
);
begin
with
form1
.
Canvas
do
begin
if
(shift=[ssleft])
and
(f=
false
)
then
begin
i:=i+
1
;
if
(
10
>
abs
(x-xx[
0
]))
and
(
10
>
abs
(y-yy[
0
]))
then
begin
f:=
true
;
end
else
begin
xx[i]:=x;
yy[i]:=y;
setlength(xx,length(xx)+
1
);
setlength(yy,length(yy)+
1
);
end
;
figure(xx,yy);
end
;
if
(shift=[ssleft])
and
(f=
true
)
then
begin
for
j:=
0
to
i-
1
do
begin
end
;
end
;
if
(shift=[ssright,ssctrl])
and
(f=
true
)
then
begin
for
j:=
0
to
length(xx)
do
begin
if
(
10
>
abs
(x-xx[j]))
and
(
10
>
abs
(y-yy[j]))
then
begin
f1:=
true
;
exit;
end
;
end
;
end
;
if
(shift=[ssright,ssshift])
and
(f=
true
)
then
begin
for
j:=
0
to
length(xx)
do
begin
if
(
10
>
abs
(x-xx[j]))
and
(
10
>
abs
(y-yy[j]))
then
begin
for
k:=j
to
length(xx)-
2
do
begin
xx[k]:=xx[k+
1
];
yy[k]:=yy[k+
1
];
end
;
setlength(xx,length(xx)-
1
);
setlength(yy,length(yy)-
1
);
figure(xx,yy);
exit;
end
;
end
;
end
;
if
(shift=[ssright,ssalt])
and
(f=
true
)
then
begin
n:=length(xx);
for
j:=
0
to
n-
1
do
begin
rasst1:=sqr(power(x-xx[j],
2
)+power(y-yy[j],
2
))+sqr(power(x-xx[j+
1
],
2
)+power(y-yy[j+
1
],
2
));
rasst2:=sqr(power(xx[j+
1
]-xx[j],
2
)+(power(yy[j+
1
]-yy[j],
2
)));
if
rasst1-rasst2<
0
then
begin
edit1
.
text:=
'yes'
;
setlength(xx,length(xx)+
1
);
setlength(yy,length(yy)+
1
);
for
k:=n
downto
j+
1
do
begin
xx[k]:=xx[k-
1
];
yy[k]:=yy[k-
1
];
end
;
xx[j]:=x;
yy[j]:=y;
figure(xx,yy);
exit;
end
;
end
;
end
;
end
;
end
;
procedure
TForm1
.
FormCreate(Sender: TObject);
begin
i:=-
1
;
setlength(xx,
1
);
setlength(yy,
1
);
end
;
procedure
TForm1
.
FormMouseUp(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y:
Integer
);
begin
with
form1
.
canvas
do
begin
if
(Button=mbright)
and
(shift=[ssctrl])
and
(f1=
true
)
then
begin
f1:=
false
;
figure(xx,yy);
end
;
end
;
end
;
procedure
TForm1
.
FormMouseMove(Sender: TObject; Shift: TShiftState; X,
Y:
Integer
);
begin
with
form1
.
Canvas
do
begin
if
(shift=[ssright,ssctrl])
and
(f1=
true
)
then
begin
xx[j]:=x;
yy[j]:=y;
pen
.
Width:=
2
;
figure(xx,yy);
end
;
end
;
end
;
end
.