Вращение куба с разноцветными гранями

uses Graph, Crt;
 
procedure DrawCube;
label
  nextj;
type
  cube=array[1..8] of record x,y,z:integer end;
 
{verts-koordinatu (x,y,z) vershin figyru}
const
 verts:cube=(
 (x: 1; y: 1; z: 1),  {1-a vershina}
 (x: 1; y: 1; z:-1),  {2}
 (x: 1; y:-1; z: 1),  {3}
 (x: 1; y:-1; z:-1),  {4}
 (x:-1; y: 1; z: 1),  {5}
 (x:-1; y: 1; z:-1),  {6}
 (x:-1; y:-1; z: 1),  {7}
 (x:-1; y:-1; z:-1)); {8}
 
 {g- eto opisanie iz kakih vershin v sostoiat grani
     (v massive legat nomera tochec v nymeracii verts) }
 g:array[1..6, 1..4] of shortint=
 ((1,2,4,3),
  (1,2,6,5),
  (1,3,7,5),
  (3,4,8,7),
  (2,4,8,6),
  (5,6,8,7));
 
 
var
  Alfa,Beta,Gamma, {proekcii edinichnogo vectora povorota (ego dlina=1)}
  Teta,            {ygol povorota tochek prostranstva}
  DT:real;         {pribavka ygla Teta}
  c:cube;          {massiv dlia koordinat vrashaemuh vershin}
 
 procedure Rotate(var x,y,z:integer);
 {povorot tochki vokrug edinichnogo vektora (Alfa, Beta, Gamma) na ygol Teta}
 var
   cosT, sinT, One_cosT, AOne_cosT, BOne_cosT,GsinT:real;
   xn,yn,zn:integer;
 begin
   {eto slognoe preobrathovanie vziato iz spravochnika po stereometrii}
   cosT:=cos(Teta);
   sinT:=sin(Teta);
   One_cosT :=1.0-cosT;
   AOne_cosT:=Alfa*One_cosT;
   BOne_cosT:=Beta*One_cosT;
   GsinT:=Gamma*sinT;
 
   xn:=trunc(
      x*( cosT      + Alfa  * AOne_cosT)+
      y*( GsinT     + Beta  * AOne_cosT)+
      z*(-Beta*sinT + Gamma * AOne_cosT));
 
   yn:=trunc(
      x*(-GSinT     + Beta  * AOne_cosT)+
      y*( cosT      + Beta  * BOne_cosT)+
      z*( Alfa*sinT + Gamma * BOne_cosT));
 
   zn:=trunc(
      x*( Beta*sinT + Gamma * AOne_cosT)+
      y*(-alfa*sinT + Gamma * BOne_cosT)+
      z*( cosT      + Gamma*Gamma*One_cosT));
 
   x:=xn; y:=yn; z:=zn;
 end;
 
 function minz:integer;
 {nahogdenie samoi "zadnei" tochki, t.e. s min Z}
 var j,m:integer;
 begin
   m:=1;
   for j:=2 to 8 do
     if c[j].z<c[m].z then m:=j;
   minz:=m;
 end;
 
 
var
  Pnts:array[1..5] of record {Byfer dlia risovania tochek grani cherez FillPoly}
    x,y:integer
  end;
  min:integer;      {nomer samoi "zadnei" tochki}
  x0,y0:integer;    {centr izobrajenia}
  a: integer;       {Koef. yvelichenia izobrajenia}
 
  i,j,k:integer;    {Parametru ciklov}
  page:word;
 
begin
 page:=0;
 x0:=120;
 y0:=100;
 
 a:=40;
 Alfa:=0.6;
 Beta:=0.7;
 Gamma:=sqrt(1.0-Alfa*Alfa-Beta*Beta); {3-mernaia teorema Pifagora}
 Teta:=0;
 DT:=2*Pi/100;{2.0*Pi/20;}
 
 {Masshtabiryem i povorachivaem vse vershinu na ygol Teta}
 for i:=1 to 8 do
  begin
   c[i].x:=verts[i].x*a;
   c[i].y:=verts[i].y*a;
   c[i].z:=verts[i].z*a;
   Rotate(c[i].x,c[i].y,c[i].z)
  end;
 min:=MinZ; {Nahodim samyi zadniy vershiny}
 SetVisualPage((Page+1)mod 2);
 
 for k:=0 to 2500 do
  begin
    SetActivePage(page); {delaem aktivnoi nevidimyiy stranicy}
 
 
    for j:=1 to 6 do
      begin
        {propysk nevidimoi grani iz samoiy "zadnei" tockoi}
        for i:=1 to 4 do if min=g[j,i] then goto nextj; {goto neobhodim!}
        {prohodim po vershinam grani}
        for i:=1 to 4 do
          begin
           {Berem proekciy vershinu na ploskosti xoy  }
           Pnts[i].x:=x0+c[g[j,i]].x;
           Pnts[i].y:=y0+trunc(0.775*c[g[j,i]].y) {0.775- k-t sgatia EGA HI}
          end;
        SetFillStyle(SolidFill, word(j+8)); {Kagdoi grani svoia zakraska}
        {Pnts[5]:=Pnts[1];}    {eto nygno pri DrawPoly}
        FillPoly(4,Pnts);
        nextJ:
      end;
 
    SetVisualPage(Page);       {pokazivaem risynok: delaem vidimoi stranicy}
    SetActivePage((Page+1)mod 2); {delaem aktivnoi nevid. str. dlia Bar}
 
    {Povorachivaem vershinu}
    for i:=1 to 8 do
      begin
        c[i].x:=verts[i].x*a;
        c[i].y:=verts[i].y*a;
        c[i].z:=verts[i].z*a;
        Rotate(c[i].x,c[i].y,c[i].z)
      end;
    min:=MinZ;
 
    SetFillStyle(SolidFill, Black);
    Bar(0,0,x0*2,y0*2);           {stiraem staroe izobragenie na nevid. str.}
    Teta:=Teta+DT;                {yvelichivaem ygol povorota}
    Page:=(Page+1)mod 2;          {meniaem stranicy (0->1; 1->0) }
    if KeyPressed then
    exit;
  end;
end;
 
 
var drv,mode:integer;
begin
  drv:=EGA;
  mode:=EGAHI;
  InitGraph(drv,mode,'C:\compilat\tp\bgi');
  DrawCube;
  CloseGraph;
end.
 

автор ЛоРД_Оледжан http://www.cyberforum.ru/