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.

<< Prev

Next >>

Contents
Fastgraph Home Page

 

copyright 2001 Ted Gruber Software, Inc.