unit Main;

interface

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

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

var
  Form1: TForm1;

implementation

{$R *.DFM}

type
 Matrix = array[0..3, 0..3] of Real;
 TDPoint = record
  X: Real;
  Y: Real;
  Z: Real;
 end;

var
 DoubleBuffer: TBitmap;
 BlankBuffer: TBitmap;
 PntsOut: array[1..8] of TDPoint;
 TPPnts: array[1..8] of TPoint;
 Pnts: array[1..8] of TDPoint;
 Xang, YAng, ZAng: Real;

procedure matrixRotate(var m: Matrix; x,y,z: Real);
var
 sinX, cosX,
 sinY, cosY,
 sinZ, cosZ: Real;
 C1, C2: Integer;
begin
 sinX := sin(x);
 cosX := cos(x);
 sinY := sin(y);
 cosY := cos(y);
 sinZ := sin(z);
 cosZ := cos(z);
 for C1 := 0 to 3 do
  for C2 := 0 to 3 do
   if C1 = C2 then
    M[C1,C2] := 0
   else
    M[C1,C2] := 1;

 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;

procedure ApplyMatToPoint(PointIn: TDPoint; var PointOut: TDPoint; mat: Matrix);
var
 x, y, z: Real;
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;

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;

function ShowSide(V1,V2,V3,V4: Real): Boolean;
begin
 if (V1+V2+V3+V4) > 0 then
  ShowSide := True
 else
  ShowSide := False;
end;

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;

procedure TForm1.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;

procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
begin
 BlankBuffer.Free;
 DoubleBuffer.Free;
end;

procedure TForm1.Timer1Timer(Sender: TObject);
var
 M: Matrix;
 Count, Count2: Integer;
begin
 XAng := XAng + XRot.Position;
 YAng := YAng + YRot.Position;
 ZAng := ZAng + ZRot.Position;

 matrixRotate(M,(PI*XAng)/180,(PI*YAng)/180,(PI*ZAng)/180);

 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;

 DoubleBuffer.Canvas.CopyRect(Rect(0,0,200,200),
              BlankBuffer.Canvas,Rect(0,0,200,200));

 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);

 Form1.Canvas.CopyRect(Rect(0,0,200,200),DoubleBuffer.Canvas,
              Rect(0,0,200,200));
end;

procedure TForm1.ResetCubeClick(Sender: TObject);
begin
 XAng := 0;
 YAng := 0;
 ZAng := 0;
end;

end.