Zobrazí kocku v 3D s ktorou je možné pohybovať, otáčať, posúvať.

{ KOCKADAT.PAS                                    Copyright (c) ... }
{                                                                   }
{ Pomocny subor pre Kocka3D.                                        }
{                                                                   }
{ Author: Neznamy                                                   }
{ Date  : 16.06.2009                           http://www.trsek.com }
 
procedure TKocka.Refresh;
(* nanovo pripocita ku vsetkym bodom kocky (okrem B[1]) smerove vektory *)
  begin
    B[2].x:=B[1].x + Vx.x;
    B[2].y:=B[1].y + Vx.y;
    B[2].z:=B[1].z + Vx.z;
 
    B[3].x:=B[1].x + Vy.x;
    B[3].y:=B[1].y + Vy.y;
    B[3].z:=B[1].z + Vy.z;
 
    B[4].x:=B[1].x + Vz.x;
    B[4].y:=B[1].y + Vz.y;
    B[4].z:=B[1].z + Vz.z;
 
    B[5].x:=B[1].x + Vx.x + Vy.x;
    B[5].y:=B[1].y + Vx.y + Vy.y;
    B[5].z:=B[1].z + Vx.z + Vy.z;
 
    B[6].x:=B[1].x + Vx.x + Vz.x;
    B[6].y:=B[1].y + Vx.y + Vz.y;
    B[6].z:=B[1].z + Vx.z + Vz.z;
 
    B[7].x:=B[1].x + Vy.x + Vz.x;
    B[7].y:=B[1].y + Vy.y + Vz.y;
    B[7].z:=B[1].z + Vy.z + Vz.z;
 
    B[8].x:=B[1].x + Vx.x + Vy.x + Vz.x;
    B[8].y:=B[1].y + Vx.y + Vy.y + Vz.y;
    B[8].z:=B[1].z + Vx.z + Vy.z + Vz.z;
  end;
 
procedure TKocka.Kresli;
(* vykresli kocku = premietne vsetky body kocky na obrazovku a pospaja ich *)
  type Pixely=record
         x,y:integer;
       end;
 
  var V:Vektory;
      i:integer;
      t:real;
      s:string;
      pix:array[1..8]of Pixely;
 
  begin
    str(B[1].x,s);
    insert('X=',s,1);
    OutTextXY(20,10,s);
 
    str(B[1].y,s);
    insert('Y=',s,1);
    OutTextXY(20,20,s);
 
    str(B[1].z,s);
    insert('Z=',s,1);
    OutTextXY(20,30,s);
 
    if (B[1].z>=Hranica.z1)and(B[1].z<Hranica.z2) and
       (B[1].x>-Hranica.x)and(B[1].x<Hranica.x) and
       (B[1].y>-Hranica.y)and(B[1].y<Hranica.y) then begin
      for i:=1 to 8 do begin
        V.x:=B[i].x-Stred.x;
        V.y:=B[i].y-Stred.y;
        V.z:=B[i].z-Stred.z;
 
        t:=-(N.x*B[i].x + N.y*B[i].y + N.z*B[i].z)/(N.x*V.x + N.y*V.y + N.z*V.z);
 
        pix[i].x:=round(Kocka.B[i].x + V.x*t);
        pix[i].y:=round(Kocka.B[i].y + V.y*t);
 
        str(i,s);
        OutTextXY(pix[i].x, pix[i].y, s);
      end;
 
      Line(pix[1].x, pix[1].y, pix[2].x, pix[2].y);
      Line(pix[1].x, pix[1].y, pix[3].x, pix[3].y);
      Line(pix[1].x, pix[1].y, pix[4].x, pix[4].y);
      Line(pix[4].x, pix[4].y, pix[6].x, pix[6].y);
      Line(pix[4].x, pix[4].y, pix[7].x, pix[7].y);
      Line(pix[5].x, pix[5].y, pix[3].x, pix[3].y);
      Line(pix[5].x, pix[5].y, pix[2].x, pix[2].y);
      Line(pix[5].x, pix[5].y, pix[8].x, pix[8].y);
      Line(pix[6].x, pix[6].y, pix[2].x, pix[2].y);
      Line(pix[6].x, pix[6].y, pix[8].x, pix[8].y);
      Line(pix[7].x, pix[7].y, pix[3].x, pix[3].y);
      Line(pix[7].x, pix[7].y, pix[8].x, pix[8].y);
    end;
  end;
 
procedure TKocka.Init(x,y,z,a:integer);
  begin  (* x,y,z - poloha v priestore, a - dlzka strany *)
    B[1].x:=x;
    B[1].y:=y;
    B[1].z:=z;
 
    Vx.x:=a;
    Vx.y:=0;
    Vx.z:=0;
 
    Vy.x:=0;
    Vy.y:=a;
    Vy.z:=0;
 
    Vz.x:=0;
    Vz.y:=0;
    Vz.z:=a;
 
    Refresh;
  end;
 
procedure TKocka.Posun(x,y,z:integer);
  begin
    B[1].x:=B[1].x + x;
    B[1].y:=B[1].y + y;
    B[1].z:=B[1].z + z;
 
    B[2].x:=B[2].x + x;
    B[2].y:=B[2].y + y;
    B[2].z:=B[2].z + z;
 
    B[3].x:=B[3].x + x;
    B[3].y:=B[3].y + y;
    B[3].z:=B[3].z + z;
 
    B[4].x:=B[4].x + x;
    B[4].y:=B[4].y + y;
    B[4].z:=B[4].z + z;
 
    B[5].x:=B[5].x + x;
    B[5].y:=B[5].y + y;
    B[5].z:=B[5].z + z;
 
    B[6].x:=B[6].x + x;
    B[6].y:=B[6].y + y;
    B[6].z:=B[6].z + z;
 
    B[7].x:=B[7].x + x;
    B[7].y:=B[7].y + y;
    B[7].z:=B[7].z + z;
 
    B[8].x:=B[8].x + x;
    B[8].y:=B[8].y + y;
    B[8].z:=B[8].z + z;
  end;
 
procedure Rot2D(var x,y:integer; Sx,Sy,uhol:integer);
(* SX,SY - stred otacania; x,y - otacany bod; *)
  var m,n:integer;
      c:real;
  begin
    c:=uhol*PI/180;
    m:=round((x-Sx)*cos(c) - (y-Sy)*sin(c) + Sx);
    n:=round((x-Sx)*sin(c) + (y-Sy)*cos(c) + Sy);
    x:=m; y:=n;
  end;
 
procedure TKocka.Otoc(uhol:integer; os:TOs);
  var S:Body;
      i:integer;
 
  begin (* z koncovych bodov uhlopriecky vypocita stred kocky (stred otacania) *)
    S.x:=B[1].x + (B[8].x - B[1].x) div 2;
    S.y:=B[1].y + (B[8].y - B[1].y) div 2;
    S.z:=B[1].z + (B[8].z - B[1].z) div 2;
 
    (* podla zadanej osi otoci 4 hlavne body kocky *)
    case os of
      x : for i:=1 to 4 do Rot2D(B[i].z, B[i].y, S.z, S.y, uhol);
      y : for i:=1 to 4 do Rot2D(B[i].x, B[i].z, S.x, S.z, uhol);
      z : for i:=1 to 4 do Rot2D(B[i].x, B[i].y, S.x, S.y, uhol);
    end;
 
    (* zo 4 hlavnych bodov vypocita smerove vektory *)
    Vx.x:=B[2].x - B[1].x;
    Vx.y:=B[2].y - B[1].y;
    Vx.z:=B[2].z - B[1].z;
 
    Vy.x:=B[3].x - B[1].x;
    Vy.y:=B[3].y - B[1].y;
    Vy.z:=B[3].z - B[1].z;
 
    Vz.x:=B[4].x - B[1].x;
    Vz.y:=B[4].y - B[1].y;
    Vz.z:=B[4].z - B[1].z;
 
    Refresh; (* pomocou smerovych vektorov vypocita novu polohu ostatnych bodov *)
   end;