Форум ОлдБК

program 3D;
uses crt,graph;
var
   error,color, driver,regim:integer;
    alfa,beta:real;
    Buffx,Buffy,Xo,Yo,x1,x2,y1,y2:integer;
    n,a,z:integer;
   Sx,Sy, Q,i,j:integer;
    ax,ay:array [0..40] of integer;
    r:array [1..2,1..40,1..2] of integer;
procedure drawing;
begin
         color:=white;
         setbkcolor(color);
         setcolor(8);
         line(0,240,640,240);
         line(320,0,320,480);
         line(80,480,560,0);
         moveto(r[1,n,1]+Xo,r[1,n,2]+Yo);
         setlinestyle(2,0,3);
          for i:=1 to 2 do begin
 
            if i=2 then moveto(r[2,n,1]+z+Xo,r[2,n,2]-z+Yo);
                                    for j:=1 to n do begin
 
         if i=1 then lineto(r[i,j,1]+Xo,r[i,j,2]+Yo);
 
 
         if i=2 then lineto(r[i,j,1]+z+Xo,r[i,j,2]-z+Yo);
         end;
         end;
         for i:=1 to n do begin
 
         x1:=Xo+r[1,i,1];
         y1:=Yo+r[1,i,2];
 
         x2:=Xo+z+r[2,i,1];
         y2:=Yo-z+r[2,i,2];
 
         line(x1,y1,x2,y2);
 
         end;
    
    
       outtextxy(300 ,20 ,'Y');
       outtextxy(600 ,220 ,'X');
       outtextxy(50 ,450 ,'Z');
end;
 
 
begin
 
     Q:=15;Sx:=3;Sy:=4;
     n:=4;a:=40; z:=n+65;
     alfa:=(360/n)*pi/150;
     beta:=-Q*pi/180;
     ax[1]:=0;ay[1]:=a;
     for i:=1 to n do
     begin
          ax[i+1]:=round(ax*cos(alfa)-ay*sin(alfa));
          ay[i+1]:=round(ax*sin(alfa)+ay*cos(alfa));
          end;
     for i:=1 to n do
     for j:=1 to 2 do begin
     r[j,i,1]:=ax;
     r[j,i,2]:=ay;
     end;
     Xo:=320;Yo:=240;
     driver:=detect;
     InitGraph(driver,regim,'');
     error:=GraphResult;
     if error<>grOK then
        WriteLn('Error:',GraphErrorMsg(Error))
     else
      begin
         drawing;
         readln;
                 for i:=1 to n do
                  begin
               ax:=round(ax*Sx);
               ay:=round(ay*Sy);
 
         end;
 
         for i:=1 to n do
         for j:=1 to 2 do begin
 
         r[j,i,1]:=ax;
         r[j,i,2]:=ay;
         end;
         InitGraph(driver,regim,'');
         drawing;
         readln;
  
         for i:=1 to n do
         begin
 
               Buffx:=round(cos(beta)*ax)-round(sin(beta)*ay);
               Buffy:=round(sin(beta)*ax)+round(cos(beta)*ay);
               ax:=Buffx;ay:=Buffy;
         end;
         for i:=1 to n do
         for j:=1 to 2 do begin
         r[j,i,1]:=ax;
         r[j,i,2]:=ay;
         end;
      InitGraph(driver,regim,'');
         drawing;
              repeat until keypressed;
      end;
end.