Geometry: Delphi Version

{*****************************************************************************
*                                                                            *
*  Geometry.dpr                                                              *
*  GeometryU.pas                                                             *
*                                                                            *
*  This program shows how to display 3D objects in object space and 3D world *
*  space.                                                                    *
*                                                                            *
*****************************************************************************}
unit GeometryU;
interface
uses
  SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics, Controls,
  Forms, Dialogs, FGWin;
type
  TForm1 = class(TForm)
    procedure AppOnActivate(Sender: TObject);
    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
{$J+}
{$R *.DFM}
const
  { virtual buffer dimensions }
  vbWidth = 300;
  vbHeight = 300;
  { six faces of a 2x2x2 cube, defined in object coordinates }
  CubeFaces : Array [1..6,1..12] of double = (
   (-1.0, 1.0, 1.0,  1.0, 1.0, 1.0,  1.0, 1.0,-1.0, -1.0, 1.0,-1.0),  { top }
   (-1.0, 1.0,-1.0,  1.0, 1.0,-1.0,  1.0,-1.0,-1.0, -1.0,-1.0,-1.0),  { front }
   (-1.0, 1.0, 1.0, -1.0, 1.0,-1.0, -1.0,-1.0,-1.0, -1.0,-1.0, 1.0),  { left }
   ( 1.0, 1.0,-1.0,  1.0, 1.0, 1.0,  1.0,-1.0, 1.0,  1.0,-1.0,-1.0),  { right }
   (-1.0,-1.0,-1.0,  1.0,-1.0,-1.0,  1.0,-1.0, 1.0, -1.0,-1.0, 1.0),  { bottom }
   ( 1.0, 1.0, 1.0, -1.0, 1.0, 1.0, -1.0,-1.0, 1.0,  1.0,-1.0, 1.0)); { back }
var
  dc : hDC;
  hPal : hPalette;
  hVB : integer;
  hZB : integer;
  cxClient, cyClient : integer;
{*****************************************************************************
*                                                                            *
*  DrawCubes()                                                               *
*                                                                            *
*  Draws two cubes, one in 3D world space and the other in object space,     *
*  along with 3D coordinate axes.                                            *
*                                                                            *
*****************************************************************************}
procedure DrawCubes;
const
  Colors : array [1..6] of integer = (19,20,21,22,23,24);
var
  i : integer;
begin
  { set the point of view (POV) }
  fg_3Dmove(4.0,4.0,-15.0);
  { position a cube at z=20.0 with no rotation }
  fg_3Dmoveobject(0.0,0.0,20.0);
  { draw the 3D coordinate axes in world space }
  fg_setcolor(0);
  fg_3Dline(0.0,0.0,0.0,10.0,0.0,0.0);
  fg_3Dline(0.0,0.0,0.0,0.0,10.0,0.0);
  fg_3Dline(0.0,0.0,0.0,0.0,0.0,500.0);
  { draw all six faces in both cubes }
  for i := 1 to 6 do
  begin
    fg_setcolor(Colors[i]);
    fg_3Dpolygon(CubeFaces[i],4);
    fg_3Dpolygonobject(CubeFaces[i],4);
  end;
end;
{****************************************************************************}
procedure TForm1.AppOnActivate(Sender: TObject);
begin
  fg_realize(hPal);
  Invalidate;
end;
procedure TForm1.FormActivate(Sender: TObject);
begin
  fg_realize(hPal);
end;
procedure TForm1.FormCreate(Sender: TObject);
begin
  { create the device context and logical palette }
  dc := GetDC(Form1.Handle);
  fg_setdc(dc);
  hPal := fg_defpal;
  fg_realize(hPal);
  { create and open the virtual buffer }
  fg_vbinit;
  hVB := fg_vballoc(vbWidth,vbHeight);
  fg_vbopen(hVB);
  fg_vbcolors;
  { fill the virtual buffer with white pixels }
  fg_setcolor(-1);
  fg_fillpage;
  { create and open the z-buffer }
  hZB := fg_zballoc(vbWidth,vbHeight);
  fg_zbopen(hZB);
  { define 3D viewport and render state }
  fg_3Dviewport(0,vbWidth-1,0,vbHeight-1,1.0);
  fg_3Drenderstate(FG_ZBUFFER);
  { draw the cubes and coordinate axes }
  DrawCubes;
  Application.OnActivate := AppOnActivate;
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_zbfree(hZB);
  fg_vbfree(hVB);
  fg_vbfin;
  DeleteObject(hPal);
  ReleaseDC(Form1.Handle,dc);
end;
end.