Visual Basic Source Code/Visual Basic Source Code.iso/vbsource/room3d/mmain.bas

BASIC Source File | 1999-05-18 | 48.6 KB | 1,142 lines

Attribute VB_Name = "mMain"
Option Explicit
'Almost all this module (except for buildworld and checkKeys)
'Was taken from Wolfgang Kienreich's Xdemo3D example
'Hardware support code was also fixed for me by Wolfgang.... many, many,
'thanx for that

'Variables for 3d objects in the scene
Global ObjectFrame(1 To 2) As IDirect3DRMFrame2       ' Frame to hold object
Public RMLight(1 To 2) As IDirect3DRMFrame

'Variables holding DDraw and D3DRM instances ...
Public G_oDDInstance As IDirectDraw                 ' Instance of DirectDraw interface
Public G_oD3DInstance As IDirect3DRM                ' Instance of Direct3DRM interface
' Variables for primary D3DRM display system ...
Public RMDevice As IDirect3DRMDevice2           ' Device to use for Direct3DRM operations
Public RMViewport As IDirect3DRMViewPort        ' Viewport for Direct3DRM to display results in
Public RMScene As IDirect3DRMFrame2       ' Top level frame that contains all other frames
Public RMCamera As IDirect3DRMFrame2                ' Frame to contain the camera; The viewport is created from this frame
Public RMDriver As tD3DDriver                   ' Driver for use with Direct3DRM
Public RMDriverExist As Boolean               ' Flag holding presence of driver (equals driver enumeration success)
Public G_dCamPosLookup(359) As D3DVECTOR            ' Lookup table of position values for camera
Public G_nCamPosCurrent As Integer                  ' Current position of camera according to lookup table
Global BufferDC As Long
' Variables for DirectDraw blit system ...
Public G_oDDPrimary As IDirectDrawSurface3          ' Primary DirectDraw surface that is displayed on the form
Public G_oDDBackbuffer As IDirectDrawSurface3       ' Backbuffer DirectDraw surface that is flipped onto the primary
Public G_dDDWindow(0) As tDDWindow                  ' Buffers holding windows for effects

' Various variables ...
Public G_nFrameCount As Long                       ' Global framecounter
Public G_nFrameAvg As Double                       ' Global average frames per second

' Various constants
    Public Const PIFACTOR = 0.0174532

' Types for use with XDemo3D ...
    ' Driver type for enumeration of D3D driver
    Public Type tD3DDriver
      DESC    As String                         ' Driver description
      NAME    As String                         ' Driver name
      GUID    As Byte                           ' Unique interface ID for accessing driver
      GUID1   As Byte                           ' ...
      GUID2   As Byte                           ' ...
      GUID3   As Byte                           ' ...
      GUID4   As Byte                           ' ...
      GUID5   As Byte                           ' ...
      GUID6   As Byte                           ' ...
      GUID7   As Byte                           ' ...
      GUID8   As Byte                           ' ...
      GUID9   As Byte                           ' ...
      GUID10  As Byte                           ' ...
      GUID11  As Byte                           ' ...
      GUID12  As Byte                           ' ...
      GUID13  As Byte                           ' ...
      GUID14  As Byte                           ' ...
      GUID15  As Byte                           ' ...
      DEVDESC As D3DDEVICEDESC                  ' Device description for use by D3DRM
      HDW     As Boolean                        ' Device is hardware
      EMU     As Boolean                        ' Device is software-emulated
      RGB     As Boolean                        ' Device has rgb caps
      MONO    As Boolean                        ' Device has mono ramp caps
    End Type
    ' Viewport window for scrolling effects windows
    Public Type tDDWindow
        nX As Integer
        nY As Integer
        nDX As Integer
        nDY As Integer
        oDDSurface As IDirectDrawSurface3
        dRenderArea As RECT
    End Type
    Global PickInfo As String
' APPERROR: Reports application errors and terminates application properly
Public Sub AppError(nNumber As Long, sText As String, sSource As String)

    ' Enable error handling
    On Error Resume Next

    ' Cleanup
    Call AppTerminate

    ' Display error
    MsgBox "ERROR: " & IIf(InStr(1, UCase(sText), "AUTOM") > 0, "DirectX reports '" & GetDXError(nNumber) & "'", " Application reports '" & sText & "'") & vbCrLf & "SOURCE: " & sSource, vbCritical + vbOKOnly, "XDEMO3D"
    ' Terminate program
    End
