Cube: Delphi Version
{*****************************************************************************
* *
* Cube.dpr *
* CubeU.pas *
* *
* This program draws a cube in 3D world space and allows the user to move *
* and rotate the cube through keyboard controls. Each of the six cube faces *
* is a different color. *
* *
*****************************************************************************}
unit CubeU;
interface
uses
SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics, Controls,
Forms, Dialogs, FGWin;
type
TForm1 = class(TForm)
procedure AppOnActivate(Sender: TObject);
procedure AppIdle(Sender: TObject; var Done: Boolean);
procedure FormActivate(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure FormPaint(Sender: TObject);
procedure FormResize(Sender: TObject);
procedure FormDestroy(Sender: TObject);
end;
var
Form1: TForm1;
implementation
{$R *.DFM}
type
POINT3D = record
x : double;
y : double;
z : double;
end;
const
{ virtual buffer dimensions }
vbWidth = 640;
vbHeight = 480;
{ six faces of a 40x40x40 cube, defined in object coordinates }
Face1 : array [1..4] of POINT3D = (
(x: 20.0; y:-20.0; z:-20.0),
(x:-20.0; y:-20.0; z:-20.0),
(x:-20.0; y: 20.0; z:-20.0),
(x: 20.0; y: 20.0; z:-20.0));
Face2 : array [1..4] of POINT3D = (
(x:-20.0; y:-20.0; z:-20.0),
(x:-20.0; y:-20.0; z: 20.0),
(x:-20.0; y: 20.0; z: 20.0),
(x:-20.0; y: 20.0; z:-20.0));
Face3 : array [1..4] of POINT3D = (
(x: 20.0; y: 20.0; z: 20.0),
(x:-20.0; y: 20.0; z: 20.0),
(x:-20.0; y:-20.0; z: 20.0),
(x: 20.0; y:-20.0; z: 20.0));
Face4 : array [1..4] of POINT3D = (
(x: 20.0; y:-20.0; z: 20.0),
(x: 20.0; y:-20.0; z:-20.0),
(x: 20.0; y: 20.0; z:-20.0),
(x: 20.0; y: 20.0; z: 20.0));
Face5 : array [1..4] of POINT3D = (
(x: 20.0; y:-20.0; z: 20.0),
(x:-20.0; y:-20.0; z: 20.0),
(x:-20.0; y:-20.0; z:-20.0),
(x: 20.0; y:-20.0; z:-20.0));
Face6 : array [1..4] of POINT3D = (
(x: 20.0; y: 20.0; z:-20.0),
(x:-20.0; y: 20.0; z:-20.0),
(x:-20.0; y: 20.0; z: 20.0),
(x: 20.0; y: 20.0; z: 20.0));
{ for convenience, an array of pointers to each of the six faces }
Faces : array [1..6] of ^POINT3D = (@Face1,@Face2,@Face3,@Face4,@Face5,@Face6);
var
dc : hDC;
hPal : hPalette;
hVB : integer;
cxClient, cyClient : integer;
vbDepth : integer;
Redraw : boolean;
xAngle, yAngle, zAngle : integer;
xWorld, yWorld, zWorld : double;
{*****************************************************************************
* *
* DrawCube() *
* *
* Draws each of the six cube faces in 3D world space. *
* *
*****************************************************************************}
procedure DrawCube;
const
Colors : array [1..6] of integer = (84,88,92,96,100,104);
var
i : integer;
r, g, b : integer;
begin
for i := 1 to 6 do
begin
if (vbDepth> 8) then
begin
fg_getrgb(Colors[i],r,g,b);
fg_setcolorrgb(r,g,b);
end
else
fg_setcolor(Colors[i]);
fg_3Dpolygonobject(Faces[i]^,4);
end;
end;
{*****************************************************************************
* *
* CheckForMovement() *
* *
* The CheckForMovement() function checks for key presses that control the *
* cube's movement, and if required redraws the cube at its new position and *
* orientation. It is called from the application's OnIdle event handler. *
* *
*****************************************************************************}
procedure CheckForMovement;
var
ShiftKey : boolean;
begin
{ check if either shift key is pressed }
ShiftKey := (fg_kbtest(42) = 1) or (fg_kbtest(54) = 1);
{ + and - move cube along the z axis (+ is toward viewer, - is }
{ away from viewer) }
if (fg_kbtest(74) = 1) then
begin
zWorld := zWorld + 3.0;
Redraw := True;
end
else if (fg_kbtest(78) = 1) then
begin
zWorld := zWorld - 3.0;
Redraw := True;
end
{ left and right arrow keys move cube along x axis }
else if (fg_kbtest(75) = 1) then
begin
xWorld := xWorld - 3.0;
Redraw := True;
end
else if (fg_kbtest(77) = 1) then
begin
xWorld := xWorld + 3.0;
Redraw := True;
end
{ up and down arrow keys move cube along y axis }
else if (fg_kbtest(72) = 1) then
begin
yWorld := yWorld + 3.0;
Redraw := True;
end
else if (fg_kbtest(80) = 1) then
begin
yWorld := yWorld - 3.0;
Redraw := True;
end
{ x rotates counterclockwise around x axis, X rotates clockwise }
else if (fg_kbtest(45) = 1) then
begin
if (ShiftKey) then
begin
Inc(xAngle,6);
if (xAngle>= 360) then Dec(xAngle,360);
end
else
begin
Dec(xAngle,6);
if (xAngle < 0) then Inc(xAngle,360); end; Redraw := True; end { y rotates counterclockwise around y axis, Y rotates clockwise } else if (fg_kbtest(21) = 1) then begin if (ShiftKey) then begin Inc(yAngle,6); if (yAngle>= 360) then Dec(yAngle,360);
end
else
begin
Dec(yAngle,6);
if (yAngle < 0) then Inc(yAngle,360); end; Redraw := True; end { z rotates counterclockwise around z axis, Z rotates clockwise } else if (fg_kbtest(44) = 1) then begin if (ShiftKey) then begin Inc(zAngle,6); if (zAngle>= 360) then Dec(zAngle,360);
end
else
begin
Dec(zAngle,6);
if (zAngle < 0) then Inc(zAngle,360); end; Redraw := True; end; { if the cube's position or rotation changed, redraw the cube } if (Redraw) then begin { erase the previous frame from the virtual buffer } fg_setcolor(-1); fg_fillpage; { define the cube's new position and rotation in 3D world space } fg_3Dsetobject(xWorld,yWorld,zWorld,xAngle*10,yAngle*10,zAngle*10); { draw the cube } DrawCube; { display what we just drew } fg_vbscale(0,vbWidth-1,0,vbHeight-1,0,cxClient-1,0,cyClient-1); Redraw := False; end; end; {****************************************************************************} procedure TForm1.AppOnActivate(Sender: TObject); begin fg_realize(hPal); Invalidate; end; procedure TForm1.AppIdle(Sender: Tobject; var Done: Boolean); begin CheckForMovement; Done := False; end; procedure TForm1.FormActivate(Sender: TObject); begin fg_realize(hPal); end; procedure TForm1.FormCreate(Sender: TObject); begin dc := GetDC(Form1.Handle); fg_setdc(dc); hPal := fg_defpal; fg_realize(hPal); fg_vbinit; vbDepth := fg_colors; fg_vbdepth(vbDepth); hVB := fg_vballoc(vbWidth,vbHeight); fg_vbopen(hVB); fg_vbcolors; fg_setcolor(-1); fg_fillpage; fg_3Dviewport(0,vbWidth-1,0,vbHeight-1,0.5); fg_3Drenderstate(FG_ZCLIP); xAngle := 0; yAngle := 0; zAngle := 0; xWorld := 0.0; yWorld := 0.0; zWorld := 100.0; Redraw := True; Application.OnActivate := AppOnActivate; Application.OnIdle := AppIdle; end; procedure TForm1.FormPaint(Sender: TObject); begin fg_vbscale(0,vbWidth-1,0,vbHeight-1,0,cxClient-1,0,cyClient-1); end; procedure TForm1.FormResize(Sender: TObject); begin cxClient := ClientWidth; cyClient := ClientHeight; Invalidate; end; procedure TForm1.FormDestroy(Sender: TObject); begin fg_vbclose; fg_vbfree(hVB); fg_vbfin; DeleteObject(hPal); ReleaseDC(Form1.Handle,dc); end; end.