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 qq ( 15 years ago )
program dbf;
uses graph,crt;
var
driver,mode:integer;
t:integer;
i:integer;
j:integer;
a0:real;
c:integer;
c1:integer;
del:integer;

xd1:array[1..16] of real;
yd1:array[1..16] of real;
zd1:array[1..16] of real;

xd:array[1..16] of real;
yd:array[1..16] of real;
zd:array[1..16] of real;

xd2:array[1..16] of integer;
yd2:array[1..16] of integer;

xds:array[1..16] of real;
yds:array[1..16] of real;

xb1:array[1..26] of real;
yb1:array[1..26] of real;
zb1:array[1..26] of real;

xb:array[1..26] of real;
yb:array[1..26] of real;
zb:array[1..26] of real;

xb2:array[1..26] of integer;
yb2:array[1..26] of integer;

xbs:array[1..26] of real;
ybs:array[1..26] of real;


xf1:array[1..20] of real;
yf1:array[1..20] of real;
zf1:array[1..20] of real;

xf:array[1..20] of real;
yf:array[1..20] of real;
zf:array[1..20] of real;

xf2:array[1..20] of integer;
yf2:array[1..20] of integer;

xfs:array[1..20] of real;
yfs:array[1..20] of real;

a:real;

procedure drawingf(var c:integer);
begin
     for i:=1 to 9 do
     begin
         line(xf2[i],yf2[i],xf2[i+1],yf2[i+1]);
     end;
     line(xf2[10],yf2[10],xf2[1],yf2[1]);
     for i:=11 to 19 do
     begin
          line(xf2[i],yf2[i],xf2[i+1],yf2[i+1]);
     end;
     line(xf2[20],yf2[20],xf2[11],yf2[11]);
     for i:=1 to 10 do
     begin
          line(xf2[i],yf2[i],xf2[i+10],yf2[i+10]);
     end;
end;

procedure drawingb(var c:integer);
begin
     setcolor(c);
     line(xb2[1],yb2[1],xb2[2],yb2[2]);
     line(xb2[2],yb2[2],xb2[3],yb2[3]);
     line(xb2[3],yb2[3],xb2[4],yb2[4]);
     line(xb2[4],yb2[4],xb2[5],yb2[5]);
     line(xb2[5],yb2[5],xb2[6],yb2[6]);
     line(xb2[6],yb2[6],xb2[7],yb2[7]);
     line(xb2[7],yb2[7],xb2[1],yb2[1]);
     line(xb2[8],yb2[8],xb2[9],yb2[9]);
     line(xb2[9],yb2[9],xb2[10],yb2[10]);
     line(xb2[10],yb2[10],xb2[8],yb2[8]);
     line(xb2[11],yb2[11],xb2[12],yb2[12]);
     line(xb2[12],yb2[12],xb2[13],yb2[13]);
     line(xb2[13],yb2[13],xb2[11],yb2[11]);
     line(xb2[14],yb2[14],xb2[15],yb2[15]);
     line(xb2[15],yb2[15],xb2[16],yb2[16]);
     line(xb2[16],yb2[16],xb2[17],yb2[17]);
     line(xb2[17],yb2[17],xb2[18],yb2[18]);
     line(xb2[18],yb2[18],xb2[19],yb2[19]);
     line(xb2[19],yb2[19],xb2[20],yb2[20]);
     line(xb2[20],yb2[20],xb2[14],yb2[14]);
     line(xb2[21],yb2[21],xb2[22],yb2[22]);
     line(xb2[22],yb2[22],xb2[23],yb2[23]);
     line(xb2[23],yb2[23],xb2[21],yb2[21]);
     line(xb2[24],yb2[24],xb2[25],yb2[25]);
     line(xb2[25],yb2[25],xb2[26],yb2[26]);
     line(xb2[26],yb2[26],xb2[24],yb2[24]);

     for i:=1 to 13 do
     begin
     line(xb2[i],yb2[i],xb2[i+13],yb2[i+13]);
     {line(xb2[1],yb2[1],xb2[14],yb2[14]);
     line(xb2[2],yb2[2],xb2[15],yb2[15]);
     line(xb2[3],yb2[3],xb2[16],yb2[16]);
     line(xb2[4],yb2[4],xb2[17],yb2[17]);
     line(xb2[5],yb2[5],xb2[18],yb2[11]);}
     end;