End Sub
Public Sub AppInitialize() 'Startup of program
    ' Enable error handling
        On Error GoTo E_AppInitialize

    ' Setup local variables...

        Dim L_dDDSD As DDSURFACEDESC           ' Utility surface description
        Dim L_dDDSC As DDSCAPS                 ' Utility display capabilities description
        Dim L_oD3DIM As IDirect3D2             ' Utility Direct3DIM interface for retrieving drivers
        Dim L_dDDCK As DDCOLORKEY              ' Color key for applying to various surfaces

    ' Initialize DirectDraw interface instance ...
        ' Create DirectDraw instance
        DirectDrawCreate ByVal 0&, G_oDDInstance, Nothing

        ' Check instance existance, terminate if missing
        If G_oDDInstance Is Nothing Then
           AppError 0, "Could not create DirectDraw instance", "AppInitialize"
           Exit Sub
        End If

        ' Set cooperation mode of DirectX
        G_oDDInstance.SetCooperativeLevel fMain.hWnd, DDSCL_EXCLUSIVE Or DDSCL_FULLSCREEN

        ' Set display mode
        G_oDDInstance.SetDisplayMode 640, 480, 16
        ' Initialize primary surface description
        With L_dDDSD
            ' Get Structure size
            .dwSize = Len(L_dDDSD)
            ' Structure uses Surface Caps and count of BackBuffers
            .dwFlags = DDSD_CAPS Or DDSD_BACKBUFFERCOUNT
            ' Structure describes a flippable (buffered) surface
            .DDSCAPS.dwCaps = DDSCAPS_PRIMARYSURFACE Or DDSCAPS_FLIP Or DDSCAPS_COMPLEX Or DDSCAPS_SYSTEMMEMORY
            ' Structure uses one BackBuffer
            .dwBackBufferCount = 1
         End With

        ' Create primary surface from structure
        G_oDDInstance.CreateSurface L_dDDSD, G_oDDPrimary, Nothing

        ' Check primary existance, terminate if missing
        If G_oDDPrimary Is Nothing Then
           AppError 0, "Could not create primary surface", "AppInitialize"
           Exit Sub
        End If

    ' Initialize backbuffer from primary ...

        ' Set surface description to backbuffer creation
        L_dDDSD.dwFlags = DDSD_CAPS
        L_dDDSD.DDSCAPS.dwCaps = DDSCAPS_BACKBUFFER

        ' Create backbuffer from frontbuffer
        G_oDDPrimary.GetAttachedSurface L_dDDSD.DDSCAPS, G_oDDBackbuffer
        ' Check backbuffer existance, terminate if missing
        If G_oDDBackbuffer Is Nothing Then
           AppError 0, "Could not create backbuffer", "AppInitialize"
           Exit Sub
        End If


    ' Initialize windows for displaying various effects
        Call CreateWindows

    ' Initialize Direct3DRM interface instance ...

        ' Create Direct3DRM instance
        Direct3DRMCreate G_oD3DInstance

        ' Check instance existance, terminate if missing
        If G_oD3DInstance Is Nothing Then
           AppError 0, "Could not create D3DRM instance", "AppInitialize"
           Exit Sub
        End If

    ' Initialize Direct3DRM driver ...

        ' Get a Direct3D immediate object from the existing DirectDraw object
        Set L_oD3DIM = G_oDDInstance

        ' Set error handler to local for enumeration only
        On Error Resume Next

        ' Start the callback that does the driver enumeration
        L_oD3DIM.EnumDevices AddressOf EnumDeviceCallback, 0

        ' Catch any error resulting from the enumeration and terminate
        If err.Number > 0 Then
           AppError err.Number, err.Description, "AppInitialize"
           Exit Sub
        End If

        ' Reset error handler to default
        On Error GoTo E_AppInitialize

        ' Reset Direct3D immediate object
        Set L_oD3DIM = Nothing

    ' Initialize D3DRM display system

        ' Create a D3DRM device from the 3D buffer
        G_oD3DInstance.CreateDeviceFromSurface G_dD3DSelectedDriver.GUID, G_oDDInstance, G_dDDWindow(0).oDDSurface, RMDevice

        ' Check device existance, terminate if missing
        If RMDevice Is Nothing Then
           AppError 0, "Could not create D3DRM device", "AppInitialize"
           Exit Sub
        End If

        ' Set D3DRM device quality
        RMDevice.SetQuality D3DRMLIGHT_ON Or D3DRMFILL_SOLID Or D3DRMSHADE_PHONG
        ' Create the master frame containing all other frames
        G_oD3DInstance.CreateFrame Nothing, RMScene
        ' Create the camera frame containing the primary camera
        G_oD3DInstance.CreateFrame RMScene, RMCamera
        ' Create a D3D viewport from the device, using the camera frame for output
        G_oD3DInstance.CreateViewport RMDevice, RMCamera, 0, 0, 640, 480, RMViewport

        ' Check viewport existance, terminate if missing
        If RMViewport Is Nothing Then
           AppError 0, "Could not create D3DRM viewport", "AppInitialize"
           Exit Sub
        End If

        ' Initialize scene and display settings ...
        Call CreateScene
        ' Create scene from 3DSE mesh
        Call BuildWorld
        'Apply object to objectbuilder
        Call AddObjects
        Call AddLights
        RMDevice.SetDither 0
        Exit Sub
E_AppInitialize:
        AppError err.Number, err.Description, "AppInitialize"
End Sub
Public Sub AppLoop() 'Contains MASTER LOOP for doing all stuff

    ' Enable error handling
        On Error GoTo E_AppLoop

    ' Setup local variables...
        Dim L_nNextFrameTime As Long        ' Timer used to time frames to a minimum duration
        Dim L_nFrameCount As Long           ' Frame counter used for calculating average framerate
        Dim L_nNextSecond As Long           ' TimeGetTime value above which next second begins
        Dim L_nCurrentTime As Long          ' Time at start of frame, to avoid multiple calls of TimeGetTime
        Dim L_dRenderArea As RECT           ' Rectangle to describe render area for blitting
        Dim L_dDDBLTFX As DDBLTFX           ' Holds F/X settings for blitting

        ' Prepare BLTFX structure for color fill blit to clear backbuffer
        With L_dDDBLTFX
            .dwSize = Len(L_dDDBLTFX)
            .dwFillColor = 0
        End With

    ' Master loop controlling application behavior...
        Do
            ' Do frame timing and statistics ...
                ' Increase global frame counter
                G_nFrameCount = G_nFrameCount + 1

                ' Get frame start time
                L_nCurrentTime = timeGetTime

                ' Increase frame count for avg frametime calculation
                L_nFrameCount = L_nFrameCount + 1

                ' Protocol frame time: Count frames and write out average frame count every second
                If L_nNextSecond < L_nCurrentTime Then
                    G_nFrameAvg = (G_nFrameAvg + L_nFrameCount) / 2
                    L_nNextSecond = L_nCurrentTime + 1000
                    L_nFrameCount = 0
                End If

                ' Prepare timing: Set next frame time to current time plus minimum frame duration (15fps , makes for ~60ms)
                L_nNextFrameTime = L_nCurrentTime + 50

                ' Query user input

            ' Clear backbuffer ...

                ' FX-Blit filling background with black
                With L_dRenderArea
                    .Top = 0
                    .Left = 0
                    .Bottom = 480
                    .Right = 640
                End With
                G_oDDBackbuffer.Blt L_dRenderArea, ByVal Nothing, ByVal 0&, DDBLT_COLORFILL, L_dDDBLTFX

            ' Check keyboard for movement
            Call CheckKeyboard
            ' Check Mouse for firing
            Call CheckMouse
            ' Text Output Procedures
            Call TextOutput("Direct3DRM Room Demo " & PickInfo, 0, 10)
            ' Do updating for D3DRM scene ...
            Call UpdateScene
            ' Update display system ...
            Call UpdateWindows

            ' Flip DirectX buffers...
            G_oDDPrimary.Flip Nothing, 0

            'Uses a set speed (in case FPS is too high, yeah right)
            Do
            Loop Until timeGetTime > L_nNextFrameTime

        Loop

    ' Error handling ...

        Exit Sub

E_AppLoop:
        ' Resume to ignore the weird math errors Direct3DRM reports from time to time
        Resume Next
