TMcubeX: Delphi Version


{*****************************************************************************
*                                                                            *
*  TMcubeX.dpr                                                               *
*  TMcubeXU.pas                                                              *
*                                                                            *
*  This program is similar to the TMcube example, but it shows how to create *
*  a native, DirectDraw, or Direct3D program from the same source code.      *
*                                                                            *
*****************************************************************************}
unit TMcubeXU;
interface
{ define DIRECTX if creating a DirectDraw or Direct3D application }
{$DEFINE DIRECTX}
{$IFDEF DIRECTX}
uses
  SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics, Controls,
  Forms, Dialogs, FGWinD;
{$ELSE}
uses
  SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics, Controls,
  Forms, Dialogs, FGWin;
{$ENDIF}
type
  TForm1 = class(TForm)
    procedure AppOnActivate(Sender: TObject);
    procedure AppIdle(Sender: TObject; var Done: Boolean);
    procedure FormActivate(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure FormKeyDown(Sender: TObject; var Key: Word;
      Shift: TShiftState);
    procedure FormDestroy(Sender: TObject);
  protected
    procedure WMActivateApp(var Msg: TMessage); message WM_ACTIVATEAPP;
  end;
var
  Form1: TForm1;
implementation
{$J+}
{$R *.DFM}
type
  POINT3D = record
    x : double;
    y : double;
    z : double;
  end;
const
  { render state }
  RENDER_STATE = FG_PERSPECTIVE_TM or FG_ZBUFFER or FG_ZCLIP;
  { define the flag bits for fg_ddsetup() }
  { specify FG_DX_FLIP for a Direct3D application }
  { specify FG_DX_RENDER_HW or FG_DX_RENDER_SW for a Direct3D application }
  { specify FG_DX_ZBUFFER only if FG_ZBUFFER is defined in RENDER_STATE }
  {$IFDEF DIRECTX}
  DIRECTX_FLAGS = FG_DX_FLIP or FG_DX_RENDER_HW or FG_DX_ZBUFFER;
  {$ENDIF}
  { virtual buffer dimensions }
  vbWidth = 640;
  vbHeight = 480;
  vbDepth = 16;
  { 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);
  { width of texture map in pixels }
  tmWidth = 64;
  { coordinates defining source polygon vertices within the texture map array }
  tmSource : array [1..8] of integer = (
    tmWidth-1,tmWidth-1, 0,tmWidth-1, 0,0, tmWidth-1,0);
  AppIsActive : boolean = False;
  AppIsReady : boolean = False;
var
  { texture map array }
  Texture : array [1..6,1..tmWidth*tmWidth*(vbDepth div 8)] of byte;
  dc : hDC;
  hPal : hPalette;
  hVB : integer;
  hZB : integer;
  hTM : array [1..6] of integer;
  xAngle, yAngle, zAngle : integer;
  xWorld, yWorld, zWorld : double;
{*****************************************************************************
*                                                                            *
*  DrawCube()                                                                *
*                                                                            *
*  Transforms, clips, projects, and draws each of the six cube faces.        *
*                                                                            *
*****************************************************************************}
procedure DrawCube;
var
  i : integer;
begin
  for i := 1 to 6 do
  begin
    fg_tmselect(hTM[i]);
    fg_3Dtexturemapobject(Faces[i]^,tmSource,4);
  end;
end;
{*****************************************************************************
*                                                                            *
*  ShowCube()                                                                *
*                                                                            *
*  Performs a blit or flip to make the cube visible.                         *
*                                                                            *
*****************************************************************************}
procedure ShowCube;
begin
  {$IFDEF DIRECTX}
  fg_ddflip;
  {$ELSE}
  fg_vbpaste(0,vbWidth-1,0,vbHeight-1,0,vbHeight-1);
  {$ENDIF}
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.    *
*                                                                            *
*  The Redraw parameter controls when CheckForMovement() redraws the cube.   *
*  If False, the cube is redrawn only if its position or orientation has     *
*  changed since the last call. If True, the cube is redrawn no matter what. *
*                                                                            *
*****************************************************************************}
procedure CheckForMovement(Redraw: boolean);
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
    {$IFDEF DIRECTX}
    { tell Direct3D we're about to start a new frame }
    fg_ddframe(0);
    {$ENDIF}
    { prepare the z-buffer for the next frame }
    fg_zbframe;
    { 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;
    {$IFDEF DIRECTX}
    { tell Direct3D we're finished with this frame }
    fg_ddframe(1);
    {$ENDIF}
    { display what we just drew }
    ShowCube;
  end;
end;
{****************************************************************************}
procedure TForm1.AppOnActivate(Sender: TObject);
begin
  fg_realize(hPal);
end;
procedure TForm1.AppIdle(Sender: Tobject; var Done: Boolean);
begin
  if AppIsActive and AppIsReady then CheckForMovement(False);
  Done := False;
end;
{****************************************************************************}
procedure TForm1.WMActivateApp(var Msg: TMessage);
begin
  AppIsActive := (Msg.WParam <> 0);
  if AppIsActive and AppIsReady then
  begin
    {$IFDEF DIRECTX}
    fg_ddrestore;
    {$ENDIF}
    CheckForMovement(True);
  end;
end;
{****************************************************************************}
procedure TForm1.FormActivate(Sender: TObject);
begin
  fg_realize(hPal);
end;
procedure TForm1.FormCreate(Sender: TObject);
var
  i : integer;
begin
  Visible := True;
  {$IFDEF DIRECTX}
  fg_ddsetup(vbWidth,vbHeight,vbDepth,DIRECTX_FLAGS);
  {$ELSE}
  fg_modeset(vbWidth,vbHeight,fg_colors,1);
  WindowState := wsMaximized;
  {$ENDIF}
  dc := GetDC(Form1.Handle);
  fg_setdc(dc);
  hPal := fg_defpal;
  fg_realize(hPal);
  fg_vbinit;
  fg_vbdepth(vbDepth);
  {$IFDEF DIRECTX}
  hVB := 0;
  {$ELSE}
  hVB := fg_vballoc(vbWidth,vbHeight);
  {$ENDIF}
  fg_vbopen(hVB);
  fg_vbcolors;
  hZB := fg_zballoc(vbWidth,vbHeight);
  fg_zbopen(hZB);
  { define 3D viewport, clipping planes, and initial render state }
  fg_3Dviewport(0,vbWidth-1,0,vbHeight-1,0.5);
  fg_3Dsetzclip(40.0,1000.0);
  fg_3Drenderstate(RENDER_STATE);
  { obtain the six texture maps from the CUBE.PCX file }
  fg_tminit(6);
  fg_showpcx('CUBE.PCX'+chr(0),FG_AT_XY or FG_KEEPCOLORS);
  fg_move(0,tmWidth-1);
  for i := 1 to 6 do
  begin
    if (vbDepth = 8) then
    begin
      fg_getimage(Texture[i],tmWidth,tmWidth);
      fg_invert(Texture[i],tmWidth,tmWidth);
    end
    else
    begin
      fg_getdcb(Texture[i],tmWidth,tmWidth);
      fg_invdcb(Texture[i],tmWidth,tmWidth);
    end;
    hTM[i] := fg_tmdefine(Texture[i],tmWidth,tmWidth);
    fg_moverel(tmWidth,0);
  end;
  xAngle := 0;
  yAngle := 0;
  zAngle := 0;
  xWorld := 0.0;
  yWorld := 0.0;
  zWorld := 100.0;
  CheckForMovement(True);
  Application.OnActivate := AppOnActivate;
  Application.OnIdle := AppIdle;
  AppIsActive := True;
  AppIsReady := True;
end;
procedure TForm1.FormKeyDown(Sender: TObject; var Key: Word;
  Shift: TShiftState);
begin
  if (Key = VK_Escape) or (Key = VK_F12) then Close;
end;
procedure TForm1.FormDestroy(Sender: TObject);
begin
  fg_vbclose;
  fg_tmfree(-1);
  fg_zbfree(hZB);
  {$IFDEF DIRECTX}
  fg_vbfin;
  {$ELSE}
  fg_vbfree(hVB);
  fg_vbfin;
  fg_modeset(0,0,0,0);
  {$ENDIF}
  DeleteObject(hPal);
  ReleaseDC(Form1.Handle,dc);
  Application.Minimize;
end;
end.

<< Prev

Next >>

Contents
Fastgraph Home Page

 

copyright 2001 Ted Gruber Software, Inc.