private
{ Private declarations }
public
{ Public declarations }
end;
var
Form1: TForm1;
cn,sn:pr;
mx,my:tp;
strr:string;
x0,y0:integer;
time:double;
tt:pr;
kkk:integer;
implementation
{$R *.DFM}
procedure Writ(x,y:tp);
var t:pr;
begin
new(t);
t^.x:=x;
t^.y:=y;
t^.n:=sn;
sn:=t;
end;
procedure TForm1.PaintBox1Paint(Sender: TObject);
var t:pr;
rect:TRect;
x,y:integer;
begin
with PaintBox1 do
begin
Canvas.Brush.Color :=clBtnFace;
rect.Left:=0;
rect.Top:=0;
rect.Bottom:=Height;
rect.Right:=Width;
Canvas.FillRect(rect);
Canvas.Pen.Color :=clGray;
x0:=Width div 2;
y0:=Height div 2;
Canvas.MoveTo(x0,y0);
Canvas.LineTo(x0,0);
Canvas.MoveTo(x0,y0);
Canvas.LineTo(x0,Height);
Canvas.MoveTo(x0,y0);
Canvas.LineTo(0,y0);
Canvas.MoveTo(x0,y0);
Canvas.LineTo(Width,y0);
Canvas.Pen.Color :=clGreen;
if sn<>nil then
begin
t:=sn;
x:=x0+Trunc(t^.x*mx);
y:=y0+Trunc(t^.y*my);
Canvas.MoveTo(x,y);
while t<>nil do
begin
x:=x0+Trunc(t^.x*mx);
y:=y0+Trunc(t^.y*my);
Canvas.LineTo(x,y);
t:=t^.n;
end;
x:=x0+Trunc(sn^.x*mx);
y:=y0+Trunc(sn^.y*my);
Canvas.LineTo(x,y);
end;
Canvas.Pen.Color :=clBlue;
t:=cn;
while t<>nil do
begin
x:=x0+Trunc(t^.x*mx);
y:=y0+Trunc(t^.y*my);
Canvas.Ellipse(x-1,y-1,x+1,y+1);
t:=t^.n;
end;
end;
end;
procedure TForm1.RandomButtonClick(Sender: TObject);
var
i:integer;
t:pr;
begin
randomize();
while cn<>nil do
begin
t:=cn^.n;
dispose(cn);
cn:=t;
end;
while sn<>nil do
begin
t:=sn^.n;
dispose(sn);
sn:=t;
end;
mx:=0;
my:=0;
for i:=1 to QRandom.Value do
begin
new(t);
t^.n:=cn;
cn:=t;
t^.x:=random(2*Range.Value+1)-Range.Value;
t^.y:=random(2*Range.Value+1)-Range.Value;
if mx0 then mx:=0.8*(Width div 2)/mx;
if my<>0 then my:=0.8*(Height div 2)/my;
PaintBox1.Refresh;
end;
procedure TForm1.ResetButtonClick(Sender: TObject);
var
t:pr;
begin
while cn<>nil do
begin
t:=cn^.n;
dispose(cn);
cn:=t;
end;
while sn<>nil do
begin
t:=sn^.n;
dispose(sn);
sn:=t;
end;
mx:=1;
my:=1;
PaintBox1.Refresh;
end;
procedure TForm1.FormCreate(Sender: TObject);
begin
cn:=nil;
sn:=nil;
mx:=1;
my:=1;
with PaintBox1 do
begin
x0:=Width div 2;
y0:=Height div 2;
end;
end;
procedure TForm1.GrahamButtonClick(Sender: TObject);
label repl;
type
prec=^rec;
rec=record
x,y:tp;
Не нашли нужную работу? Закажи реферат, курсовую, диплом на заказ
next,prev:prec;
end;
var st,t,s,l,r,p:prec;
procedure inss(var st:prec;t,d:prec);
begin
if st=nil then
begin
st:=t;
d^.next:=t;
st^.prev:=d;
end else
begin
st^.prev^.next:=t;
d^.next:=st;
t^.prev:=st^.prev;
st^.prev:=d;
end;
end;
procedure ins(var st,t:prec);
begin
if st=nil then
begin
st:=t;
st^.next:=t;
st^.prev:=t;
end else
begin
t^.next:=st;
t^.prev:=st^.prev;
st^.prev^.next:=t;
st^.prev:=t;
end;
end;
procedure cut(var st,t:prec);
begin
if st^.next=st then st:=nil else
begin
if t=st
then st:=t^.next;
t^.next^.prev:=t^.prev;
t^.prev^.next:=t^.next;
end;
end;
procedure sort(var b:prec;e:prec);
var p,q:prec;
x:tp;
begin
if b=e then exit;
if b^.next=e then
begin
if (b^.x>e^.x) or ((b^.x=e^.x)and(b^.y>e^.y)) then
begin
x:=b^.x;
b^.x:=e^.x;
e^.x:=x;
x:=b^.y;
b^.y:=e^.y;
e^.y:=x;
end;
exit;
end;
p:=b;
q:=e;
while (p<>q)and(p^.next<>q) do
begin
p:=p^.next;
q:=q^.prev;
end;
if p=q then q:=q.next;
p^.next:=b;
b^.prev:=p;
q^.prev:=e;
e^.next:=q;
sort(b,p);
sort(q,e);
p:=b;
b:=nil;
while (p<>nil)and(q<>nil) do
begin
if (p^.x>q^.x)or((p^.x=q^.x)and(p^.y>q^.y)) then
begin
e:=q;
cut(q,e);
ins(b,e);
end else
begin
e:=p;
cut(p,e);
ins(b,e);
end;
end;
if p<>nil then
begin
e:=p;
inss(b,e,e^.prev);
end;
if q<>nil then
begin
e:=q;
inss(b,e,e^.prev);
end;
end;
procedure sort2(var b:prec;e:prec);
var p,q:prec;
x:tp;
begin
if b=e then exit;
if b^.next=e then
begin
if (b^.xq)and(p^.next<>q) do
begin
p:=p^.next;
q:=q^.prev;
end;
if p=q then q:=q.next;
p^.next:=b;
b^.prev:=p;
q^.prev:=e;
e^.next:=q;
sort2(b,p);
sort2(q,e);
p:=b;
b:=nil;
while (p<>nil)and(q<>nil) do
begin
if (p^.xnil then
begin
e:=p;
inss(b,e,e^.prev);
end;
if q<>nil then
begin
e:=q;
inss(b,e,e^.prev);
end;
end;
procedure grah(var st:prec);
var r,t,g:prec;
f:integer;
begin
if st^.next=st^.prev then exit;
r:=st;
t:=st;
f:=0;
while (f<=0) or (t<>r) do
begin
if (t^.next^.x-t^.prev^.x)*(t^.y-t^.prev^.y)>=(t^.x-t^.prev^.x)*(t^.next^.y-t^.prev^.y) then
begin
if t=r then
begin
dec(f);
r:=t^.next;
end;
t:=t^.prev;
g:=t^.next;
cut(st,g);
dispose(g);
end else
begin
t:=t^.next;
if t=r then inc(f);
end;
end;
end;
begin
time:=now;
kkk:=0;
repeat
while sn<>nil do
begin
tt:=sn^.n;
dispose(sn);
sn:=tt;
end;
st:=nil;
s:=nil;
tt:=cn;
if tt=nil then exit;
while tt<>nil do
begin
new(t);
t^.x:=tt^.x;
t^.y:=tt^.y;
tt:=tt^.n;
ins(st,t);
end;
if st=nil then exit;
l:=st;
r:=st;
t:=st;
repeat
if (r^.xt^.x) or ((l^.y>t^.y)and(l^.x=t^.x)) then l:=t;
t:=t^.next;
until t=st;
if l^.x=r^.x then
begin
str((now-time)*24*60*60:0:2,strr);
TimeL.Caption:=strr+'s';
writ(l^.x,l^.y);
if not((r^.x=l^.x)and(r^.y=l^.y)) then writ(r^.x,r^.y);
t:=l;
while l<>nil do
begin
t:=l;
cut(l,t);
dispose(t);
end;
exit;
end;
t:=l;
t:=st;
repeat
repl:
if st=nil then break;
p:=t;
t:=t^.next;
if (p^.x-l^.x)*(r^.y-l^.y)<=(p^.y-l^.y)*(r^.x-l^.x) then
begin
cut(st,p);
ins(s,p);
goto repl;
end;
until t=st;
sort2(s,s^.prev);
if st <> nil then
Рефераты и/или содержимое рефератов предназначено исключительно для ознакомления, без целей коммерческого использования. Все права в отношении рефератов и/или содержимого рефератов принадлежат их законным правообладателям. Любое их использование возможно лишь с согласия законных правообладателей. Администрация сайта не несет ответственности за возможный вред и/или убытки, возникшие или полученные в связи с использованием рефератов и/или содержимого рефератов.