End Sub
Public Sub AppTerminate() 'exit program and shut down directx to avoid crashing
    ' Enable error handling...
        On Error GoTo E_AppTerminate

    ' Setup local variables ...
        Dim L_nRun As Integer             ' Variable to run through various array data

    ' Return control from DirectX to windows ...

        ' Restore old resolution and depth
        G_oDDInstance.RestoreDisplayMode

        ' Return control to windows
        G_oDDInstance.SetCooperativeLevel fMain.hWnd, DDSCL_NORMAL

    ' Reset DirectX objects ...

        ' D3DRM display system ...

            Set RMCamera = Nothing
            Set RMScene = Nothing
            Set RMViewport = Nothing
            Set RMDevice = Nothing

        ' Object Builders

            Set ObjectFrame(1) = Nothing
            Set ObjectFrame(2) = Nothing

        ' DD Display system ...

            Set G_oDDBackbuffer = Nothing
            Set G_oDDPrimary = Nothing

        ' DD Windows ...

            For L_nRun = 0 To 4
                Set G_dDDWindow(L_nRun).oDDSurface = Nothing
            Next

        ' DirectX interfaces ...

            Set G_oDDInstance = Nothing
            Set G_oD3DInstance = Nothing

        ' Dinput Keyboard

            Set Keyboarddevice2 = Nothing

    ' Error handling ...

        Exit Sub

E_AppTerminate:
        ' Resume to ensure that all objects available are cleaned up
        Resume Next
End Sub
Private Sub CreateScene() 'creates 3d scene

    ' Enable error handling...
        On Error GoTo E_CreateScene

    ' Setup local variables ...
        Dim L_oD3DLight As IDirect3DRMLight     ' Variable for light creating
        Dim L_nRun As Single                    ' Variable to run through arrays
        Dim L_dDDCK As DDCOLORKEY               ' Color key for making status display transparent

    ' Initialize scenario settings ...

        ' Create position lookup table for camera
        For L_nRun = 0 To 179
            With G_dCamPosLookup(L_nRun)
                .z = 5
                .X = 11 + Sin((L_nRun * 2) * PIFACTOR) * 7.8
                .Y = 10.5 + Cos((L_nRun * 2) * PIFACTOR) * 7.8
            End With
        Next

        ' Set the projection model and properties for the viewport
        With RMViewport
            .SetProjection D3DRMPROJECT_PERSPECTIVE
            .SetBack 20
            .SetFront 1
            .SetUniformScaling 1
        End With

        ' Set the scene properties (fog, backcolor)
        With RMScene
            .SetSceneBackgroundRGB 0, 0, 0
        End With

        ' Create ambient light
        G_oD3DInstance.CreateLightRGB D3DRMLIGHT_AMBIENT, 0.3, 0.3, 0.3, L_oD3DLight
        RMScene.AddLight L_oD3DLight
        Set L_oD3DLight = Nothing

    ' Error handling ...

        Exit Sub

E_CreateScene:
        AppError err.Number, err.Description, "CreateScene"
        Exit Sub
End Sub
Private Sub CreateWindows() 'creates windowed views

    ' Enable error handling...
        On Error GoTo E_CreateWindows

    ' Setup local variables ...
    Dim L_dDDCK As DDCOLORKEY

    L_dDDCK.dwColorSpaceHighValue = 0
    L_dDDCK.dwColorSpaceLowValue = 0

    ' Initialize threed buffer surface ...

        With G_dDDWindow(0)

            ' Create surface capable of being a 3d device
            Set .oDDSurface = MakeDXSurface(640, 480, True)

             ' Set color key to enable transparent blits
            .oDDSurface.SetColorKey DDCKEY_SRCBLT, L_dDDCK

            ' Set render area
            .dRenderArea.Top = 0
            .dRenderArea.Left = 0
            .dRenderArea.Bottom = 480
            .dRenderArea.Right = 640

            ' Set initial position and motion
            .nX = 0
            .nY = 0
            .nDX = 2
            .nDY = -2

        End With
        Exit Sub
E_CreateWindows:
    AppError err.Number, err.Description, "CreateWindows"
End Sub
Private Sub UpdateWindows() 'updates all windowed viewports (3d scene, logo)
    'Exit Sub
    ' Enable error handling ...

        On Error GoTo E_UpdateWindows

    ' Setup local variables ...

        Dim L_nRunWindows As Integer      ' Variable to run through all windows

    ' Update all windows that are activated ...
            With G_dDDWindow(0)
                ' Redraw window contents
                If Not (G_dDDWindow(L_nRunWindows).oDDSurface Is Nothing) Then
                    G_oDDBackbuffer.BltFast .nX, .nY, .oDDSurface, .dRenderArea, DDBLTFAST_SRCCOLORKEY
                End If
            End With

    ' Error handler ...
        Exit Sub

E_UpdateWindows:
        AppError err.Number, err.Description, "UpdateWindows"
End Sub
Private Sub UpdateScene() 'updates 3d scene
'    Exit Sub
    ' Enable error handling ...

On Error GoTo E_UpdateScene

    ' Setup local variables ...

        ' Update D3DRM model
        G_oD3DInstance.Tick 1

    ' Error handler ...
        Exit Sub

E_UpdateScene:
        AppError err.Number, err.Description, "UpdateScene"
End Sub
Public Sub Restore()
    'If problems, breaking, selecting CTRL+G, and typing restore should fix then
    Call AppTerminate
    End
