Графика в Турбо Паскаль - Turbo Pascal - Ответ 465559

program Bukvi3D;
 uses graph,crt;
 const m=36; d=34; v=36;  pi=3.14;
 var mx,my,mx1,my1,mz,mz1,mx2,my2,mz2,mxe,mxe1,mye,mye1:array[1..m] of integer;
 dx,dy,dx1,dy1,dz,dz1,dx2,dy2,dz2:array[1..d] of integer;
 vx,vy,vz,vx1,vy1,vz1,vx2,vy2,vz2:array[1..v] of integer;
 mfe,mfe1:array[1..60] of pointtype;
 dfe,dfe1:array[1..60] of pointtype;
 vfe,vfe1:array[1..60] of pointtype;
 
 
 i,j,n,l,GraphDriver,GraphMode,GraphError:integer;
 f:text;
 
 
procedure Mekr;      { процедура преобразования координат буквы М    }
 begin                    {  из кабинетной 3D проекции на плоскось экрана  }
  for i:=1 to m do
     begin
      mx2[i]:=round(1*mx1[i]+0*my1[i]-cos(pi/3)*mz1[i]+100);
      my2[i]:=round(0*mx1[i]-1*my1[i]-sin(pi/3)*mz1[i]+200);
     end;
 end;
 
procedure Dekr;         { преобразование координат буквы Д}
 begin
  for i:=1 to d do
     begin
      dx2[i]:=round(1*dx1[i]+0*dy1[i]-cos(pi/3)*dz1[i]+250);
      dy2[i]:=round(0*dx1[i]-1*dy1[i]-sin(pi/3)*dz1[i]+200);
     end;
 end;
 
procedure Vekr;         { преобразование координат буквы В}
 begin
  for i:=1 to v do
     begin
      vx2[i]:=round(1*vx1[i]+0*vy1[i]-cos(pi/3)*vz1[i]+400);
      vy2[i]:=round(0*vx1[i]-1*vy1[i]-sin(pi/3)*vz1[i]+200);
     end;
 end;
 
 
procedure fmekr;        { процедура закраски передней грани буквы М}
 begin
   for i:=1 to 12 do
    begin
     mfe[i].x:=mx2[i];
     mfe[i].y:=my2[i];
    end;
   setfillstyle(1,green);
   drawpoly(12,mfe);
   fillpoly(12,mfe);
 end;
procedure fmekr1;        { процедура закраски задней грани буквы М}
 begin
   for i:=1 to 12 do
    begin
     mfe1[i].x:=mx2[i+13];
     mfe1[i].y:=my2[i+13];
    end;
   setfillstyle(1,green);
   drawpoly(12,mfe1);
   fillpoly(12,mfe1);
 end;
 
procedure fdekr;        { процедура закраски передней грани буквы Д}
 begin
   for i:=1 to 17 do
    begin
     dfe[i].x:=dx2[i];
     dfe[i].y:=dy2[i];
    end;
   setfillstyle(1,yellow);
   drawpoly(17,dfe);
   fillpoly(17,dfe);
 end;
 
 
procedure fdekr1;          { процедура закраски задней грани буквы М}
 begin
   for i:=1 to 17 do
    begin
     dfe1[i].x:=dx2[i+17];
     dfe1[i].y:=dy2[i+17];
    end;
   setfillstyle(1,yellow);
   drawpoly(17,dfe1);
   fillpoly(17,dfe1);
 end;
 
procedure fvekr;      { процедура закраски передней грани буквы В}
 begin
   for i:=1 to 18 do
    begin
     vfe[i].x:=vx2[i];
     vfe[i].y:=vy2[i];
    end;
   setfillstyle(1,red);
   drawpoly(18,vfe);
   fillpoly(18,vfe);
 end;
procedure fvekr1;         { процедура закраски задней грани буквы В}
 begin
   for i:=1 to 18 do
    begin
     vfe1[i].x:=vx2[i+18];
     vfe1[i].y:=vy2[i+18];
    end;
   setfillstyle(1,red);
   drawpoly(18,vfe1);
   fillpoly(18,vfe1);
 end;
 
procedure risM;       { рисуем саму букву М на плоскости }
  begin
  Mekr;
   for i:=2 to m do
     begin
      line(mx2[i-1],my2[i-1],mx2[i],my2[i]);
     end;
   for i:=1 to 12 do
     begin
     line(mx2[i],my2[i],mx2[i+13],my2[i+13]);
     end;
  end;
 
procedure risD;       { рисуем  Д на плоскости }
 begin
  Dekr;
  for i:=2 to d do
    if (i <> 14) and (i<>18) and (i<>31) then  line(dx2[i-1],dy2[i-1],dx2[i],dy2[i]);
  for i := 1 to 14 do
    line(dx2[i],dy2[i],dx2[i+17],dy2[i+17]);
 end;
 
procedure  risV;      { рисуем В на плоскости}
 begin
   Vekr;
   for i:=2 to v do
     begin
      if (i<>9) and (i<>14) and (i<>19) and (i<>27) and (i<>32) then line(vx2[i-1],vy2[i-1],vx2[i],vy2[i]);
     end;
   for i:=1 to 14 do
    line(vx2[i],vy2[i],vx2[i+18],vy2[i+18]);
 end;
 
 
