Welcome, guest! Login / Register - Why register?
Psst.. new poll here.
Psst.. new forums here.
Microsoft is blocking us again (TY IP Reputation!) so just use oauth login instead. :)

Paste

Pasted by kenny ( 15 years ago )
program fff;
Uses
 crt,graph;
const
 d=50;
type
 MWays=array[1..3] of longint;
 MFlags=array[1..4] of boolean;
 Engine=record
  AddX:integer;
  AddY:integer;
  F:Mflags;
 end;
 MPeople=array[1..3] of Engine;
var
 Driver,Mode,Error,a,b,x1,x2,y1,y2,c,e,i,j:integer;
 n:byte;
 s:MWays;
 Info:MPeople;
 {F:Mflags;}

procedure PreFlags(var F:MFlags);
var
 i:byte;
Begin
 for i:=1 to 14 do
  F[i]:=True;
end;

procedure CheckResolution(var a,b:integer);
Begin
 a:=GetMaxX;
 b:=GetMaxY;
end;

function DetWay(var n,i:byte; var x1,x2,y1,y2:integer):longint;
Begin
 DetWay:=((x2-x1-2*i*d)*2+(y2-y1-2*i*d)*2)*n;
end;

procedure DrawRectangle(var a,b,x1,x2,y1,y2:integer);
var
 i:byte;
Begin
 x1:=a div 150;
 y1:=b div 149;
 x2:=x1*149;
 y2:=y1*148;
 for i:=0 to 3 do
  Rectangle(x1+i*d,y1+i*d,x2-i*d,y2-i*d);
 for i:=0 to 2 do
  s[i+1]:=DetWay(n,i,x1,x2,y1,y2);
end;

procedure DrawPeople1(var x1,y1,c,e:integer);
Begin
 Circle(x1+125+c,y1+5+e,5);
 Line(x1+125+c,y1+10+e,x1+120+c,y1+30+e); {tulovishe}
 Line(x1+125+c,y1+10+e,x1+130+c,y1+20+e); {pravaya ruka}
 Line(x1+130+c,y1+20+e,x1+140+c,y1+15+e);
 Line(x1+125+c,y1+10+e,x1+115+c,y1+15+e); {levaya ruka}
 Line(x1+115+c,y1+15+e,x1+117+c,y1+23+e);
 Line(x1+120+c,y1+30+e,x1+135+c,y1+35+e); {pravaya noga}
 Line(x1+135+c,y1+35+e,x1+130+c,y1+45+e);
 Line(x1+130+c,y1+45+e,x1+135+c,y1+47+e);
 Line(x1+120+c,y1+30+e,x1+113+c,y1+40+e); {levaya noga}
 Line(x1+113+c,y1+40+e,x1+103+c,y1+33+e);
 Line(x1+103+c,y1+33+e,x1+100+c,y1+39+e);
end;

procedure DrawPeople2(var x1,y1,c,e:integer);
Begin
 Circle(x1+125+c,y1+5+e,5);
 Line(x1+125+c,y1+10+e,x1+120+c,y1+30+e); {tulovishe}
 Line(x1+125+c,y1+10+e,x1+124+c,y1+24+e); {pravaya ruka}
 Line(x1+124+c,y1+24+e,x1+133+c,y1+21+e);
 Line(x1+125+c,y1+10+e,x1+118+c,y1+20+e); {levaya ruka}
 Line(x1+118+c,y1+20+e,x1+124+c,y1+24+e);
 Line(x1+120+c,y1+30+e,x1+125+c,y1+38+e); {pravaya noga}
 Line(x1+125+c,y1+38+e,x1+120+c,y1+46+e);
 Line(x1+120+c,y1+46+e,x1+124+c,y1+50+e);
 Line(x1+120+c,y1+30+e,x1+120+c,y1+40+e); {levaya noga}
 Line(x1+120+c,y1+40+e,x1+115+c,y1+47+e);
 Line(x1+115+c,y1+47+e,x1+118+c,y1+50+e);
end;

procedure DrawPeople3(var x2,y1,c,e:integer);
Begin
 Circle(x2-25-c,y1+5+e,5);
 Line(x2-25-c,y1+10+e,x2-25-c,y1+25+e); {tulovishe}
 Line(x2-25-c,y1+10+e,x2-15-c,y1+25+e); {pravaya ruka}
 Line(x2-25-c,y1+10+e,x2-35-c,y1+25+e); {levaya ruka}
 Line(x2-25-c,y1+25+e,x2-20-c,y1+40+e); {pravaya noga}
 Line(x2-20-c,y1+40+e,x2-25-c,y1+32+e);
 Line(x2-25-c,y1+25+e,x2-30-c,y1+40+e); {levaya noga}
 Line(x2-30-c,y1+40+e,x2-30-c,y1+50+e);