End Sub
Public Sub CheckKeyboard()
    Dim MoveVelocity As Single
    Dim ThetaFactor As Single
    Dim SinTheta As Single
    Dim CosTheta As Single
    Dim Strafe As Byte 'Byte takes less memory than boolean
    Dim OldPos As D3DVECTOR
    Dim NewFrame As IDirect3DRMFrame
    Dim LookFrame As IDirect3DRMFrame

    'Make position Check frames
    G_oD3DInstance.CreateFrame RMScene, NewFrame
    G_oD3DInstance.CreateFrame RMScene, LookFrame

    'Get Position of camera BEFORE move
    RMCamera.GetPosition RMScene, OldPos

    'Set as position for LookFrame
    LookFrame.SetPosition RMScene, OldPos.X, OldPos.Y, OldPos.z

    'Acquire Keyboard State
    Keyboarddevice2.Acquire
    Keyboarddevice2.GetDeviceState 256, KeyboardState(0)

    If (KeyboardState(DIK_LCONTROL) And &H80) <> 0 Or (KeyboardState(DIK_RCONTROL) And &H80) <> 0 Then
        Strafe = 1
    Else
        Strafe = 0
    End If
    If (KeyboardState(DIK_LSHIFT) And &H80) <> 0 Or (KeyboardState(DIK_RSHIFT) And &H80) <> 0 Then
        MoveVelocity = 0.3
        ThetaFactor = 0.01745329252
        SinTheta = 0.0871557!      ' Sin(5░)
        CosTheta = 0.9961946!         ' Cos(5░)
    Else
        MoveVelocity = 0.1
        ThetaFactor = 0.008725
        SinTheta = 0.0348995!      ' Sin(2░)
        CosTheta = 0.9993908!         ' Cos(2░)
    End If
    'Movement
    If (KeyboardState(DIK_ESCAPE) And &H80) <> 0 Then
        Call AppTerminate
        End
    ElseIf (KeyboardState(DIK_LEFT) And &H80) <> 0 Then
        If Strafe = 0 Then
            RMCamera.SetOrientation RMCamera, -SinTheta, 0, CosTheta, 0, 1, 0
        Else
            RMCamera.AddTranslation D3DRMCOMBINE_BEFORE, -MoveVelocity, 0, 0
        End If
    ElseIf (KeyboardState(DIK_RIGHT) And &H80) <> 0 Then
        If Strafe = 0 Then
            RMCamera.SetOrientation RMCamera, SinTheta, 0, CosTheta, 0, 1, 0
        Else
            RMCamera.AddTranslation D3DRMCOMBINE_BEFORE, MoveVelocity, 0, 0
        End If
    End If
    If (KeyboardState(DIK_UP) And &H80) <> 0 Then
        RMCamera.AddTranslation D3DRMCOMBINE_BEFORE, 0, 0, MoveVelocity '1
    ElseIf (KeyboardState(DIK_DOWN) And &H80) <> 0 Then
        RMCamera.AddTranslation D3DRMCOMBINE_BEFORE, 0, 0, -MoveVelocity '-1
    End If
    If (KeyboardState(DIK_S) And &H80) <> 0 Then
        RMCamera.AddRotation D3DRMCOMBINE_BEFORE, 1, 0, 0, -(ThetaFactor)
    ElseIf (KeyboardState(DIK_X) And &H80) <> 0 Then
        RMCamera.AddRotation D3DRMCOMBINE_BEFORE, 1, 0, 0, (ThetaFactor)
    End If
    If (KeyboardState(DIK_A) And &H80) <> 0 Then
        RMCamera.AddTranslation D3DRMCOMBINE_BEFORE, 0, MoveVelocity, 0 '0,1,0
    ElseIf (KeyboardState(DIK_Z) And &H80) <> 0 Then
        RMCamera.AddTranslation D3DRMCOMBINE_BEFORE, 0, -MoveVelocity, 0 '0,-1,0
    End If
    If (KeyboardState(DIK_END) And &H80) <> 0 Then
        RMCamera.SetOrientation RMScene, 0, 0, 1, 0, 1, 0
    End If
    Dim CamPos As D3DVECTOR
    Dim CamDir As D3DVECTOR, CamUp As D3DVECTOR
    Dim CameraRay As D3DRMRAY
    Dim ReturnVis As IDirect3DRMPicked2Array
    Dim PickSize As Long
    RMCamera.GetPosition RMScene, CamPos
    NewFrame.SetPosition RMScene, CamPos.X, CamPos.Y, CamPos.z
    LookFrame.LookAt NewFrame, RMScene, D3DRMCONSTRAIN_X
    LookFrame.LookAt NewFrame, RMScene, D3DRMCONSTRAIN_Y
    'RMCamera.GetOrientation RMScene, CamDir, CamUp
    'Use lookframe instead of camera to track backwards, etc moves
    LookFrame.GetOrientation RMScene, CamDir, CamUp
    CameraRay.dvPos = CamPos
    CameraRay.dvDir = CamDir
    RMScene.RayPick RMScene, CameraRay, 0, ReturnVis

    PickSize = ReturnVis.GetSize
    If PickSize < 1 Then
        RMCamera.SetPosition RMScene, OldPos.X, OldPos.Y, OldPos.z
        'PickInfo = ""
        Exit Sub
    End If
    'PickInfo = "- Picked " & PickSize & " points"

    Set NewFrame = Nothing
    Set LookFrame = Nothing

