uses Graph; CONST Num = 10; MinX = 100; MinY = 100; MaxX = 540; MaxY = 380; {---------------------------------------------------------------} Procedure Delay(aMS:word);assembler; asm xor dx, dx mov ax, aMS mov bx, 1000 mul bx mov cx, dx mov dx, ax mov ah, 86h int 15h end; type PList = ^TList; TList = record val : real; x,y : longint; prev: PList; end; {---------------------------------------------------------------} var grDriver : Integer; grMode : Integer; ErrCode : Integer; i,cx,cy : LongInt; List,NNN,Tmp : Plist; {------------------------------------------------------------} Function Angle(x,y:word):real; var x1,y1:longint; ret:real; begin x1 := x-cx; y1 := y-cy; if x1=0 then begin Angle:=(PI/2) - PI * (y1/abs(y1)-1)/2; Exit; end; ret:=arctan(y1/x1); if (x1>0) and (y1<0) then ret:=ret+2*Pi; if ((x1<0) and (y1>0)) or ((x1<0) and (y1<0)) then ret:=ret+Pi; Angle:=ret; end; {==============================================================} Procedure Sort(var List:plist); var ret,t1,t2,t3:plist; min:plist; begin ret:=nil; t1:=List; while t1<>nil do begin t1^.val:=Angle(t1^.x,t1^.y); t1:=t1^.prev end; t1:=List; repeat t2:=t1; min:=t1; while t2^.prev<>nil do begin if t2^.prev^.val t1^.val then begin New(t3); t3^.val := t1^.val; t3^.x := t1^.x; t3^.y := t1^.y; t3^.prev:=ret; ret:=t3; t2:=t1; t1:=t1^.prev; DisPose(t2); end else begin New(t3); t3^.val := min^.prev^.val; t3^.x := min^.prev^.x; t3^.y := min^.prev^.y; t3^.prev:=ret; ret:=t3; t2:=min^.prev; min^.prev := t2^.prev; DisPose(t2); end; until t1^.prev=nil; t1^.prev:=ret; List:=t1; end; {-------------------------------------------------} var deleted,ay,ay1,ay2,ax,ax1,ax2,aa,ab,ac : longint; GGG : string; pr1 : plist; begin grDriver := Detect; InitGraph(grDriver, grMode,' '); ErrCode := GraphResult; if ErrCode = grOk then begin { Do graphics } randomize; List:=nil; cx:=0; cy:=0; for i := 1 to Num do begin New(NNN); NNN^.x:=random(MaxX-minX)+minX; NNN^.y:=random(MaxY-minY)+minY; inc(cx,NNN^.x);inc(cy,NNN^.y); FillEllipse(NNN^.x,NNN^.y,2,2); NNN^.prev := List; List:=NNN end; cx := cx div Num; cy := cy div Num; SetFillStyle(SOLIDFILL,Magenta); FillEllipse(cx,cy,3,3); Sort(List); NNN:=List; SetWriteMode(XORPut); ax1:=1; while (NNN^.prev<>nil) do begin SetColor(Green); Str(ax1,GGG); OutTextXY(NNN^.x,NNN^.y+5,GGG); SetColor(Blue); Line(cx,cy,NNN^.x,NNN^.y); Delay(300); Line(cx,cy,NNN^.x,NNN^.y); Inc(ax1); NNN:=nnn^.prev; end; nnn^.prev:=List; SetColor(Green); Str(ax1,GGG); OutTextXY(NNN^.x,NNN^.y+5,GGG); SetColor(Blue); Line(cx,cy,NNN^.x,NNN^.y); Delay(300); Line(cx,cy,NNN^.x,NNN^.y); repeat NNN:=List; pr1:=List; deleted:=0; repeat ax:=NNN^.prev^.prev^.x;ax1:=NNN^.x;ax2:=NNN^.prev^.x; ay:=NNN^.prev^.prev^.y;ay1:=NNN^.y;ay2:=NNN^.prev^.y; aa:=ay2-ay1; ab:=ax1-ax2; ac:=ay1*(ax2-ax1)-ax1*(ay2-ay1); SetColor(Blue); Line(ax1,ay1,ax2,ay2); SetColor(Red); Line(cx,cy,ax,ay); if ( (aa*ax+ab*ay+ac) * (aa*cx+ab*cy+ac) ) < 0 then begin inc(deleted); tmp:=NNN^.prev; SetColor(Green); Line(ax2-3,ay2-3,ax2+3,ay2+3); Line(ax2-3,ay2+3,ax2+3,ay2-3); if (List=tmp) then List := NNN; NNN^.prev := tmp^.prev; dispose(tmp); NNN:=pr1; end; Delay(500); SetColor(Blue); Line(ax1,ay1,ax2,ay2); SetColor(Red); Line(cx,cy,ax,ay); Pr1:=NNN; NNN:=NNN^.Prev; until NNN=List; until deleted=0; {-------------------------------------------------------} SetColor(Yellow); MoveTo(List^.x,List^.y); NNN:=list^.prev; while (NNN<>List) do begin LineTo(NNN^.x,NNN^.y); Tmp:=NNN; NNN:=NNN^.prev; Dispose(Tmp); end; LineTo(NNN^.x,NNN^.y); Dispose(NNN); Readln; CloseGraph; end else Writeln('Graphics error:', GraphErrorMsg(ErrCode)); end.