Rapid-Q Direct3D Component by John Kelly Appendix B: QD3DPrimitive

QD3DPrimitive Component

INCLUDED IN RAPIDQ_D3D.INC
This will make simple polygon mesh objects that you can add to your scene. Use the Mesh and Frame portions for translating, rotation, color and scaling. See limitations.
 
QD3DPrimitive Properties
FieldTypeR/WDefault




BoxSidesINTEGER 
number of sides that a box can have
4 = open box
5 = box with top
6 = fully enclosed box
R/W
MeshQD3DMESHBUILDER  (see other docs) R/W
FrameQD3DFRAME R/W
DrawCenterQD3DVector  to set the center of the drawing coordinates, i.,e., 
Prim.DrawCenter.x = 0.5
Prim.DrawCenter.y = 0.5
Prim.DrawCenter.z = 0.5
R/W
ViewFromOutsideINTEGER 
Set this to False if you want to see the inside of the  mesh. 
Otherwise you see the faces outside (backside culling)
R/W
VisibleINTEGER 
Set this to true if the object has faces (polygons)
R/W

QD3DPrimitive Methods
MethodTypeDescriptionParams




The following Methods require passing the QDXScreen as an argument for creation of faces and meshes
LoadTextureFileSUB() opens a QOPENDIALOG box and loads the texture 1
MakeBox (DXScreen AS QDXSCREEN) build a 3dbox, number of sides set by BoxSides1
MakeCone (DXScreen AS QDXSCREEN, NumFaces #) build a cone pointing up, 3dbox, NumFaces will be the total number of faces 2
MakeHorizPlane(DXScreen AS QDXSCREEN)  make a flat plane in the horizontal dimension1
MakeVertZPlane(DXScreen AS QDXSCREEN) simple vertical plane down the z-axis (x = 0)2
MakeVertXPlane(DXScreen AS QDXSCREEN) simple vertical plane down the x-axis (z = 0)1
MakePyramid (DXScreen AS QDXSCREEN) Pyramid will be pointing up, 4 sides1
MakeSphere(DXScreen AS QDXSCREEN, NumFaces #)NumFaces will be the total number of faces in the sphere, good values range from 16 to 1201
MakeCylinder(DXScreen AS QDXSCREEN, NumFaces #)Cylinder will be pointing up, NumFaces will be the total number of faces in the sphere, good values range from 6 to 643

QD3DPrimitive Events

Event Type Occurs when... Params




QD3DPrimitive Examples
'
'3D pong Demo with Grateful Dead inspiration
'  Some minor code sections by Basic4GL
' JohnK
'
DECLARE SUB ChromeWrapThem
DECLARE SUB CloseApp
DECLARE SUB DXInit(Sender AS QDXScreen)
DECLARE SUB DXInitSurface(Sender AS QDXScreen)
DECLARE SUB DXscreen_MouseMove (MousX AS INTEGER, MousY AS INTEGER)
DECLARE SUB Form_Key_Press(TheKey AS WORD, Shift AS INTEGER)
DECLARE SUB Make3DObjects
DECLARE SUB MakeParticles
DECLARE SUB MoveParticles
DECLARE SUB MoveThem
DECLARE SUB New_Psychedelic_Background
DECLARE SUB RenderLoop
DECLARE SUB Reset_New_Ball
DECLARE SUB RotateCamera
DECLARE SUB WrapObjects
DECLARE SUB intro
DECLARE SUB scoreboard
DECLARE SUB updateFPS


$TYPECHECK ON                   'force checking of data types
$INCLUDE <RAPIDQ2.INC>          'objects and constants
$INCLUDE <RapidQ_D3D.INC>       'constants ++
$DEFINE DXWidth 640             'set display window for DxScreen
$DEFINE DXHeight 480
$DEFINE CourtX 20
$DEFINE CourtZ 10
$DEFINE Ceiling 12
$DEFINE PaddleWidth 3
$DEFINE PaddleThick 1
$DEFINE PaddleHeight 2
$DEFINE BallSize 0.8
$DEFINE MaxSpeed 3.5
$DEFINE pSpeed 2.5
$DEFINE InterPlayDelay 0.5  'delay between serves
$DEFINE NumParticles 20
CONST tmpBMPFile = "~~3DPongadelic.bmp"


DIM x AS SINGLE:            x=RND(1)* CourtX    'randomize the starting point of the ball x position
DIM y AS SINGLE:            y=RND(1)* Ceiling   'randomize the starting point of the ball y position
DIM z AS SINGLE:            z=RND(1)* CourtZ    'randomize the starting point of the ball Height
DIM bool_x:                 bool_x = true   'Test to See if the Ball Needs to go Left or Right
DIM bool_y:                 bool_x = true   'Test to See if the Ball Needs to go Up or Down
DIM bool_z:                 bool_z = true   'Test to See if the Ball Needs to go Cross court
DIM player1_y AS SINGLE:    player1_y = 0   'Player 1 height position
DIM player2_y AS SINGLE:    player2_y = 0   'Player 2 height position
DIM player1_z AS SINGLE:    player1_z = 0   'Player 1 lateral position
DIM player2_z AS SINGLE:    player2_z = 0   'Player 2 lateral position
DIM p1_score:               p1_score = 0    'Player 1 score
DIM p2_score:               p2_score = 0    'Player 2 Score
DIM FailRate AS SINGLE:     FailRate =30.0  'Player 2(computer) fails about 30%
DIM FPS AS INTEGER:         FPS = 30        'frames per second
DIM TheSpeed AS SINGLE:     TheSpeed = 0.2  'arbitrary speed for now
DIM RotateMe AS INTEGER:    RotateMe = True 'rotate world
DIM RelX AS SINGLE:         RelX = 0        'camera rotation
DIM RelY AS SINGLE:         RelY = 0        'camera rotation
DIM GameEndFlag AS INTEGER: GameEndFlag = False


DIM WorldFrame          AS QD3DFrame        'Master (parent) frame all 3d objects moving together attached to this frame
DIM AmbientLight        AS QD3DLight        'ambient DXscreen light.. make it dark for dark, daylight handles daytime!!
DIM DayLight            AS QD3DLight        'set the properties of the light, this is for ambient daylight
DIM DayLightFrame       AS QD3DFrame        'allow position & orientation of light
DIM Cam                 AS QD3DCAMERA       'custom camera component
DIM Paddle1             AS QD3DPrimitive    'our player 1 paddle
DIM Paddle2             AS QD3DPrimitive    'our player 1 paddle
DIM TheBall             AS QD3DPrimitive    'Boing ball
DIM FloorObj            AS QD3DPrimitive    'Floor is a reserved keyword
DIM SkyBox              AS QD3DPrimitive    'box around the world frame, texture surround scene on it
DIM wrap                AS QD3DWRAP         'object to hold texture wrapping information
DIM Particles1          AS QD3DCloneMesh    'A clone mesh is a single mesh on many QD3DFrames
DIM Particles2          AS QD3DCloneMesh    'A clone mesh is a single mesh on many QD3DFrames

CREATE MainForm AS QForm
    Caption = "3D Pong"
    BorderStyle =   bsNone
    Width = DXWidth
    Height = DXHeight
    Center
    OnKeyDown = Form_Key_Press
    OnClose = CloseApp

    CREATE DXScreen AS QDXScreen            'really a direct draw surface?
        Top = 0
        Left = 0
        Width = DXWidth
        Height = DXHeight
        Cursor = crNone
        FullScreen = True
        Init(DXWidth, DXHeight)
        BitCount = Screen.GetPixelDepth         'get whatever mode we are in
        Use3D = True                            'load Direct3D Retained mode
        UseHardware = True                      '3D accelerated video cards are cheap, get one!!
        OnInitialize = DXInit                   'load your meshs/faces to the frames, set lights, camera
        OnInitializeSurface = DXInitSurface     'screen is ready to be drawn
        OnMouseMove =   DXscreen_MouseMove      'pass mouse (X%, Y%)
        OnKeyDown = Form_Key_Press
    END CREATE
END CREATE

'DIM DXTimer AS QDXTimer                            'regularly update display
'    DXTimer.Enabled = False
'    DXTimer.Interval = 50
'    DXTimer.OnTimer = updateFPS





SUB updateFPS
'   FPS = DXTimer.FrameRate
'   DXScreen.TextOut(500, 32, "FPS = "+STR$(DXTimer.FrameRate) + "     ",&HFFFFFF, 0)' Print Player 2 Score
'   DXScreen.ForceUpdate(500, 32, 540, 64)
'   DXScreen.Flip
END SUB


'*******************************************************
'*******************************************************
'****     INITIALIZATION CODE FOR DirectX Screen *******
'*******************************************************
'*******************************************************

SUB DXInitSurface(Sender AS QDXScreen)
    DxScreen.setRenderMode(D3DRMRENDERMODE_BLENDEDTRANSPARENCY OR D3DRMRENDERMODE_SORTEDTRANSPARENCY)
    Intro
    RenderLoop
END SUB



SUB DXInit(Sender AS QDXScreen)

    DXScreen.CreateFrame(WorldFrame)    'create the terrain frame, all other frames will be attached to it in heirarchy
    DXScreen.CreateFrame(DayLightFrame) 'probably allocates pointer to COM interface, memory, handles, etc

'       *********  First we create the lights  ******************
    DXScreen.CreateLightRGB(D3DRMLIGHT_AMBIENT, 0.6, 0.6, 0.6, AmbientLight)    'ambient is dark for baseline darkness!!
    DXScreen.AddLight(AmbientLight)                                             'this light moves with root frame
    DXScreen.CreateLightRGB(D3DRMLIGHT_DIRECTIONAL, 0.9, 0.9, 0.9, DayLight)    'point light
    DayLightFrame.AddLight(DayLight)                                            'to a frame so we can remove from scene
    DayLightFrame.SetPosition(0, 8, 0)                                         'x,y,z position, some arbitary value until load a terrain
    DayLightFrame.SetOrientation(0, -1, 0, 0, 1, 0)                             'points straight down
    DXScreen.SetTextureQuality(D3DRMTEXTURE_MIPLINEAR)      'gives a smooth appearance to textures
    WorldFrame.SetPosition(0.0, 0.0, 0.0)           'centered because Heightmap is centered
    Make3DObjects
'   DXScreen.SetCameraPosition(0.0, 2.5 * Ceiling, -4 * CourtZ)
'   DXScreen.SetCameraOrientation(0.0,-0.5, 0.7, 0, 1, 0)
    Cam.Pos.x = 0.0
    Cam.Pos.y = 2.5 * Ceiling
    Cam.Pos.z = -4.5 * CourtZ
    Cam.Orient.x = 0.0
    Cam.Orient.y = -0.5
    Cam.Orient.z = 0.7
    Cam.Update(DXscreen)
    DXScreen.Font.Size = 14
    DXScreen.Font.Bold = True
    MakeParticles
    New_Psychedelic_Background
    ChromeWrapThem
END SUB




SUB RenderLoop

  DO                    ' Main Game Loop
    '----  move BALL and Paddles  -----------------

    TheBall.Frame.SetPosition(x, y, z)
    TheBall.Frame.Move(TheSpeed)                        'rotate it
    Paddle1.Frame.SetPosition(-CourtX, player1_y, player1_z)
    'add some strategy to the computer
    IF (x  > (CourtX/4)) THEN Paddle2.Frame.SetPosition(CourtX, y, z)   ' only hit near its side
    IF RotateMe THEN RotateCamera
    ChromeWrapThem
    MoveParticles
    DXScreen.Render
    scoreboard
    DOEVENTS


    'bounce if player 1 hits(Left Player)-----------------------------------------------------------------
    IF x < (-CourtX + PaddleThick) and (x >-CourtX) THEN
        IF (z <=player1_z + PaddleWidth) AND (z >=player1_z - PaddleWidth) THEN
            IF (y <=player1_y + PaddleHeight) AND (y >=player1_y - PaddleHeight) THEN   bool_x = true
        END IF
    END IF

    IF x <= -CourtX then
        p1_score = p1_score + 1   'If Ball Goes Past the Player then Score Goes
        Reset_New_Ball           'put up a new ball
		New_Psychedelic_Background
    END IF

    'IF 2 player game then bounce if player 2 hits(Right Player)----------------------------------------------------------------
'   Paddle2.Frame.SetPosition(CourtX, player2_y, player2_z)
'   if x >= (CourtX + PaddleThick) and (x < CourtX) and _
'           (y <=player2_z + PaddleWidth) and (y >=player2_z -PaddleWidth) then bool_x = true

    'did computer miss?
    IF (x >= CourtX - PaddleThick) THEN
        IF RND(100) < FailRate THEN             'miss about 30% of the time
            Paddle2.Frame.SetPosition(CourtX, y - PaddleHeight, z + PaddleWidth)' only hit it right 50%
            p2_score = p2_score + 1     ' Up By One Point
            Reset_New_Ball              'put up a new ball
		    New_Psychedelic_Background
        ELSE
            bool_x = false              ' Served it back ok
        END IF
    END IF

    if bool_x then x = x + TheSpeed  else x = x - TheSpeed  ' Bool(C++) Value Test Value
    if z <=-CourtZ then bool_z=true         ' Bounce Ball off walls
    if z >=CourtZ then bool_z=false
    if bool_z then INC(z, TheSpeed) else DEC(z, TheSpeed)

    if y <=0 then bool_y=true           'bounce off floor
    if y >= Ceiling then bool_y=false   'bounce off ceiling
    if bool_y then INC(y,TheSpeed)  else DEC(y, TheSpeed)


  LOOP UNTIL GameEndFlag
  CloseApp
END SUB



SUB Reset_New_Ball
    x = RND(1)* CourtX/3 * RND(1)
    y = RND(1) * Ceiling/3
    z = RND(1) * CourtZ/3 * RND(1)

    IF p1_score MOD 6 = 0 THEN
        DXscreen.VIEW.CLEAR
        intro
        DXscreen.VIEW.CLEAR
        IF TheSpeed < MaxSpeed THEN INC(TheSpeed, TheSpeed/6)
    END IF
END SUB




SUB Form_Key_Press(TheKey AS WORD, Shift AS INTEGER)
    SELECT CASE TheKey
    'Player One keyboard control (keeps in bounds)--------------------------------------------------------
    CASE = ASC("q")
        IF player1_z <CourtZ then player1_z =player1_z +TheSpeed
    CASE = ASC("a")
        IF player1_z >-CourtZ then player1_z =player1_z -TheSpeed
    'Player Two keyboard control (keeps in bounds)--------------------------------------------------------
    CASE = 38, 107      'up arrow and "+"
        IF player2_z <2.4 then player2_z =player2_z +TheSpeed
    CASE = 40, 109          'dn arrow "-"
        IF player2_z >-3 then player2_z =player2_z -TheSpeed
    CASE 82 'r
        IF RotateMe THEN RotateMe = False ELSE RotateMe = True
    CASE 27     'esc
        GameEndFlag = True
    END SELECT
END SUB


SUB DXscreen_MouseMove (MousX AS INTEGER, MousY AS INTEGER)
    player1_z = CourtZ - (MouseX/DXScreen.Height) * CourtZ * 2
    player1_y = Ceiling - (MouseY/DXScreen.Width * Ceiling)
END SUB



SUB CloseApp
    WorldFrame.DeleteVisual(SkyBox.Mesh)
    WorldFrame.DeleteVisual(FloorObj.Mesh)
    Application.Terminate
END SUB



SUB intro
    CREATE BMP1 AS QBITMAP
        Width = 32
        Height =32
        pixelFormat = pf24Bit
    END CREATE

    CREATE BMP2 AS QBITMAP
        Width = 32
        Height =32
        Font.Size = 24
        Font.AddStyles(fsBold)
        pixelFormat = pf24Bit
        TransparentMode =  tmFixed
        TransparentColor = 0
    END CREATE

    DIM Scalar As INTEGER
    DIM num AS INTEGER
    DIM R AS QRECT

    For num = 1 to 3        'count down
     BMP1.Width = 32: BMP1.Height = 32
     BMP1.FillRect(0, 0, 32, 32, 0)
     BMP2.FillRect(0, 0, 32, 32, 0)
     BMP2.TextOut(5, 2, STR$(num), &HBBFF, -1)
     For Scalar = 10 TO  DXHeight STEP 10
        BMP1.Width = Scalar: BMP1.Height = Scalar
        R.Left = 0 : R.Top = 0
        R.Right = BMP1.Width : R.Bottom = BMP1.Height
        BMP1.StretchDraw(R, BMP2.BMP)
        DXSCREEN.Draw(DXWidth\2 - BMP1.Width\2, DXHeight\2 - BMP1.Height\2, BMP1.BMP)
        DXscreen.Flip
     Next Scalar
     Next Num
END SUB



SUB scoreboard
    DXScreen.TextOut(10, 10, "Player: "+STR$(p2_score) + "     ",&HFFFFFF, 0)' Print Player 1 Score
    DXScreen.TextOut(170, 10, "r to toggle rotation",&HFFFFFF, 0)' Print Player 1 Score
    DXScreen.TextOut(DXScreen.Width-200, 10, "Computer: "+STR$(p1_score) + "     ",&HFFFFFF, 0)' Print Player 2 Score
    DXScreen.Flip
END SUB




SUB Make3DObjects                                   'make the box, floor and paddles
    DXScreen.CreateMeshBuilder(SkyBox.Mesh)         'Reallocate memory
	WITH SkyBox
     .ViewFromOutside = False                   'view from inside, it is a skybox (dome)
     .BoxSides = 4                              'No ceiling
     .MakeBox (DXScreen)
     .Mesh.Scale(CourtX, Ceiling, CourtZ)
'  .Mesh.SetRGBA(1.0, 1.0, 1.0, 0.85)        'sky color
	END WITH
    WorldFrame.AddVisual(SkyBox.Mesh)               'this object moves on top of world

    DXScreen.CreateMeshBuilder(FloorObj.Mesh)
    WITH FloorObj
        .ViewFromOutside = False                'render the inside of the plane only
        .MakeHorizPlane (DXScreen)              'make a horizontal plane
        .Mesh.Scale(CourtX, 0.0, CourtZ)
'       .Mesh.SetRGB(0.2, 0.65, 1.0)            'floor color
'        .Mesh.LoadTexture("c:\rapidq\Ground.bmp")
    END WITH
    WorldFrame.AddVisual(FloorObj.Mesh)             'add Floor to frame, all will rotate/move together now


    DXScreen.CreateMeshBuilder(Paddle1.Mesh)        'hold vertices
    DXScreen.CreateFrame(Paddle1.Frame)             'holds 3d transformation matrix
    WITH Paddle1
       .DrawCenter.y = -1
       .MakeCylinder (DXScreen, 12)
       .Mesh.Scale(1/PaddleThick, 1, 1/PaddleWidth)
       .DrawCenter.y = 0
       .BoxSides = 5                                   'all sides but the floor
       .ViewFromOutside = True                         'view from outside
       .MakeBox (DXScreen)
       .Mesh.Scale(PaddleThick, PaddleHeight, PaddleWidth)
       .Mesh.SetRGB(0.8, 0.0, 1.0)
       .Frame.AddVisual(Paddle1.Mesh)                  'put paddle on its own frame for movement
    END WITH


    DXScreen.CreateMeshBuilder(Paddle2.Mesh)        'hold vertices
    DXScreen.CreateFrame(Paddle2.Frame)             'holds 3d transformation matrix
    WITH Paddle2
        .DrawCenter.y = -1
        .MakeCylinder (DXScreen, 12)
        .Mesh.Scale(1/PaddleThick, 1, 1/PaddleWidth)
        .DrawCenter.y = 0
        .BoxSides = 5
        .ViewFromOutside = True
        .MakeBox (DXScreen)
        .Mesh.Scale(PaddleThick, PaddleHeight, PaddleWidth)
        .Mesh.SetRGB(0.4, 0.9, 0.2)
        .Frame.AddVisual(Paddle2.Mesh)              'put paddle on its own frame for movement
    END WITH


    DXScreen.CreateMeshBuilder(TheBall.Mesh)
    DXScreen.CreateFrame(TheBall.Frame)
    WITH TheBall
        .BoxSides = 6
        .ViewFromOutside = True
'		 .Mesh.Load("ball.x")
        .MakeSphere (DXScreen, 64)
        .Mesh.Scale(BallSize, BallSize, BallSize)
        .Mesh.SetRGB(1.0, 1.0, 1.0)
        .Frame.SetRotation(0.2,0.8, 0.5, 3 * TheSpeed)
        .Frame.AddVisual(TheBall.Mesh)                      'All objects added to the root frame (WorldFrame)
    END WITH
END SUB




SUB RotateCamera
    DIM tmpRadius AS SINGLE

    tmpRadius = Cam.GetXZRadius         'store it, next calculations affect radius
    Cam.Pos.x = Cos(RelX)*tmpRadius     'move position around circle
'   Cam.Pos.y = Cos(RelY)*tmpRadius     'centered at 0,0
    Cam.Pos.z = Sin(RelX)*tmpRadius
    Cam.Orient.y = -0.5 '-Cos(RelY)
    Cam.Orient.x = -Cos(RelX)
    Cam.Orient.z = -Sin(RelX)
    Cam.Update(DXScreen)
    INC(RelX, TheSpeed/20)
    INC(RelY, TheSpeed/20)
END SUB



SUB New_Psychedelic_Background
     DIM Pong_a_delc AS QBITMAP
     DIM MyTexture AS QD3DTexture
     DIM x As INTEGER, y As INTEGER, r As INTEGER, g As INTEGER, b As INTEGER
     DIM Bitsz As INTEGER
     DIM t AS SINGLE

     t = TIMER
     Bitsz = 2^(RND(3) + 2)
     Pong_a_delc.Width = Bitsz
     Pong_a_delc.Height = Bitsz
     Pong_a_delc.Pixelformat = pf24bit

     For x = 0 TO Bitsz
     For y = 0 TO Bitsz
      IF RND(10) > 5 THEN r = 255 ELSE r = 0
      IF RND(10) > 5 THEN g = 255 ELSE g = 0
      IF RND(10) > 5 THEN b = 255 ELSE b = 0
      Pong_a_delc.Pixel(x,y) = RGB(r,g,b)
     Next x
     Next y
     Pong_a_delc.SaveToFile(tmpBMPFile)
     DXScreen.LoadTexture(tmpBMPFile, MyTexture) 'store it on file in order to load it
     SkyBox.Mesh.SetTexture(MyTexture)
     TheBall.Mesh.SetTexture(MyTexture)
     Pong_a_delc.Line(0, Bitsz\2, Bitsz, Bitsz\2, &HFFFFFF)
     Pong_a_delc.Line(Bitsz\2, 0, Bitsz\2, Bitsz, &HFFFFFF)
     Pong_a_delc.SaveToFile(tmpBMPFile)
     DXScreen.LoadTexture(tmpBMPFile, MyTexture) 'store it on file in order to load it
     FloorObj.Mesh.SetTexture(MyTexture)
     KILL tmpBMPFile        'don't need it anymore
     WrapObjects
     DO: LOOP UNTIL ((TIMER - t) > InterPlayDelay)
END SUB



SUB WrapObjects
    DXScreen.createWrap(D3DRMWRAP_FLAT,_    'type of texture projection
            -CourtX, 0, -CourtZ, _        'origin on the mesh coordinates
            0, 1, 0, _                   'the z-axis direction vector - texture projects down the z-azis
            0, 0, 1, _                 'the up vector - the top of the texture points up the y-axis
            0, 0, _                      'origin coordinates on bitmap
            0.5/CourtX, 0.5/CourtZ, wrap)   'scale so bitmap covers all object 1/maxx, 1/maxy
    wrap.apply(FloorObj.Mesh)

    DXScreen.createWrap(D3DRMWRAP_SPHERE,_    'type of texture projection
            0, 0, 0, _          'origin on the mesh coordinates
            0, 1, 0, _          'the z-axis direction vector - texture projects down the z-azis
            0, 0, 1, _          'the up vector - the top of the texture points up the y-axis
            0, 0, _             'origin coordinates on bitmap
            1, 1, wrap)
    wrap.Apply(SkyBox.Mesh)


    DXScreen.createWrap(D3DRMWRAP_CHROME,_    'type of texture projection
            0, 0, 0, _            'origin on the mesh coordinates
            0, 0, 1, _            'the z-axis direction vector - texture projects down the z-azis
            0, 1, 0, _            'the up vector - the top of the texture points up the y-axis
            0, 0, _               'origin coordinates on bitmap
            2, 2, wrap)
    wrap.apply(TheBall.Mesh)

END SUB



SUB ChromeWrapThem  'hmmm not working
	Wrap.ApplyRelative(TheBall.Frame,TheBall.Mesh) 'for each frame
'    wrap.applyRelative(WorldFrame, TheBall.Mesh)
END SUB



SUB MakeParticles
 DIM Face1 AS QD3DFace
 DIM Face2 AS QD3DFace
 DIM Face3 AS QD3DFace
 DIM i AS INTEGER

 DXScreen.CreateFace(Face1)  'create face instance
 Face1.AddVertex(-1, 0, -1): Face1.AddVertex( 1, 0, -1)  'horiz plane
 Face1.AddVertex( 1, 0, 1): Face1.AddVertex(-1, 0, 1)
 Face1.AddVertex(-1, 0, 1): Face1.AddVertex( 1, 0, 1)
 Face1.AddVertex( 1, 0, -1): Face1.AddVertex(-1, 0, -1)
 DXScreen.CreateFace(Face2)
 Face2.AddVertex(0, -1, -1): Face2.AddVertex( 0, 1, -1)  'vert y-z plane
 Face2.AddVertex( 0, 1, 1): Face2.AddVertex(0, -1, 1)
 Face2.AddVertex(0, -1, 1): Face2.AddVertex( 0, 1, 1)
 Face2.AddVertex( 0, 1, -1): Face2.AddVertex(0, -1, -1)
 DXScreen.CreateFace(Face3)
 Face3.AddVertex(-1, -1, 0): Face3.AddVertex( 1, -1, 0)  'horiz plane
 Face3.AddVertex( 1, 1, 0): Face3.AddVertex(-1, 1, 0)
 Face3.AddVertex(-1, 1, 0): Face3.AddVertex( 1, 1, 0)
 Face3.AddVertex( 1, -1, 0): Face3.AddVertex(-1, -1, 0)

 WITH Particles1
  .CloneNum = NumParticles
  '.File = "YourModel.x"  '3D mesh file in binary .x format
  .Range.Left  = -CourtX
  .Range.Top  = -CourtZ
  .Range.Right = CourtX
  .Range.Bottom = CourtZ
  .RandPos = True
  .RandScale = True
  .Init(DXScreen)    'set properties first, creates frames, meshbuilder COM objects
  .Mesh.AddFace(Face1)   'follows init
  .Mesh.AddFace(Face2)   'follows init
  .Mesh.AddFace(Face3)   'follows init
  .Mesh.SetRGBA(1.0, 1.0, 0.0, 0.25)
  .Mesh.Scale(0.5, 0.5, 0.5)
  FOR i = 1 TO .CloneNum
   WorldFrame.AddFrame(Particles1.Frame(i)) 'now particles move with the whole scene
  NEXT i
 END WITH


 'must do this again for the next Particle system
 DXScreen.CreateFace(Face1)  'create face instance
 Face1.AddVertex(-1, 0, -1): Face1.AddVertex( 1, 0, -1)  'horiz plane
 Face1.AddVertex( 1, 0, 1): Face1.AddVertex(-1, 0, 1)
 Face1.AddVertex(-1, 0, 1): Face1.AddVertex( 1, 0, 1)
 Face1.AddVertex( 1, 0, -1): Face1.AddVertex(-1, 0, -1)
 DXScreen.CreateFace(Face2)
 Face2.AddVertex(0, -1, -1): Face2.AddVertex( 0, 1, -1)  'vert y-z plane
 Face2.AddVertex( 0, 1, 1): Face2.AddVertex(0, -1, 1)
 Face2.AddVertex(0, -1, 1): Face2.AddVertex( 0, 1, 1)
 Face2.AddVertex( 0, 1, -1): Face2.AddVertex(0, -1, -1)
 DXScreen.CreateFace(Face3)
 Face3.AddVertex(-1, -1, 0): Face3.AddVertex( 1, -1, 0)  'horiz plane
 Face3.AddVertex( 1, 1, 0): Face3.AddVertex(-1, 1, 0)
 Face3.AddVertex(-1, 1, 0): Face3.AddVertex( 1, 1, 0)
 Face3.AddVertex( 1, -1, 0): Face3.AddVertex(-1, -1, 0)


 WITH Particles2
  .CloneNum = NumParticles
  '.File = "YourModel.x"  '3D mesh file in binary .x format
  .Range.Left  = -CourtX
  .Range.Top  = -CourtZ
  .Range.Right = CourtX
  .Range.Bottom = CourtZ
  .RandPos = True
  .RandScale = True
  .Init(DXScreen)    'set properties first, creates frames, meshbuilder COM objects
  .Mesh.AddFace(Face1)   'follows init
  .Mesh.AddFace(Face2)   'follows init
  .Mesh.AddFace(Face3)   'follows init
  .Mesh.SetRGBA(1.0, 1.0, 1.0, 0.25)
  .Mesh.Scale(0.5, 0.5, 0.5)
  FOR i = 1 TO .CloneNum
   WorldFrame.AddFrame(Particles2.Frame(i))
  NEXT i
 END WITH
END SUB



SUB MoveParticles
 DIM i AS INTEGER

 WITH Particles1
 FOR i = 1 TO .CloneNum
     .Pos(i).x = .Pos(i).x + pSpeed * (RND - 0.5)
   IF .Pos(i).x < -CourtX THEN .Pos(i).x = -CourtX
   IF .Pos(i).x >  CourtX THEN .Pos(i).x =  CourtX
     .Pos(i).y = .Pos(i).y + pSpeed * (RND - 0.5)
   IF .Pos(i).y < 0 THEN .Pos(i).y = 0
   IF .Pos(i).y > Ceiling THEN .Pos(i).y = Ceiling
  .Pos(i).z = .Pos(i).z + pSpeed * (RND - 0.5)
   IF .Pos(i).z < -CourtZ THEN .Pos(i).z = -CourtZ
   IF .Pos(i).z >  CourtZ THEN .Pos(i).z =  CourtZ
  .Frame(i).SetPosition(.Pos(i).x, .Pos(i).y, .Pos(i).z)
 NEXT i

 END WITH

 WITH Particles2
 FOR i = 1 TO .CloneNum
     .Pos(i).x = .Pos(i).x + pSpeed * (RND - 0.5)
   IF .Pos(i).x < -CourtX THEN .Pos(i).x = -CourtX
   IF .Pos(i).x >  CourtX THEN .Pos(i).x =  CourtX
     .Pos(i).y = .Pos(i).y + pSpeed * (RND - 0.5)
   IF .Pos(i).y < 0 THEN .Pos(i).y = 0
   IF .Pos(i).y > Ceiling THEN .Pos(i).y = Ceiling
  .Pos(i).z = .Pos(i).z + pSpeed * (RND - 0.5)
   IF .Pos(i).z < -CourtZ THEN .Pos(i).z = -CourtZ
   IF .Pos(i).z >  CourtZ THEN .Pos(i).z =  CourtZ
  .Frame(i).SetPosition(.Pos(i).x, .Pos(i).y, .Pos(i).z)
 NEXT i
 END WITH
END SUB


MainForm.ShowModal                                          'get the program running

Prev Component

Contents

Next Component