End Sub
Public Sub BuildWorld()
    Dim n As Long, n1 As Long, n2 As Long
    Dim aVertices(0 To 19) As D3DVECTOR
    Dim aFaces(1 To 26) As Long
    Dim aNormals(0) As D3DVECTOR
    Dim d3dRMmeshbuilder As IDirect3DRMMeshBuilder2    ' Meshbuilder to hold created faces
    Dim Face3d As IDirect3DRMFace
    Dim FaceArray As IDirect3DRMFaceArray
    Dim Texture As IDirect3DRMTexture
    Dim ThisTex As String
    Dim Vert As D3DVECTOR
    'These are all the vertices that make up the faces
    aVertices(0).X = -2:     aVertices(0).Y = 0:     aVertices(0).z = 5
    aVertices(1).X = -2:     aVertices(1).Y = 3:     aVertices(1).z = 5
    aVertices(2).X = 2:      aVertices(2).Y = 3:     aVertices(2).z = 5
    aVertices(3).X = 2:     aVertices(3).Y = 0:     aVertices(3).z = 5

    aVertices(4).X = -2:    aVertices(4).Y = 0:    aVertices(4).z = -5
    aVertices(5).X = -2:    aVertices(5).Y = 3:    aVertices(5).z = -5
    aVertices(6).X = 2:    aVertices(6).Y = 3:    aVertices(6).z = -5
    aVertices(7).X = 2:    aVertices(7).Y = 0:    aVertices(7).z = -5

    aVertices(8).X = 2:    aVertices(8).Y = 3:    aVertices(8).z = -5
    aVertices(9).X = 2:    aVertices(9).Y = 3:    aVertices(9).z = 5
    aVertices(10).X = 2:    aVertices(10).Y = 0:    aVertices(10).z = 5
    aVertices(11).X = 2:    aVertices(11).Y = 0:    aVertices(11).z = -5

    aVertices(12).X = -2:    aVertices(12).Y = 3:    aVertices(12).z = -5
    aVertices(13).X = -2:    aVertices(13).Y = 3:    aVertices(13).z = 5
    aVertices(14).X = -2:    aVertices(14).Y = 0:    aVertices(14).z = 5
    aVertices(15).X = -2:    aVertices(15).Y = 0:    aVertices(15).z = -5

    aVertices(16).X = -2:    aVertices(16).Y = 0:    aVertices(16).z = -5
    aVertices(17).X = 2:    aVertices(17).Y = 0:    aVertices(17).z = -5
    aVertices(18).X = 2:    aVertices(18).Y = 0:    aVertices(18).z = 5
    aVertices(19).X = -2:    aVertices(19).Y = 0:    aVertices(19).z = 5

    'Front Wall, Face #0
    aFaces(1) = 4 '4 Vertices in face
    aFaces(2) = 0
    aFaces(3) = 1
    aFaces(4) = 2
    aFaces(5) = 3
    'Back wall, Face #1  (vertices in reverse order, order determines which side of face is visible)
    aFaces(6) = 4 '4 Vertices in face
    aFaces(7) = 7
    aFaces(8) = 6
    aFaces(9) = 5
    aFaces(10) = 4
    'Left Wall, Face #2
    aFaces(11) = 4 '4 Vertices in face
    aFaces(12) = 12
    aFaces(13) = 13
    aFaces(14) = 14
    aFaces(15) = 15
    'Right Wall, Face #3
    aFaces(16) = 4 '4 Vertices in face
    aFaces(17) = 11
    aFaces(18) = 10
    aFaces(19) = 9
    aFaces(20) = 8
    'Floor, Face #4
    aFaces(21) = 4 '4 Vertices in face
    aFaces(22) = 19
    aFaces(23) = 18
    aFaces(24) = 17
    aFaces(25) = 16
    'Ceiling, Face #5
    aFaces(26) = 0

    ' Initialize meshbuilder
    G_oD3DInstance.CreateMeshBuilder d3dRMmeshbuilder

    d3dRMmeshbuilder.AddFaces 20, aVertices(0), 0, aNormals(0), aFaces(1), Nothing
    d3dRMmeshbuilder.SetPerspective 1

    d3dRMmeshbuilder.GetFace 0, Face3d
        Face3d.SetColorRGB 1!, 0, 0
    d3dRMmeshbuilder.GetFace 1, Face3d
        Face3d.SetColorRGB 0, 0, 1!
    'Load Texture
        ThisTex = App.Path & "\textures\bricks.bmp"
        G_oD3DInstance.LoadTexture ThisTex, Texture
    d3dRMmeshbuilder.GetFace 2, Face3d
        Face3d.SetTexture Texture
        'Texture Coordinates (Vertex, Horizontal stretch to vertex, vertical stretch to vertex)
        Face3d.SetTextureCoordinates 0, 0, 5
        Face3d.SetTextureCoordinates 1, 25, 5
        Face3d.SetTextureCoordinates 2, 25, 0
        Face3d.SetTextureCoordinates 3, 0, 0
    d3dRMmeshbuilder.GetFace 3, Face3d
        Face3d.SetTexture Texture
        'Texture Coordinates (Vertex, Horizontal stretch to vertex, vertical stretch to vertex)
        Face3d.SetTextureCoordinates 0, 0, 5
        Face3d.SetTextureCoordinates 1, 25, 5
        Face3d.SetTextureCoordinates 2, 25, 0
        Face3d.SetTextureCoordinates 3, 0, 0
    'Load Texture
        ThisTex = App.Path & "\textures\floor.bmp"
        G_oD3DInstance.LoadTexture ThisTex, Texture
    d3dRMmeshbuilder.GetFace 4, Face3d
        Face3d.SetTexture Texture
        'Texture Coordinates (Vertex, Horizontal stretch to vertex, vertical stretch to vertex)
        Face3d.SetTextureCoordinates 0, 0, 25
        Face3d.SetTextureCoordinates 1, 25, 25
        Face3d.SetTextureCoordinates 2, 25, 0
        Face3d.SetTextureCoordinates 3, 0, 0
RenderView:
    RMCamera.SetPosition RMScene, 0.5!, 0.5!, 0
    RMScene.AddVisual d3dRMmeshbuilder

    'Create BackGround Surface

    'Assign an Image to the scene's Background
    ThisTex = App.Path & "\textures\background.bmp"
    G_oD3DInstance.LoadTexture ThisTex, Texture
    RMScene.SetSceneBackgroundImage Texture
    '----------unload unneeded stuff------------'
    Set Face3d = Nothing
    Set Texture = Nothing
    Exit Sub
GenScene_Err:
    On Error GoTo 0
    Debug.Print "GenScene Err... Source:" & err.source & "Description:" & err.Description
    Exit Sub
End Sub

Public Function LoadBitmapIntoDXS(ByVal sFileName As String) As IDirectDrawSurface3

    ' Enable error handling ...
        On Error GoTo E_LoadBitmapIntoDXS

    ' Setup local variables ...

        Dim L_nBMBitmap As Long               ' Handle on bitmap
        Dim L_nDCBitmap As Long               ' Handle on dc of bitmap
        Dim L_dBitmap As BITMAP               ' Bitmap descriptor
        Dim L_dDXD As DDSURFACEDESC           ' Surface descriptor
        Dim L_nDCDXS As Long                  ' Handle on dc of surface
        Dim L_oDDSTemp As IDirectDrawSurface3 ' Temporary DD surface

    ' Load bitmap into surface ...

        ' Load bitmap
        L_nBMBitmap = LoadImage(ByVal 0&, sFileName, 0, 0, 0, LR_LOADFROMFILE Or LR_CREATEDIBSECTION)

        ' Check for validity of bitmap handle
        If L_nBMBitmap < 1 Then
            AppError 0, "Bitmap could not be loaded", "LoadBitmapIntoDXS"
            Exit Function
        End If

        ' Get bitmap descriptor
        GetObject L_nBMBitmap, Len(L_dBitmap), L_dBitmap

        ' Fill DX surface description
        With L_dDXD
            .dwSize = Len(L_dDXD)
            .dwFlags = DDSD_CAPS Or DDSD_HEIGHT Or DDSD_WIDTH
            .DDSCAPS.dwCaps = DDSCAPS_OFFSCREENPLAIN
            .dwWidth = L_dBitmap.bmWidth
            .dwHeight = L_dBitmap.bmHeight
        End With

        ' Create DX surface
        G_oDDInstance.CreateSurface L_dDXD, L_oDDSTemp, Nothing

        ' Check surface existance
        If L_oDDSTemp Is Nothing Then
            AppError 0, "Surface could not be created", "LoadBitmapIntoDXS"
            Exit Function
        End If

        ' Create API memory DC
        L_nDCBitmap = CreateCompatibleDC(ByVal 0&)

        ' Select the bitmap into API memory DC
        SelectObject L_nDCBitmap, L_nBMBitmap

        ' Restore DX surface
        L_oDDSTemp.Restore

        ' Get DX surface API DC
        L_oDDSTemp.GetDC L_nDCDXS

        ' Blit BMP from API DC into DX DC using standard API BitBlt
        StretchBlt L_nDCDXS, 0, 0, L_dDXD.dwWidth, L_dDXD.dwHeight, L_nDCBitmap, 0, 0, L_dBitmap.bmWidth, L_dBitmap.bmHeight, SRCCOPY

        ' Cleanup
        L_oDDSTemp.ReleaseDC L_nDCDXS
        DeleteDC L_nDCBitmap
        DeleteObject L_nBMBitmap

        ' Return success
        Set LoadBitmapIntoDXS = L_oDDSTemp

        ' Cleanup
        Set L_oDDSTemp = Nothing

    ' Error handler ...

        Exit Function

E_LoadBitmapIntoDXS:

        AppError err.Number, err.Description, "LoadBitmapIntoDXS"

End Function

Public Function MakeDXSurface(ByVal nWidth As Integer, ByVal nHeight As Integer, Optional bIs3D As Boolean) As IDirectDrawSurface3

    ' Enable error handling ...

        On Error GoTo E_MakeDXSurface

    ' Setup local variables ...

        Dim L_dDXD As DDSURFACEDESC    ' Variable holding temporary surface description

    ' Create surface ...

        ' Fill surface description
        With L_dDXD
           .dwSize = Len(L_dDXD)
           .dwFlags = DDSD_CAPS Or DDSD_HEIGHT Or DDSD_WIDTH
           .DDSCAPS.dwCaps = DDSCAPS_OFFSCREENPLAIN Or DDSCAPS_VIDEOMEMORY Or IIf(bIs3D, DDSCAPS_3DDEVICE, 0)
           .dwWidth = nWidth
           .dwHeight = nHeight
        End With

        ' Create surface from description
        G_oDDInstance.CreateSurface L_dDXD, MakeDXSurface, Nothing

        ' Check for existance of surface
        If MakeDXSurface Is Nothing Then
           AppError 0, "Surface could not be created", "MakeDXSurface"
           Exit Function
        End If

    ' Error handler ...
        Exit Function

E_MakeDXSurface:

        AppError err.Number, err.Description, "MakeDXSurface"

End Function

Public Function GetDXError(nError As Long) As String

    Select Case nError
        Case DDERR_DCALREADYCREATED
            GetDXError = "A device context (DC) has already been returned for this surface. Only one DC can be retrieved for each surface."
        Case DDERR_DIRECTDRAWALREADYCREATED
            GetDXError = "A IDirectDraw object representing this driver has already been created for this process."
        Case DDERR_EXCEPTION
            GetDXError = "An exception was encountered while performing the requested operation."
        Case DDERR_EXCLUSIVEMODEALREADYSET
            GetDXError = "An attempt was made to set the cooperative level when it was already set to exclusive."
        Case DDERR_HEIGHTALIGN
            GetDXError = "The height of the provided rectangle is not a multiple of the required alignment."
        Case DDERR_HWNDALREADYSET
            GetDXError = "The IDirectDraw cooperative level window handle has already been set. It cannot be reset while the process has surfaces or palettes created."
        Case DDERR_HWNDSUBCLASSED
            GetDXError = "IDirectDraw is prevented from restoring state because the IDirectDraw cooperative level window handle has been subclassed."
        Case DDERR_ALREADYINITIALIZED
            GetDXError = "The object has already been initialized."
        Case DDERR_BLTFASTCANTCLIP
            GetDXError = "A IDirectDrawClipper object is attached to a source surface that has passed into a call to the IDirectDrawSurface2::BltFast method."
        Case DDERR_CANNOTATTACHSURFACE
            GetDXError = "A surface cannot be attached to another requested surface."
        Case DDERR_CANNOTDETACHSURFACE
            GetDXError = "A surface cannot be detached from another requested surface."
        Case DDERR_CANTCREATEDC
            GetDXError = "Windows cannot create any more device contexts (DCs)."
        Case DDERR_CANTDUPLICATE
            GetDXError = "Primary and 3D surfaces, or surfaces that are implicitly created, cannot be duplicated."
        Case DDERR_CANTLOCKSURFACE
            GetDXError = "Access to this surface is refused because an att    empt was made to lock the primary surface without DCI support."
        Case DDERR_CANTPAGELOCK
            GetDXError = "An attempt to page lock a surface failed. Page lock will not work on a display-m    emory surface or an     emulated primary surface."
        Case DDERR_CANTPAGEUNLOCK
            GetDXError = "An attempt to page unlock a surface failed. Page unlock will not work on a display-m    emory surface or an     emulated primary surface."
        Case DDERR_CLIPPERISUSINGHWND
            GetDXError = "An attempt was made to set a clip list for a IDirectDrawClipper object that is already monitoring a window handle."
        Case DDERR_COLORKEYNOTSET
            GetDXError = "No source color key is specified for this operation."
        Case DDERR_CURRENTLYNOTAVAIL
            GetDXError = "No support is currently available."
        Case DDERR_IMPLICITLYCREATED
            GetDXError = "The surface cannot be restored because it is an implicitly created surface."
        Case DDERR_INCOMPATIBLEPRIMARY
            GetDXError = "The primary surface creation request does not match with the existing primary surface."
        Case DDERR_INVALIDCAPS
            GetDXError = "One or more of the capability bits passed to the callback function are incorrect."
        Case DDERR_INVALIDCLIPLIST
            GetDXError = "IDirectDraw does not support the provided clip list."
        Case DDERR_INVALIDDIRECTDRAWGUID
            GetDXError = "The globally unique identifier (GUID) passed to the IDirectDrawCreate function is not a valid IDirectDraw driver identifier."
        Case DDERR_INVALIDMODE
            GetDXError = "IDirectDraw does not support the requested mode."
        Case DDERR_INVALIDOBJECT
            GetDXError = "IDirectDraw received a pointer that was an invalid IDirectDraw object."
        Case DDERR_INVALIDPIXELFORMAT
            GetDXError = "The pixel format was invalid as specified."
        Case DDERR_INVALIDPOSITION
            GetDXError = "The position of the overlay on the destination is no longer legal."
        Case DDERR_INVALIDRECT
            GetDXError = "The provided rectangle was invalid."
        Case DDERR_INVALIDSURFACETYPE
            GetDXError = "The requested operation could not be performed because the surface was of the wrong type."
        Case DDERR_LOCKEDSURFACES
            GetDXError = "One or more surfaces are locked, causing the failure of the requested operation."
        Case DDERR_NO3D
            GetDXError = "No 3D hardware or emulation is present."
        Case DDERR_NOALPHAHW
            GetDXError = "No alpha acceleration hardware is present or available, causing the failure of the requested operation."
        Case DDERR_NOBLTHW
            GetDXError = "No blitter hardware is present."
        Case DDERR_NOCLIPLIST
            GetDXError = "No clip list is available."
        Case DDERR_NOCLIPPERATTACHED
            GetDXError = "No IDirectDrawClipper object is attached to the surface object."
        Case DDERR_NOCOLORCONVHW
            GetDXError = "The operation cannot be carried out because no color-conversion hardware is present or available."
        Case DDERR_NOCOLORKEY
            GetDXError = "The surface does not currently have a color key."
        Case DDERR_NOCOLORKEYHW
            GetDXError = "The operation cannot be carried out because there is no hardware support for the destination color key."
        Case DDERR_NOCOOPERATIVELEVELSET
            GetDXError = "A create function is called without the IDirectDraw2::SetCooperativeLevel method being called."
        Case DDERR_NODC
            GetDXError = "No DC has ever been created for this surface."
        Case DDERR_NODDROPSHW
            GetDXError = "No IDirectDraw raster operation (ROP) hardware is available."
        Case DDERR_NODIRECTDRAWHW
            GetDXError = "Hardware-only IDirectDraw object creation is not possible; the driver does not support any hardware."
        Case DDERR_NODIRECTDRAWSUPPORT
            GetDXError = "IDirectDraw support is not possible with the current display driver."
        Case DDERR_NOEMULATION
            GetDXError = "Software emulation is not available."
        Case DDERR_NOEXCLUSIVEMODE
            GetDXError = "The operation requires the application to have exclusive mode, but the application does not have exclusive mode."
        Case DDERR_NOFLIPHW
            GetDXError = "Flipping visible surfaces is not supported."
        Case DDERR_NOGDI
            GetDXError = "No GDI is present."
        Case DDERR_NOHWND
            GetDXError = "Clipper notification requires a window handle, or no window handle has been previously set as the cooperative level window handle."
        Case DDERR_NOMIPMAPHW
            GetDXError = "The operation cannot be carried out because no mipmap texture mapping hardware is present or available."
        Case DDERR_NOMIRRORHW
            GetDXError = "The operation cannot be carried out because no mirroring hardware is present or available."
        Case DDERR_NOOVERLAYDEST
            GetDXError = "The IDirectDrawSurface2::GetOverlayPosition method is called on an overlay that the IDirectDrawSurface2::UpdateOverlay method has not been called on to establish a destination."
        Case DDERR_NOOVERLAYHW
            GetDXError = "The operation cannot be carried out because no overlay hardware is present or available."
        Case DDERR_NOPALETTEATTACHED
            GetDXError = "No palette object is attached to this surface."
        Case DDERR_NOPALETTEHW
            GetDXError = "There is no hardware support for 16- or 256-color palettes."
        Case DDERR_NORASTEROPHW
            GetDXError = "The operation cannot be carried out because no appropriate raster operation hardware is present or available."
        Case DDERR_NOROTATIONHW
            GetDXError = "The operation cannot be carried out because no rotation hardware is present or available."
        Case DDERR_NOSTRETCHHW
            GetDXError = "The operation cannot be carried out because there is no hardware support for stretching."
        Case DDERR_NOT4BITCOLOR
            GetDXError = "The IDirectDrawSurface object is not using a 4-bit color palette and the requested operation requires a 4-bit color palette."
        Case DDERR_NOT4BITCOLORINDEX
            GetDXError = "The IDirectDrawSurface object is not using a 4-bit color index palette and the requested operation requires a 4-bit color index palette."
        Case DDERR_NOT8BITCOLOR
            GetDXError = "The IDirectDrawSurface object is not using an 8-bit color palette and the requested operation requires an 8-bit color palette."
        Case DDERR_NOTAOVERLAYSURFACE
            GetDXError = "An overlay component is called for a non-overlay surface."
        Case DDERR_NOTEXTUREHW
            GetDXError = "The operation cannot be carried out because no texture-mapping hardware is present or available."
        Case DDERR_NOTFLIPPABLE
            GetDXError = "An attempt has been made to flip a surface that cannot be flipped."
        Case DDERR_NOTFOUND
            GetDXError = "The requested item was not found."
        Case DDERR_NOTLOCKED
            GetDXError = "An attempt is made to unlock a surface that was not locked."
        Case DDERR_NOTPAGELOCKED
            GetDXError = "An attempt is made to page unlock a surface with no outstanding page locks."
        Case DDERR_NOTPALETTIZED
            GetDXError = "The surface being used is not a palette-based surface."
        Case DDERR_NOVSYNCHW
            GetDXError = "The operation cannot be carried out because there is no hardware support for vertical blank synchronized operations."
        Case DDERR_NOZBUFFERHW
            GetDXError = "The operation to create a z-buffer in display memory or to perform a blit using a z-buffer cannot be carried out because there is no hardware support for z-buffers."
        Case DDERR_NOZOVERLAYHW
            GetDXError = "The overlay surfaces cannot be z-layered based on the z-order because the hardware does not support z-ordering of overlays."
        Case DDERR_OUTOFCAPS
            GetDXError = "The hardware needed for the requested operation has already been allocated."
        Case DDERR_OUTOFVIDEOMEMORY
            GetDXError = "IDirectDraw does not have enough display memory to perform the operation."
        Case DDERR_OVERLAYCANTCLIP
            GetDXError = "The hardware does not support clipped overlays."
        Case DDERR_OVERLAYCOLORKEYONLYONEACTIVE
            GetDXError = "An attempt was made to have more than one color key active on an overlay."
        Case DDERR_OVERLAYNOTVISIBLE
            GetDXError = "The IDirectDrawSurface2::GetOverlayPosition method is called on a hidden overlay."
        Case DDERR_PALETTEBUSY
            GetDXError = "Access to this palette is refused because the palette is locked by another thread."
        Case DDERR_PRIMARYSURFACEALREADYEXISTS
            GetDXError = "This process has already created a primary surface."
        Case DDERR_REGIONTOOSMALL
            GetDXError = "The region passed to the IDirectDrawClipper::GetClipList method is too small."
        Case DDERR_SURFACEALREADYATTACHED
            GetDXError = "An attempt was made to attach a surface to another surface to which it is already attached."
        Case DDERR_SURFACEALREADYDEPENDENT
            GetDXError = "An attempt was made to make a surface a dependency of another surface to which it is already dependent."
        Case DDERR_SURFACEBUSY
            GetDXError = "Access to the surface is refused because the surface is locked by another thread."
        Case DDERR_SURFACEISOBSCURED
            GetDXError = "Access to the surface is refused because the surface is obscured."
        Case DDERR_SURFACELOST
            GetDXError = "Access to the surface is refused because the surface memory is gone. The IDirectDrawSurface object representing this surface should have the IDirectDrawSurface2::Restore method called on it."
        Case DDERR_SURFACENOTATTACHED
            GetDXError = "The requested surface is not attached."
        Case DDERR_TOOBIGHEIGHT
            GetDXError = "The height requested by IDirectDraw is too large."
        Case DDERR_TOOBIGSIZE
            GetDXError = "The size requested by IDirectDraw is too large. However, the individual height and width are OK."
        Case DDERR_TOOBIGWIDTH
            GetDXError = "The width requested by IDirectDraw is too large."
        Case DDERR_UNSUPPORTEDFORMAT
            GetDXError = "The FourCC format requested is not supported by IDirectDraw."
        Case DDERR_UNSUPPORTEDMASK
            GetDXError = "The bitmask in the pixel format requested is not supported by IDirectDraw."
        Case DDERR_UNSUPPORTEDMODE
            GetDXError = "The display is currently in an unsupported mode."
        Case DDERR_VERTICALBLANKINPROGRESS
            GetDXError = "A vertical blank is in progress."
        Case DDERR_WASSTILLDRAWING
            GetDXError = "The previous blit operation that is transferring information to or from this surface is incomplete."
        Case DDERR_WRONGMODE
            GetDXError = "This surface cannot be restored because it was created in a different mode."
        Case DDERR_XALIGN
            GetDXError = "The provided rectangle was not horizontally aligned on a required boundary."
        Case Else
            GetDXError = "Unknown Error: Out of memory or invalid parameters passed."
    End Select

End Function
Public Sub AppStart()
    ' Initialize application data
    Call AppInitialize
    ' Create dinput Keyboard for key polling
    directInputmodule.CreateDirectInputKeyboard directInput, Keyboarddevice2, fMain
    ' Create dinput Mouse for mouse polling
    directInputmodule.CreateDirectInputMouse directInput, MouseDevice2, fMain
    ' Start main application loop
    Call AppLoop
End Sub
Public Sub TextOutput(Text As String, X, Y)
    SetTextColor fMain.hDC, RGB(255, 255, 255)
    TextOut fMain.hDC, X, Y, Text, Len(Text)
End Sub
Public Sub AddObjects()
        'Set a random position for the flask object
    Dim RandomX As Single, RandomZ As Single
    Dim ObjectBuilder As IDirect3DRMMeshBuilder2    ' Holds and loads the mesh for the object
    Dim ObjectBuilder2 As IDirect3DRMMeshBuilder2    ' Holds and loads the mesh for the object

        'Create frame for object
        G_oD3DInstance.CreateFrame RMScene, ObjectFrame(1)
        G_oD3DInstance.CreateFrame RMScene, ObjectFrame(2)
        G_oD3DInstance.CreateMeshBuilder ObjectBuilder
        G_oD3DInstance.CreateMeshBuilder ObjectBuilder2

        ObjectBuilder.Load App.Path & "\mesh\jar.x", 0, 0, 0, 0
        ObjectFrame(1).AddVisual ObjectBuilder
        ObjectFrame(1).AddScale D3DRMCOMBINE_BEFORE, 0.1, 0.1, 0.1
        ObjectBuilder2.Load App.Path & "\mesh\face.x", 0, 0, 0, 0
        ObjectFrame(2).AddVisual ObjectBuilder2
        ObjectFrame(2).AddScale D3DRMCOMBINE_BEFORE, 0.1, 0.1, 0.1

        Randomize
        RandomX = 1 * Rnd - 1
        Randomize
        RandomZ = 8 * Rnd - 4
        ObjectFrame(1).SetPosition RMScene, RandomX, 0.2, RandomZ

        Randomize
        RandomX = 1 * Rnd - 1
        Randomize
        RandomZ = 8 * Rnd - 4
        ObjectFrame(2).SetPosition RMScene, RandomX, 0.2, RandomZ

        Set ObjectBuilder = Nothing
        Set ObjectBuilder2 = Nothing
End Sub
Public Sub CheckMouse()
    On Error GoTo 0
    Dim CursorPos As POINTAPI
    Dim PickedArray As IDirect3DRMPickedArray
    Dim MeshBuilder As IDirect3DRMMeshBuilder
    Dim FrameArray As IDirect3DRMFrameArray
    Dim PickDesc As D3DRMPICKDESC

    Dim Distance As Single
    Dim CameraPos As D3DVECTOR
    Dim World As D3DVECTOR
    Dim Screen As D3DRMVECTOR4D

    Dim framer As IDirect3DRMFrame

    MouseDevice2.Acquire
    MouseDevice2.GetDeviceState 16, MouseState
    Call GetCursorPos(CursorPos)
    If MouseState.rgbButtons(0) <> 0 Then
        RMViewport.Pick CursorPos.X, CursorPos.Y, PickedArray
        PickedArray.GetPick 0, MeshBuilder, FrameArray, PickDesc
        FrameArray.GetElement (FrameArray.GetSize - 1), framer
        framer.GetPosition RMCamera, CameraPos
        framer.LookAt RMCamera, RMScene, D3DRMCONSTRAIN_Z
        'Stupid d3d rescales object when moved???
        framer.AddScale D3DRMCOMBINE_BEFORE, 0.1, 0.1, 0.1
        framer.SetPosition framer, 0, 0, 0.3
        With PickDesc.vPosition
            Screen.X = .X
            Screen.Y = .Y
            Screen.z = .z
            Screen.w = 1
        End With
        RMViewport.InverseTransform World, Screen
        Distance = Sqr((CameraPos.X - World.X) ^ 2 + (CameraPos.z - World.z) ^ 2)
        TextOutput "Distance to object: " & Distance, CursorPos.X + 5, CursorPos.Y
    End If
End Sub

Public Sub AddLights()
    Dim Light As IDirect3DRMLight
    G_oD3DInstance.CreateFrame RMScene, RMLight(1)
    G_oD3DInstance.CreateFrame RMScene, RMLight(2)
    G_oD3DInstance.CreateLightRGB D3DRMLIGHT_POINT, 0, 0, 0.2, Light
    RMLight(1).AddLight Light
    G_oD3DInstance.CreateLightRGB D3DRMLIGHT_POINT, 0.3, 0, 0, Light
    RMLight(2).AddLight Light
    RMLight(1).SetPosition RMScene, 2, 4, 1
    RMLight(2).SetPosition RMScene, -3, 3, -1
End Sub