end;
procedure drawingd(var c:integer);
begin
     setcolor(c);

     line(xd2[1],yd2[1],xd2[2],yd2[2]);
     line(xd2[2],yd2[2],xd2[3],yd2[3]);
     line(xd2[3],yd2[3],xd2[4],yd2[4]);
     line(xd2[4],yd2[4],xd2[5],yd2[5]);
     line(xd2[5],yd2[5],xd2[1],yd2[1]);
     line(xd2[6],yd2[6],xd2[7],yd2[7]);
     line(xd2[7],yd2[7],xd2[8],yd2[8]);
     line(xd2[8],yd2[8],xd2[6],yd2[6]);

     line(xd2[9],yd2[9],xd2[10],yd2[10]);
     line(xd2[10],yd2[10],xd2[11],yd2[11]);
     line(xd2[11],yd2[11],xd2[12],yd2[12]);
     line(xd2[12],yd2[12],xd2[13],yd2[13]);
     line(xd2[13],yd2[13],xd2[9],yd2[9]);
     line(xd2[14],yd2[14],xd2[15],yd2[15]);
     line(xd2[15],yd2[15],xd2[16],yd2[16]);
     line(xd2[16],yd2[16],xd2[14],yd2[14]);
     for i:=1 to 8 do
     begin
     {line(xd2[1],yd2[1],xd2[9],yd2[9]);
     line(xd2[2],yd2[2],xd2[10],yd2[10]);
     line(xd2[3],yd2[3],xd2[11],yd2[11]);
     line(xd2[4],yd2[4],xd2[12],yd2[12]);
     line(xd2[5],yd2[5],xd2[13],yd2[13]);
     line(xd2[6],yd2[6],xd2[14],yd2[14]);
     line(xd2[7],yd2[7],xd2[15],yd2[15]);
     line(xd2[8],yd2[8],xd2[16],yd2[16]);}
     line(xd2[i],yd2[i],xd2[i+8],yd2[i+8]);
     end;
end;

begin
     clrscr;
     writeln('(c) Moskvin Alexey (dbf) Email:[email protected] 2002');
     writeln('Введите значение задержки (рекомендуется для начала попробовать 500)');
     readln(del);
     driver:=detect;
     initgraph(driver,mode,'');
{     cleardevice; }

     xd1[1]:=-80;
     yd1[1]:=0;
     zd1[1]:=0;

     xd1[2]:=-50;
     yd1[2]:=0;
     zd1[2]:=0;

     xd1[3]:=-20;
     yd1[3]:=0;
     zd1[3]:=40;

     xd1[4]:=-50;
     yd1[4]:=0;
     zd1[4]:=80;

     xd1[5]:=-80;
     yd1[5]:=0;
     zd1[5]:=80;

     xd1[6]:=-65;
     yd1[6]:=0;
     zd1[6]:=20;

     xd1[7]:=-40;
     yd1[7]:=0;
     zd1[7]:=40;

     xd1[8]:=-65;
     yd1[8]:=0;
     zd1[8]:=60;

     xd1[9]:=-80;
     yd1[9]:=30;
     zd1[9]:=0;

     xd1[10]:=-50;
     yd1[10]:=30;
     zd1[10]:=0;

     xd1[11]:=-20;
     yd1[11]:=30;
     zd1[11]:=40;

     xd1[12]:=-50;
     yd1[12]:=30;
     zd1[12]:=80;

     xd1[13]:=-80;
     yd1[13]:=30;
     zd1[13]:=80;

     xd1[14]:=-65;
     yd1[14]:=30;
     zd1[14]:=20;

     xd1[15]:=-40;
     yd1[15]:=30;
     zd1[15]:=40;

     xd1[16]:=-65;
     yd1[16]:=30;
     zd1[16]:=60;

     {--------------}

     xb1[1]:=-10;
     yb1[1]:=0;
     zb1[1]:=0;

     xb1[2]:=20;
     yb1[2]:=0;
     zb1[2]:=0;

     xb1[3]:=40;
     yb1[3]:=0;
     zb1[3]:=15;

     xb1[4]:=30;
     yb1[4]:=0;
     zb1[4]:=30;

     xb1[5]:=40;
     yb1[5]:=0;
     zb1[5]:=45;

     xb1[6]:=30;
     yb1[6]:=0;
     zb1[6]:=60;

     xb1[7]:=-10;
     yb1[7]:=0;
     zb1[7]:=60;

     xb1[8]:=0;
     yb1[8]:=0;
     zb1[8]:=5;

     xb1[9]:=20;
     yb1[9]:=0;
     zb1[9]:=15;

     xb1[10]:=0;
     yb1[10]:=0;
     zb1[10]:=25;

     xb1[11]:=0;
     yb1[11]:=0;
     zb1[11]:=35;

     xb1[12]:=20;
     yb1[12]:=0;
     zb1[12]:=45;

     xb1[13]:=0;
     yb1[13]:=0;
     zb1[13]:=55;

     xb1[14]:=-10;
     yb1[14]:=30;
     zb1[14]:=0;

     xb1[15]:=20;
     yb1[15]:=30;
     zb1[15]:=0;

     xb1[16]:=40;
     yb1[16]:=30;
     zb1[16]:=15;

     xb1[17]:=30;
     yb1[17]:=30;
     zb1[17]:=30;

     xb1[18]:=40;
     yb1[18]:=30;
     zb1[18]:=45;

     xb1[19]:=30;
     yb1[19]:=30;
     zb1[19]:=60;

     xb1[20]:=-10;
     yb1[20]:=30;
     zb1[20]:=60;

     xb1[21]:=0;
     yb1[21]:=30;
     zb1[21]:=5;

     xb1[22]:=20;
     yb1[22]:=30;
     zb1[22]:=15;

     xb1[23]:=0;
     yb1[23]:=30;
     zb1[23]:=25;

     xb1[24]:=0;
     yb1[24]:=30;
     zb1[24]:=35;

     xb1[25]:=20;
     yb1[25]:=30;
     zb1[25]:=45;

     xb1[26]:=0;
     yb1[26]:=30;
     zb1[26]:=55;


     zb1[6]:=zb1[6]+10;
     zb1[7]:=zb1[7]+10;
     zb1[19]:=zb1[19]+10;
     zb1[20]:=zb1[20]+10;