End;

procedure DrawPeople4(var x2,y1,c,e:integer);
Begin
 Circle(x2-25-c,y1+5+e,5);
 Line(x2-25-c,y1+10+e,x2-25-c,y1+25+e); {tulovishe}
 Line(x2-25-c,y1+10+e,x2-15-c,y1+25+e); {pravaya ruka}
 Line(x2-25-c,y1+10+e,x2-35-c,y1+25+e); {levaya ruka}
 Line(x2-25-c,y1+25+e,x2-20-c,y1+40+e); {pravaya noga}
 Line(x2-20-c,y1+40+e,x2-20-c,y1+50+e);
 Line(x2-25-c,y1+25+e,x2-30-c,y1+40+e); {levaya noga}
 Line(x2-30-c,y1+40+e,x2-25-c,y1+32+e);
End;

Begin
 clrscr;
 Writeln('Vvedite kolichestvo krugov');
 Read(n);
 Driver:=Detect;
 InitGraph(Driver,Mode,'');
 Error:=GraphResult;
 If Error<>grOk then
  Writeln(GraphErrorMsg(Error))
 else
 Begin
  CheckResolution(a,b);
  for i:=1 to 3 do
  Begin
   Info[i].AddX:=0;
   Info[i].AddY:=0;
   For j:=2 to 4 do
    Info[i].F[j]:=False;
  end;
  For i:=1 to 3 do
   Info[i].F[1]:=True;
  While true do
  Begin
   c:=0;
   DrawRectangle(a,b,x1,x2,y1,y2);
   For i:=1 to 3 do
   Begin
    If  (Info[i].F[1]) and (Info[i].AddX+x1+150<x2-c) then
    Begin
     DrawRectangle(a,b,x1,x2,y1,y2);
     DrawPeople1(x1,y1,Info[i].AddX,c);
     Info[i].AddX:=Info[i].AddX+10;
    End
    else
    Begin
     Info[i].F[1]:=False;
     Info[i].F[2]:=True;
    End;
    c:=c+50;
   End;
   If Info[1].F[1]=true then
    Delay(17000);
   ClearDevice;
   c:=0;
   For i:=1 to 3 do
   Begin
    If  (Info[i].F[1]) and (Info[i].AddX+x1+150<x2-c) then
    Begin
     DrawRectangle(a,b,x1,x2,y1,y2);
     DrawPeople2(x1,y1,Info[i].AddX,c);
     Info[i].AddX:=Info[i].AddX+10;
    End
    else
    Begin
     Info[i].F[1]:=False;
     Info[i].F[2]:=True;
    End;
   c:=c+50;
   End;
   If Info[1].F[1]=true then
    Delay(17000);
   ClearDevice;
   c:=0;
   For i:=1 to 3 do
   Begin
    If  (Info[i].F[2]) and (Info[i].AddY+y1<y2-c) then
    Begin
     DrawRectangle(a,b,x1,x2,y1,y2);
     DrawPeople3(x2,y1,c,Info[i].AddY);
     Info[i].AddY:=Info[i].AddY+10;
    End
    else
    Begin
     Info[i].F[2]:=False;
     Info[i].F[3]:=True;
    End;
    c:=c+50;
   End;
   If Info[1].F[2]=true then
   Begin
    Delay(17000);
    ClearDevice;
    c:=0;
   end;
   For i:=1 to 3 do
   Begin
    If  (Info[i].F[2]) and (Info[i].AddY+y1<y2-c) then
    Begin
     DrawRectangle(a,b,x1,x2,y1,y2);
     DrawPeople4(x2,y1,c,Info[i].AddY);
     Info[i].AddY:=Info[i].AddY+10;
    End
    else
    Begin
     Info[i].F[2]:=False;
     Info[i].F[3]:=True;
    End;
    c:=c+50;
   End;
   If Info[1].F[2]=true then
   Begin
    Delay(17000);
    ClearDevice;
   end;
  End;
 End;
 Readkey;
End.

 

Revise this Paste

Your Name: Code Language: