2004-01-20 14:02

'*******************************************************************************************
' 	this is a simple program demonstrating DIRECT 3D in RapidQ
'	lights are moved by mouse, scaling and rotation changed by clicking - all by
'	 QD3DFrame or MeshBuilder (QD3DMeshBuilder)
'	translation is done by the camera locked to the DXscreen
'JohnK
'******************************************************************************************
'
'

     $TYPECHECK ON							'this will make you a better programmer in the end
     $INCLUDE "RapidQ_D3D.INC"		'constants


     DECLARE SUB DXInitialize(Sender AS QDXSCREEN)		'initalize Direct3D Retained mode interface
     DECLARE SUB DXInitializeSurface(Sender AS QDXSCREEN)'initialize Direct Draw surface
     DECLARE SUB DXTimerExpired
     DECLARE SUB ToggleRotation (Button AS INTEGER, X AS INTEGER, Y AS INTEGER)



     DIM DXTimer AS QDXTIMER					'regularly update display
     DXTimer.Enabled = 1
     DXTimer.Interval = 0
     DXTimer.Activeonly = 0
     DXTimer.OnTimer = DXTimerExpired

     DIM MeshFrame AS QD3DFRAME				'possible for root frame all 3d objects should be attached to a frame
     DIM LightFrame AS QD3DFRAME				'lights must be placed on a frame. Camera is attached to a frame by RapidQ for you
     DIM MeshBuilder AS QD3DMESHBUILDER		'mesh builder to create a mesh out of the face
     DIM i AS SINGLE							'increment a translation
     DIM RotAngl AS SINGLE : RotAngl = 0.03	'constant angle of rotation
     DIM RotateIt AS SINGLE: RotateIt = 0 	'toggle on/off rotation
     DIM TransDir AS SINGLE: TransDir= 1		'translation of object

     RANDOMIZE
     CREATE Form AS QFORM
      CAPTION = "Direct 3D Example - click or move mouse"
      Width = 640
      Height = 480
      Center
      CREATE DXScreen AS QDXSCREEN	'really a direct draw surface?
       Init(640,480)
       Align = 5					'alClient - need this to center Direct Draw screen onto Form
       BitCount = 16				'16 bits/pixel use 32 for alpha bending on fast 3d cards
       Use3D = 1					'load Direct3D Retained mode
       UseHardware = 1				'get real!! 3D accelerated video cards are cheap
       OnInitialize = DXInitialize					'load your meshs/faces to the frames, set lights, camera
       OnInitializeSurface = DXInitializeSurface	'screen is ready to be drawn
       OnMouseDown = ToggleRotation				'mouse click stops/starts rotation
      END CREATE
      SHOWMODAL						'get the program running
     END CREATE



     SUB DXInitialize(Sender AS QDXSCREEN)
      DIM Ambient AS QD3DLIGHT			'need at least one light this can be local sub-- we won't modify it
      DIM Light AS QD3DLIGHT				'will define as point ligth that gives rich illumination to see the walls
      DIM Face AS QD3DFACE				'can't modify so just declare it in sub that makes the face
      DIM Face2 AS QD3DFACE				'can't modify so just declare it in sub that makes the face
      DIM x AS DOUBLE, y AS DOUBLE, z AS DOUBLE

      DXScreen.CreateFrame(MeshFrame)		'create the frames objects will be attached to
      DXScreen.CreateFrame(LightFrame)	'probably allocates memory, handles, etc
      DXScreen.CreateMeshBuilder(MeshBuilder)


''		*********  First we create the lights  ******************
      DXScreen.CreateLightRGB(D3DRMLIGHT_AMBIENT, 0.2, 0.2, 0.5, Ambient)	'ambient is dim grey
      DXScreen.AddLight(Ambient)			'ambient light moves with root frame (and object since it is on root frame)
'	LightFrame.AddLight(Ambient)		'this would make it move with all lights -- comment out previous line

      DXScreen.CreateLightRGB(D3DRMLIGHT_POINT, 0.8, 0.8, 0.2, Light)		'point light is bright yellow, units depend on MeshBuilder.SetRGB(1, 1, 1)
'	Light.SetUmbra(1.0)					'these dont effect light much
'	Light.SetRange(3.0)					'it is more important to define the type of light
'	Light.SetPenUmbra(3.0)
      DXScreen.AddLight(Light)			'use this to attach light to  root frame so light moves with objects
      LightFrame.AddLight(Light)			'attach light to frame to move the light!
      LightFrame.SetPosition(0, 2, -1)	'units are x,y,z


''		*********  next create a face of polygons  ******************
      DIM openDialog AS QOPENDIALOG
      openDialog.CAPTION = "open a direct x model"
      openDialog.filter = "*.x (X models)|*.x"
      IF openDialog.EXECUTE THEN
       meshBuilder.load(openDialog.filename)		'make the polygons on the face into a mesh for rendering
       MeshBuilder.Scale(0.025, 0.025, 0.025)		'make it smaller by 2x
       MeshBuilder.SetQuality(D3DRMRENDER_GOURAUD)	'highest rendering Quality is D3DRMRENDER_PHONG
       MeshFrame.AddVisual(MeshBuilder)
       MeshFrame.SetRotation(0, 0, 0,RotAngl)		' Angle of rotation on center for the planes we just made
       DXScreen.SetCameraPosition(8, 2, 0)			'you can move the camera around instead of rotating 3d object
       DXScreen.CameraLookAt(MeshFrame, D3DRMCONSTRAIN_Z)			'constrain the Axis that the camera looks at
      ELSE
       Application.Terminate
      END IF
     END SUB


     SUB DXInitializeSurface(Sender AS QDXSCREEN)
      DXScreen.SetRenderMode(D3DRMRENDERMODE_BLENDEDTRANSPARENCY D3DRMRENDERMODE_BLENDEDTRANSPARENCY OR D3DRMRENDERMODE_DISABLESORTEDALPHAZWRITE OR D3DRMRENDERMODE_VIEWDEPENDENTSPECULAR)
     END SUB

     SUB DXTimerExpired
      i = i +.01 * TransDir
      IF ABS(i) > 2 THEN TransDir = TransDir * -1
      DXScreen.SetCameraPosition(8, 2, i - 1)
      LightFrame.SetPosition(Screen.MOUSEX/200, Screen.MOUSEY/200,  Screen.MOUSEY/200)	'units are x,y,z
      DXScreen.ForceUpdate(0,0,50,40)     ' Update FPS text only
      DXScreen.Move(1)                    ' This does the rotation by 2 times
      DXScreen.Render
      DXScreen.TextOut(10,10,"FPS: "+STR$(DXTimer.FrameRate), &HFFFFFF, -1)
      DXScreen.Flip
     END SUB



     SUB ToggleRotation (Button AS INTEGER, X AS INTEGER, Y AS INTEGER)
      IF Button = 0 THEN
       MeshBuilder.Scale(0.5, 0.5, 0.5)			'make it smaller by 2x
      END IF
      IF Button = 1 THEN
       MeshBuilder.Scale(2, 2, 2)					'make it bigger by 2x
      END IF
      IF RotateIt THEN
       MeshFrame.SetRotation(0, 0, 0, 0)
       RotateIt= 0
      ELSE
       MeshFrame.SetRotation(0, 0, 0, RotAngl)		' rotate on center, Angle of rotation is variable
       LightFrame.SetPosition(-1, 2, 0)			'units are x,y,z
       RotateIt = 1
      END IF
     END SUB

2004-01-20 14:02