{--------------------}
     xf1[1]:=40;
     yf1[1]:=0;
     zf1[1]:=0;

     xf1[2]:=60;
     yf1[2]:=0;
     zf1[2]:=0;

     xf1[3]:=60;
     yf1[3]:=0;
     zf1[3]:=20;

     xf1[4]:=80;
     yf1[4]:=0;
     zf1[4]:=20;

     xf1[5]:=80;
     yf1[5]:=0;
     zf1[5]:=40;

     xf1[6]:=60;
     yf1[6]:=0;
     zf1[6]:=40;

     xf1[7]:=60;
     yf1[7]:=0;
     zf1[7]:=60;

     xf1[8]:=90;
     yf1[8]:=0;
     zf1[8]:=60;

     xf1[9]:=90;
     yf1[9]:=0;
     zf1[9]:=80;

     xf1[10]:=40;
     yf1[10]:=0;
     zf1[10]:=80;


     xf1[11]:=40;
     yf1[11]:=30;
     zf1[11]:=0;

     xf1[12]:=60;
     yf1[12]:=30;
     zf1[12]:=0;

     xf1[13]:=60;
     yf1[13]:=30;
     zf1[13]:=20;

     xf1[14]:=80;
     yf1[14]:=30;
     zf1[14]:=20;

     xf1[15]:=80;
     yf1[15]:=30;
     zf1[15]:=40;

     xf1[16]:=60;
     yf1[16]:=30;
     zf1[16]:=40;

     xf1[17]:=60;
     yf1[17]:=30;
     zf1[17]:=60;

     xf1[18]:=90;
     yf1[18]:=30;
     zf1[18]:=60;

     xf1[19]:=90;
     yf1[19]:=30;
     zf1[19]:=80;

     xf1[20]:=40;
     yf1[20]:=30;
     zf1[20]:=80;



{--------------------}
     for i:=1 to 26 do
     begin
     xb1[i]:=xb1[i]+30;
     end;

     for i:=1 to 20 do
     begin
     xf1[i]:=xf1[i]+50;
     end;






     for t:=1 to 10 do
     begin
     setcolor(15);
     a0:=3.1415/6;
     a:=3.1415;
     t:=0;
     while(a>=-3.1415) do
     begin
          delay (del);
     setcolor(15);
          a:=a-0.05;
          c:=0;
          drawingd(c);
          drawingb(c);
          drawingf(c);
          for i:=1 to 16 do

          begin
               xd[i]:=xd1[i];
               yd[i]:=yd1[i];
               zd[i]:=zd1[i];
               xd[i]:= xd[i] * COS(a) + xd[i] * SIN(a);
               yd[i]:= yd[i] * COS(a) - yd[i] * SIN(a);
               xd2[i]:=trunc(xd[i] * COS(a0) + yd[i] * COS(a0)+320);
               yd2[i]:=trunc(-(xd[i] * SIN(a0) - yd[i] * SIN(a0) + zd[i])+300);
          end;

          for i:=1 to 26 do

          begin
               xb[i]:=xb1[i];
               yb[i]:=yb1[i];
               zb[i]:=zb1[i];
               xb[i]:= xb[i] * COS(a) + xb[i] * SIN(a);
               yb[i]:= yb[i] * COS(a) - yb[i] * SIN(a);
               xb2[i]:=trunc(xb[i] * COS(a0) + yb[i] * COS(a0)+320);
               yb2[i]:=trunc(-(xb[i] * SIN(a0) - yb[i] * SIN(a0) + zb[i])+300);
          end;

          for i:=1 to 20 do

          begin
               xf[i]:=xf1[i];
               yf[i]:=yf1[i];
               zf[i]:=zf1[i];
               xf[i]:= xf[i] * COS(a) + xf[i] * SIN(a);
               yf[i]:= yf[i] * COS(a) - yf[i] * SIN(a);
               xf2[i]:=trunc(xf[i] * COS(a0) + yf[i] * COS(a0)+320);
               yf2[i]:=trunc(-(xf[i] * SIN(a0) - yf[i] * SIN(a0) + zf[i])+300);
          end;
          for j:=1 to 26 do
          begin
          xb2[j]:=trunc(xb2[j]);
          yb2[j]:=trunc(yb2[j]);
          end;

           for j:=1 to 20 do
          begin
          xf2[j]:=trunc(xf2[j]);
          yf2[j]:=trunc(yf2[j]);
          end;

          c:=5;
          for j:=1 to 16 do
          begin
          xd2[j]:=trunc(xd2[j]);
          yd2[j]:=trunc(yd2[j]);
          end;
          drawingd(c);
          drawingb(c);
          drawingf(c);
     end;
     end;
end.

 

Revise this Paste

Your Name: Code Language: