1:
2:
3:
4:
5:
6:
7:
8:
9:
10:
11:
12:
13:
14:
15:
16:
17:
18:
19:
20:
21:
22:
23:
24:
25:
26:
27:
28:
29:
30:
31:
32:
33:
34:
35:
36:
37:
38:
39:
40:
41:
42:
43:
44:
45:
46:
47:
48:
49:
50:
51:
52:
53:
54:
55:
56:
57:
58:
59:
60:
61:
62:
63:
64:
65:
66:
67:
68:
69:
70:
71:
72:
73:
74:
75:
76:
77:
78:
79:
80:
81:
82:
83:
84:
85:
86:
87:
88:
89:
90:
91:
92:
93:
94:
95:
96:
97:
98:
99:
100:
101:
102:
103:
104:
105:
106:
107:
108:
109:
110:
111:
112:
113:
114:
115:
116:
117:
118:
119:
120:
121:
122:
123:
124:
125:
126:
127:
128:
129:
130:
131:
132:
133:
134:
135:
136:
137:
138:
139:
140:
141:
142:
143:
144:
145:
146:
147:
148:
149:
150:
151:
152:
153:
154:
155:
156:
157:
158:
159:
160:
161:
162:
163:
164:
165:
166:
167:
168:
169:
170:
171:
172:
173:
174:
175:
176:
177:
178:
179:
180:
181:
182:
183:
184:
185:
186:
187:
188:
189:
190:
191:
192:

unit CubeRotate;
{***************************************************}
{* The 3D Rotating Cube - A Comprehensive example  *}
{* of using animation in Delphi. This application  *}
{* displays a rotating 3 dimensional cube. The user*}
{* can adjust how quickly the cube rotates on each *}
{* axis.                                           *}
{***************************************************}

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  StdCtrls, ExtCtrls;

type
  TDrehen = class(TForm)
    Label1: TLabel;
    Label2: TLabel;
    Label3: TLabel;
    Timer: TTimer;
    ResetCube: TButton;
    XRot: TScrollBar;
    YRot: TScrollBar;
    ZRot: TScrollBar;
    procedure FormCreate(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure TimerTimer(Sender: TObject);
    procedure ResetCubeClick(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var Drehen: TDrehen;

implementation

{$R *.DFM}

Type
  {Used to create a rotation matrix}
  Matrix=array[0..3,0..3] of Extended;
  {Structure to store a 3D point   }
  TDPoint=record X,Y,Z:Extended end;

var
  DoubleBuffer:TBitmap;  {We will draw here then copyrect}
  BlankBuffer:TBitmap;  {Bitmap to store our background }
  PntsOut:array[1..8] of TDPoint; {Rotated Points}
  TPPnts:array[1..8] of TPoint;  {2D represtentation of pts}
  Pnts:array[1..8] of TDPoint;   {Origional image}
  XAng,YAng,ZAng:Extended;

{********************************************************}
{Create an array(or matrix) which sets up rotation based }
{on angels passed in terms or radians. Consult a geometry}
{book to understand the math behind rotation.            }
{********************************************************}
 procedure matrixRotate(var m:Matrix;x,y,z:Extended);
  var sinX,cosX,sinY,cosY,sinZ,cosZ:Extended; {Store here so we only need to calc once}
      C1,C2:integer; {for the loops}
  begin
   sinX := sin(x); {let's do our geometry...}
   cosX := cos(x);
   sinY := sin(y);
   cosY := cos(y);
   sinZ := sin(z);
   cosZ := cos(z);
   for C1 := 0 to 3 do  {set the matrix to the identity}
    for C2 :=0 to 3 do
     if C1 = C2 then M[C1,C2]:=0
     else M[C1,C2]:=1;
   {Take my word for it this works!....}
   M[0,0]:=cosZ*cosY;
   M[0,1]:=cosZ*-sinY*-sinX+sinZ*cosX;
   M[0,2]:=cosZ*-sinY*cosX+sinZ*sinX;
   M[1,0]:=-sinZ*cosY;
   M[1,1]:=-sinZ*-sinY*-sinX+cosZ*cosX;
   M[1,2]:=-sinZ*-sinY*cosX+cosZ*sinX;
   M[2,0]:=sinY;
   M[2,1]:=cosY*-sinX;
   M[2,2]:=cosY*cosX;
  end;

{Apply the rotation matrix to a 3D point and return a new 3D point}
 procedure ApplyMatToPoint(PointIn : TDPoint; var pointOut:TDPoint;mat : Matrix);
  var x,y,z:Extended;
  begin
   x:=PointIn.x*mat[0,0]+PointIn.y*mat[0,1]+PointIn.z*mat[0,2]+mat[0,3];
   y:=PointIn.x*mat[1,0]+PointIn.y*mat[1,1]+PointIn.z*mat[1,2]+mat[1,3];
   z:=PointIn.x*mat[2,0]+PointIn.y*mat[2,1]+PointIn.z*mat[2,2]+mat[2,3];
   PointOut.x:=x;PointOut.y:=y;PointOut.z:=z;
  end;

{We are using a cube which has 8 point. This is where we setup the }
{coordinates for each point. The middle of the cube is at (0,0,0)  }
 procedure InitCube;
  begin
   Pnts[1].X:=-50;Pnts[1].Y:=-50;Pnts[1].Z:=-50;
   Pnts[2].X:=50;Pnts[2].Y:=-50;Pnts[2].Z:=-50;
   Pnts[3].X:=50;Pnts[3].Y:=50;Pnts[3].Z:=-50;
   Pnts[4].X:=-50;Pnts[4].Y:=50;Pnts[4].Z:=-50;
   Pnts[5].X:=-50;Pnts[5].Y:=-50;Pnts[5].Z:=50;
   Pnts[6].X:=50;Pnts[6].Y:=-50;Pnts[6].Z:=50;
   Pnts[7].X:=50;Pnts[7].Y:=50;Pnts[7].Z:=50;
   Pnts[8].X:=-50;Pnts[8].Y:=50;Pnts[8].Z:=50;
  end;

{The following function returns true if the sum of the  }
{parameters is greater then zero and false if it is     }
{less then zero. We will use this function to determine }
{Which sides of the cube to hide and which to show      }
 function ShowSide(V1,V2,V3,V4:Extended):Boolean;
  begin
   if V1+V2+V3+V4>0 then ShowSide:=TRUE
   else ShowSide:=FALSE;
  end;

{We are using a double buffer. This function determines if a side}
{is visible. If it is, it draws the 2D representation on our     }
{bitmap buffer with the fill set to the color passed             }
 procedure AddSide(P1,P2,P3,P4:Integer;SideColor : TColor);
  begin
   if ShowSide(PntsOut[P1].Z,PntsOut[P2].Z,PntsOut[P3].Z,PntsOut[P4].Z) then
    begin
     DoubleBuffer.Canvas.Brush.Color:=SideColor;
     DoubleBuffer.Canvas.Polygon([TPPnts[P1],TPPnts[P2],TPPnts[P3],
                                  TPPnts[P4],TPPnts[P1]]);
    end;
  end;

{When the form loads, create and initialize our background bitmap}
{and initialize our double buffer bitmap.                        }
 procedure TDrehen.FormCreate(Sender: TObject);
  begin
   DoubleBuffer:=TBitmap.Create;
   DoubleBuffer.Height:=200;
   DoubleBuffer.Width:=200;
   BlankBuffer:=TBitmap.Create;
   BlankBuffer.Height:=200;
   BlankBuffer.Width:=200;
   BlankBuffer.Canvas.Brush.Color:=clWhite;
   BlankBuffer.Canvas.rectangle(0,0,200,200);
   InitCube;XAng:=0;YAng:=0;ZAng:=0;
  end;

{When we are done we need to clean up by freeing out bitmaps}
 procedure TDrehen.FormClose(Sender: TObject; var Action: TCloseAction);
  begin
   BlankBuffer.Free;
   DoubleBuffer.Free;
  end;

{The main procedure which draws the cube. This procedure is called  }
{by a timer that executes its OnTimer function every 20 milliseconds}
 procedure TDrehen.TimerTimer(Sender: TObject);
  var M:Matrix;             {The matrix used to rotate the cube}
      Count,Count2:Integer; {Used to loop through points       }
  begin
    XAng:=XAng+XRot.Position;  {adjust the rotation angle}
    YAng:=YAng+YRot.Position;  {by pulling out of the    }
    ZAng:=ZAng+ZRot.Position;  {scroll bars              }
    {Adjust for degrees and build the rotation matrix}
    matrixRotate(M,(PI*XAng)/180,(PI*YAng)/180,(PI*ZAng)/180);
    {Loop through all of the points and rotate, the get 2D representation}
    for Count2:=1 to 8 do
     begin
      ApplyMatToPoint(Pnts[Count2],PntsOut[Count2],M);
      TPPnts[Count2]:=Point(trunc(PntsOut[Count2].X+100),trunc(PntsOut[Count2].Y+100));
     end;
    {Clear the double buffer by copyrect[ing] the Background}
    DoubleBuffer.Canvas.CopyRect(RECT(0,0,200,200),BlankBuffer.Canvas,RECT(0,0,200,200));
    {Build the cube by calling AddSide for each of the 6 sides}
    AddSide(1,2,3,4,clBlue);
    AddSide(5,6,7,8,clRed);
    AddSide(1,2,6,5,clYellow);
    AddSide(2,3,7,6,clGreen);
    AddSide(3,4,8,7,clPurple);
    AddSide(4,1,5,8,clSilver);
    {Copy the double buffer to the form}
    Drehen.Canvas.CopyRect(RECT(0,0,200,200),DoubleBuffer.Canvas,RECT(0,0,200,200));
  end;

{To bring the cube back to its origional state, remove the rotation angles}
 procedure TDrehen.ResetCubeClick(Sender: TObject);
  begin
   XAng:=0;YAng:=0;ZAng:=0;
  end;

end.