begin
  GraphDriver :=  9;
   GraphMode := 1;
  InitGraph(GraphDriver, GraphMode,'');
  GraphError := GraphResult;
  if GraphError <> grOk then begin
    writeln ('osibka pri inizializazii graph');
    writeln(GraphErrorMsg(GraphError));
     halt(1);
    end;
    setbkcolor(15);
    setcolor(1);
 
    assign(f,'c:\projects\graphika\lab3\m.txt');    { Считываем координаты М}
    reset(f);
    for i:=1 to m do
     begin
      readln(f,mx[i],my[i],mz[i]);
      mx1[i]:=mx[i]; my1[i]:=my[i]; mz1[i]:=mz[i];
 
     end;
 
 
 
    assign(f,'c:\projects\graphika\lab3\d.txt');            { Считываем координаты Д}
    reset(f);
    for i:=1 to d do
     begin
      readln(f,dx[i],dy[i],dz[i]);
      dx1[i]:=dx[i]; dy1[i]:=dy[i]; dz1[i]:=dz[i];
     end;
 
    assign(f,'c:\projects\graphika\lab3\v.txt');        { Считываем координаты В}
    reset(f);
    for i:=1 to v do
     begin
      readln(f,vx[i],vy[i],vz[i]);
      vx1[i]:=vx[i]; vy1[i]:=vy[i]; vz1[i]:=vz[i];
     end;
 
 
      risM;   fmekr; fmekr1;           { рисуем первоначально буквы}
      risD;   fdekr; fdekr1;
      risV;   fvekr; fvekr1;
 
 
    outtext('press enter key');
    readln;
 
 
 
 for j:=1 to 72 do
  begin
 
   {            PERVI'I POVOROT             }
 
{ для улучшения визуального восприятия используем 2-х страничный режим экрана}
 
{первый поворот осуществляется вокруг оси Z}
 
 
  SetActivePage(j);  
   cleardevice;
 
   for i:=1 to m do
    begin
     mx1[i]:=round(mx[i]*cos(-5*j*pi/180)+my[i]*sin(-5*j*pi/180));
     my1[i]:=round(-mx[i]*sin(-5*j*pi/180)+my[i]*cos(-5*j*pi/180));
     mz1[i]:=mz[i]*1;
    end;
 
   for i:=1 to d do
    begin
     dx1[i]:=round(dx[i]*cos(-5*j*pi/180)+dy[i]*sin(-5*j*pi/180));
     dy1[i]:=round(-dx[i]*sin(-5*j*pi/180)+dy[i]*cos(-5*j*pi/180));
     dz1[i]:=dz[i]*1;
    end;
 
    for i:=1 to v do
    begin
     vx1[i]:=round(vx[i]*cos(-5*j*pi/180)+vy[i]*sin(-5*j*pi/180));
     vy1[i]:=round(-vx[i]*sin(-5*j*pi/180)+vy[i]*cos(-5*j*pi/180));
     vz1[i]:=vz[i]*1;
    end;
 
 
 
    risM;  risD;  risV;
    fmekr; fmekr1;
    fdekr; fdekr1;
    fvekr; fvekr1;
 
 
  SetVisualPage(j);
  delay(2500);
 
  end;
 
 
for j:=1 to 72 do
 begin
 
 {           VTOROI POVOROT               }
 
{второй поворот осуществляется вокруг оси Y}
 
  SetActivePage(j);
 cleardevice;
 
   for i:=1 to m do
    begin
     mx1[i]:=round(mx[i]*cos(5*j*pi/180)+mz[i]*sin(5*j*pi/180));
     my1[i]:=my[i]*1;
     mz1[i]:=round(-mx[i]*sin(5*j*pi/180)+mz[i]*cos(5*j*pi/180));
    end;
 
    for i:=1 to d do
    begin
     dx1[i]:=round(dx[i]*cos(5*j*pi/180)+dz[i]*sin(5*j*pi/180));
     dy1[i]:=dy[i]*1;
     dz1[i]:=round(-dx[i]*sin(5*j*pi/180)+dz[i]*cos(5*j*pi/180));
    end;
 
    for i:=1 to v do
    begin
     vx1[i]:=round(vx[i]*cos(5*j*pi/180)+vz[i]*sin(5*j*pi/180));
     vy1[i]:=vy[i]*1;
     vz1[i]:=round(-vx[i]*sin(5*j*pi/180)+vz[i]*cos(5*j*pi/180));
    end;
 
 
    risM;  risD;  risV;
    fmekr; fmekr1;
    fdekr; fdekr1;
    fvekr; fvekr1;
 
 
 SetVisualPage(j);
 delay(2500);
 end;
 
 
 for j:=1 to 72 do
  begin
 
  {          TRETII POVOROT             }
 
{третий поворот осуществляется вокруг оси X}
 
   SetActivePage(j);
   cleardevice;
 
   for i:=1 to m do
    begin
     mx1[i]:=mx[i]*1;
     my1[i]:=round(my[i]*cos(5*j*pi/180)+mz[i]*sin(5*j*pi/180));
     mz1[i]:=round(-my[i]*sin(5*j*pi/180)+mz[i]*cos(5*j*pi/180));
    end;
 
    for i:=1 to d do
    begin
     dx1[i]:=dx[i]*1;
     dy1[i]:=round(dy[i]*cos(5*j*pi/180)+dz[i]*sin(5*j*pi/180));
     dz1[i]:=round(-dy[i]*sin(5*j*pi/180)+dz[i]*cos(5*j*pi/180));
    end;
 
    for i:=1 to v do
    begin
     vx1[i]:=vx[i]*1;
     vy1[i]:=round(vy[i]*cos(5*j*pi/180)+vz[i]*sin(5*j*pi/180));
     vz1[i]:=round(-vy[i]*sin(5*j*pi/180)+vz[i]*cos(5*j*pi/180));
    end;
 
 
    risM;  risD;  risV;
    fmekr; fmekr1;
    fdekr; fdekr1;
    fvekr; fvekr1;
 
 
   SetVisualPage(j);
   delay(2500);
  end;
 
 
    readln;
    closegraph;
end.