Columns: Delphi Version
{*****************************************************************************
* *
* Columns.dpr *
* ColumnsU.pas *
* *
* This program draws a grid of columns in 3D world space. It demonstrates *
* polygon culling and Fastgraph's incremental POV functions. *
* *
*****************************************************************************}
unit ColumnsU;
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 FormDestroy(Sender: TObject);
end;
var
Form1: TForm1;
implementation
{$J+}
{$R *.DFM}
const
{ virtual buffer dimensions }
vbWidth = 600;
vbHeight = 400;
{ height of information area }
InfoHeight = 80;
{ window dimensions }
WinWidth = vbWidth;
WinHeight = vbHeight + InfoHeight;
{ six faces of a 2x2x10 column, defined in object coordinates }
ColumnData : Array [1..6,1..12] of double = (
(-1.0,10.0, 1.0, 1.0,10.0, 1.0, 1.0,10.0,-1.0, -1.0,10.0,-1.0), { top }
(-1.0,10.0,-1.0, 1.0,10.0,-1.0, 1.0, 0.0,-1.0, -1.0, 0.0,-1.0), { front }
(-1.0,10.0, 1.0, -1.0,10.0,-1.0, -1.0, 0.0,-1.0, -1.0, 0.0, 1.0), { left }
( 1.0,10.0,-1.0, 1.0,10.0, 1.0, 1.0, 0.0, 1.0, 1.0, 0.0,-1.0), { right }
(-1.0, 0.0,-1.0, 1.0, 0.0,-1.0, 1.0, 0.0, 1.0, -1.0, 0.0, 1.0), { bottom }
( 1.0,10.0, 1.0, -1.0,10.0, 1.0, -1.0, 0.0, 1.0, 1.0, 0.0, 1.0)); { back }
var
dc : hDC;
hPal : hPalette;
hVB : integer;
hZB : integer;
{*****************************************************************************
* *
* UpdateInfo() *
* *
* Displays the information at the bottom of the window. *
* *
*****************************************************************************}
procedure UpdateInfo;
var
x, y, z, xDir, yDir, zDir : double;
MessageText : string;
begin
{ get current position and direction }
fg_3Dgetpov(x,y,z,xDir,yDir,zDir);
{ clear an area to write on }
fg_setcolorrgb(0,0,140);
fg_rect(0,249,0,InfoHeight-1);
fg_setcolorrgb(0,140,0);
fg_rect(250,vbWidth-1,0,InfoHeight-1);
fg_setcolor(-1);
{ print current position and unit vector }
fg_move(20,32);
MessageText := 'x = ' + FloatToStrF(x,ffFixed,7,2) +
' xDir = ' + FloatToStrF(xDir,ffFixed,7,2);
fg_print(MessageText,length(MessageText));
fg_move(20,46);
MessageText := 'y = ' + FloatToStrF(y,ffFixed,7,2) +
' yDir = ' + FloatToStrF(yDir,ffFixed,7,2);
fg_print(MessageText,length(MessageText));
fg_move(20,60);
MessageText := 'z = ' + FloatToStrF(z,ffFixed,7,2) +
' zDir = ' + FloatToStrF(zDir,ffFixed,7,2);
fg_print(MessageText,length(MessageText));
{ print instructions }
fg_move(270,18);
MessageText := 'Up = move forward Home = move up';
fg_print(MessageText,length(MessageText));
fg_move(270,32);
MessageText := 'Down = move back End = move down';
fg_print(MessageText,length(MessageText));
fg_move(270,46);
MessageText := 'Left = turn left PgUp = look up';
fg_print(MessageText,length(MessageText));
fg_move(270,60);
MessageText := 'Right = turn right PgDn = look down';
fg_print(MessageText,length(MessageText));
fg_move(290,74);
MessageText := 'Shift+Left/Right = move left/right';
fg_print(MessageText,length(MessageText));
fg_vbpaste(0,vbWidth-1,0,InfoHeight-1,0,WinHeight-1);
end;
{*****************************************************************************
* *
* DrawColumns() *
* *
* Draws the scene at its new POV. Columns behind the viewer are culled out. *
* *
*****************************************************************************}
procedure DrawColumns;
const
r : array [1..6] of integer = (254,243,226,203,123,166);
g : array [1..6] of integer = (219,194,172,150, 98,125);
b : array [1..6] of integer = (164,117, 86, 67, 59, 60);
var
nColor : array [1..6] of integer;
row, col : integer;
i : integer;
begin
{ prepare for the new frame }
fg_zbframe;
fg_setcolor(-1);
fg_fillpage;
{ create the six encoded color values }
for i := 1 to 6 do
nColor[i] := fg_maprgb(r[i],g[i],b[i]);
{ 50x50x6 = 15000 polygons per frame }
row := -500;
while (row < 500) do
begin
col := -500;
while (col < 500) do
begin
if (fg_3Dbehindviewer(row,0.0,col,-1.0) = 0) then
begin
fg_3Dmoveobject(row,0.0,col);
{ draw all the faces }
for i := 1 to 6 do
begin
{ set the color }
fg_setcolor(nColor[i]);
{ draw the face }
fg_3Dpolygonobject(ColumnData[i],4);
end;
end;
inc(col,20);
end;
inc(row,20);
end;
{ display the scene }
fg_vbpaste(0,vbWidth-1,0,vbHeight-1,0,vbHeight-1);
{ display the 3D information at the bottom of the window }
UpdateInfo;
end;
{*****************************************************************************
* *
* CheckForMotion() *
* *
* The CheckForMotion() function checks for key presses that control the *
* viewer's position and orientation, and if required redraws the scene at *
* its new POV. It is called from the application's OnIdle event handler. *
* *
*****************************************************************************}
procedure CheckForMotion;
var
ShiftKey : boolean;
begin
{ check if either shift key is pressed }
ShiftKey := (fg_kbtest(42) = 1) or (fg_kbtest(54) = 1);
if (fg_kbtest(71) = 1) then { Home }
begin
fg_3Dmoveup(5.0);
DrawColumns;
end
else if (fg_kbtest(72) = 1) then { Up arrow }
begin
fg_3Dmoveforward(5.0);
DrawColumns;
end
else if (fg_kbtest(73) = 1) then { PgUp }
begin
fg_3Drotateup(100);
DrawColumns;
end
else if (fg_kbtest(75) = 1) then { Left arrow }
begin
if (ShiftKey) then
fg_3Dmoveright(-5.0)
else
fg_3Drotateright(-100);
DrawColumns;
end
else if (fg_kbtest(77) = 1) then { Right arrow }
begin
if (ShiftKey) then
fg_3Dmoveright(5.0)
else
fg_3Drotateright(100);
DrawColumns;
end
else if (fg_kbtest(79) = 1) then { End }
begin
fg_3Dmoveup(-5.0);
DrawColumns;
end
else if (fg_kbtest(80) = 1) then { Down arrow }
begin
fg_3Dmoveforward(-5.0);
DrawColumns;
end
else if (fg_kbtest(81) = 1) then { PgDn }
begin
fg_3Drotateup(-100);
DrawColumns;
end
end;
{****************************************************************************}
procedure TForm1.AppOnActivate(Sender: TObject);
begin
fg_realize(hPal);
Invalidate;
end;
procedure TForm1.AppIdle(Sender: Tobject; var Done: Boolean);
begin
CheckForMotion;
Done := False;
end;
procedure TForm1.FormActivate(Sender: TObject);
begin
fg_realize(hPal);
end;
procedure TForm1.FormCreate(Sender: TObject);
begin
{ set up the device context and logical palette }
dc := GetDC(Form1.Handle);
fg_setdc(dc);
hPal := fg_defpal;
fg_realize(hPal);
{ initialize the virtual buffer environment }
fg_vbinit;
fg_vbdepth(fg_colors);
{ create and open the virtual buffer }
hVB := fg_vballoc(vbWidth,vbHeight);
fg_vbopen(hVB);
fg_vbcolors;
{ create and open the z-buffer }
hZB := fg_zballoc(vbWidth,vbHeight);
fg_zbopen(hZB);
{ define 3D viewport, render state, and initial POV }
fg_3Dviewport(0,vbWidth-1,0,vbHeight-1,1.0);
fg_3Drenderstate(FG_ZBUFFER or FG_ZCLIP);
fg_3Dlookat(10.0,20.0,100.0,0.0,20.0,0.0);
{ direct strings to the active virtual buffer }
fg_fontdc(fg_getdc);
{ make the client area equal to the required size }
Top := 0;
Left := 0;
ClientWidth := WinWidth;
ClientHeight := WinHeight;
Application.OnActivate := AppOnActivate;
Application.OnIdle := AppIdle;
end;
procedure TForm1.FormPaint(Sender: TObject);
begin
DrawColumns;
end;
procedure TForm1.FormDestroy(Sender: TObject);
begin
fg_vbclose;
fg_zbfree(hZB);
fg_vbfree(hVB);
fg_vbfin;
DeleteObject(hPal);
ReleaseDC(Form1.Handle,dc);
end;
end.
|