Initial commit: ROW Client source code

Game client codebase including:
- CharacterActionControl: Character and creature management
- GlobalScript: Network, items, skills, quests, utilities
- RYLClient: Main client application with GUI and event handlers
- Engine: 3D rendering engine (RYLGL)
- MemoryManager: Custom memory allocation
- Library: Third-party dependencies (DirectX, boost, etc.)
- Tools: Development utilities

🤖 Generated with [Claude Code](https://claude.com/claude-code)

Co-Authored-By: Claude <noreply@anthropic.com>

Library/dxx8/samples/Multimedia/VBSamples/Demos/AirHockey/cAudio.cls

@@ -0,0 +1,163 @@
+VERSION 1.0 CLASS
+BEGIN
+  MultiUse = -1  'True
+  Persistable = 0  'NotPersistable
+  DataBindingBehavior = 0  'vbNone
+  DataSourceBehavior  = 0  'vbNone
+  MTSTransactionMode  = 0  'NotAnMTSObject
+END
+Attribute VB_Name = "cAudio"
+Attribute VB_GlobalNameSpace = False
+Attribute VB_Creatable = True
+Attribute VB_PredeclaredId = False
+Attribute VB_Exposed = False
+Option Explicit
+
+'We will keep our Audio vars here
+Private dmPerf As DirectMusicPerformance8
+Private dmLoad As DirectMusicLoader8
+Private dmMusic As DirectMusicSegment8
+Private dmMusicPath As DirectMusicAudioPath8
+
+Private dmSegBank As cAudioFile
+Private dmSegHit As cAudioFile
+Private dmScore As cAudioFile
+
+Public PlaySounds As Boolean
+Public PlayMusic As Boolean
+
+Private mlSoundVolume As Long
+Private mlMusicVolume As Long
+
+Private Sub InitializeBackgroundMusic(ByVal sPath As String)
+    If dmMusicPath Is Nothing Then 'We haven't created our path yet
+        Set dmMusicPath = dmPerf.CreateStandardAudioPath(DMUS_APATH_SHARED_STEREOPLUSREVERB, 128, True)
+    End If
+    If Not (dmMusic Is Nothing) Then
+        dmMusic.Unload dmMusicPath
+        Set dmMusic = Nothing
+    End If
+    Set dmMusic = dmLoad.LoadSegment(sPath)
+    dmMusic.Download dmMusicPath
+    dmMusic.SetStandardMidiFile
+End Sub
+
+Public Sub StartBackgroundMusic()
+    If Not PlayMusic Then Exit Sub
+    If Not (dmMusic Is Nothing) Then
+        'Keep repeating over and over again
+        dmMusic.SetRepeats INFINITE
+        dmPerf.PlaySegmentEx dmMusic, DMUS_SEGF_DEFAULT, 0, dmMusicPath, dmMusicPath
+    End If
+End Sub
+
+Public Sub StopBackgroundMusic()
+    If Not (dmMusic Is Nothing) Then
+        'Lets just stop
+        dmPerf.StopEx dmMusic, 0, 0
+    End If
+End Sub
+
+Public Sub PlayBankSound()
+    If Not PlaySounds Then Exit Sub
+    'Play the sound that happens when the puck hits the side wall
+    dmSegBank.Play dmPerf
+End Sub
+
+Public Sub PlayHitSound()
+    If Not PlaySounds Then Exit Sub
+    'Play the sound that happens when a paddle hits the puck
+    dmSegHit.Play dmPerf
+End Sub
+
+Public Sub PlayScoreSound()
+    If Not PlaySounds Then Exit Sub
+    'Play the sound that happens when we score
+    dmScore.Play dmPerf
+End Sub
+
+Public Property Let MusicVolume(ByVal lVol As Long)
+    mlMusicVolume = lVol
+    'Actually set the volume
+    If Not (dmMusicPath Is Nothing) Then dmMusicPath.SetVolume lVol, 0
+End Property
+
+Public Property Get MusicVolume() As Long
+    MusicVolume = mlMusicVolume
+End Property
+
+Public Property Let SoundVolume(ByVal lVol As Long)
+    mlSoundVolume = lVol
+    'Actually set the volume
+    If Not (dmPerf Is Nothing) Then
+        If Not (dmPerf.GetDefaultAudioPath Is Nothing) Then dmPerf.GetDefaultAudioPath.SetVolume lVol, 0
+    End If
+End Property
+
+Public Property Get SoundVolume() As Long
+    SoundVolume = mlSoundVolume
+End Property
+
+Public Function InitAudio() As Boolean
+    
+    Dim lCount As Long, dma As DMUS_AUDIOPARAMS
+    
+    InitAudio = True
+    On Error GoTo FailedInit
+    'Create our objects
+    Set dmPerf = dx.DirectMusicPerformanceCreate
+    Set dmLoad = dx.DirectMusicLoaderCreate
+    
+    'Create a default audio path
+    dmPerf.InitAudio frmAir.hwnd, DMUS_AUDIOF_ALL, dma, , DMUS_APATH_SHARED_STEREOPLUSREVERB, 128
+    
+    'Create the sound objects
+    Set dmSegBank = New cAudioFile
+    Set dmSegHit = New cAudioFile
+    Set dmScore = New cAudioFile
+    'Load each of the sounds
+    dmSegBank.InitSounds dmPerf, dmLoad, App.path & "\sounds\", "bank", ".wav"
+    dmSegHit.InitSounds dmPerf, dmLoad, App.path & "\sounds\", "hit", ".wav"
+    dmScore.InitSounds dmPerf, dmLoad, App.path & "\sounds\", "score", ".wav", True
+    
+    InitializeBackgroundMusic App.path & "\sounds\music.mid"
+    'Init the volume
+    SoundVolume = mlSoundVolume
+    MusicVolume = mlMusicVolume
+    Exit Function
+
+FailedInit:
+    InitAudio = False
+End Function
+
+Private Sub Class_Initialize()
+    PlaySounds = True
+    Set dmSegBank = Nothing
+    Set dmSegHit = Nothing
+    Set dmScore = Nothing
+    Set dmMusic = Nothing
+    Set dmPerf = Nothing
+    Set dmLoad = Nothing
+End Sub
+
+Private Sub Class_Terminate()
+    'On Error Resume Next
+    'Unload all of our sounds off of the audio path and destroy them
+    StopBackgroundMusic
+    Set dmSegBank = Nothing
+    Set dmSegHit = Nothing
+    Set dmScore = Nothing
+    If Not (dmMusic Is Nothing) Then
+        dmMusic.Unload dmMusicPath
+        Set dmMusic = Nothing
+    End If
+    
+    Set dmMusicPath = Nothing
+    If Not (dmPerf Is Nothing) Then
+        'Closedown
+        dmPerf.CloseDown
+    End If
+    'Destroy the rest of the objects
+    Set dmPerf = Nothing
+    Set dmLoad = Nothing
+End Sub

Library/dxx8/samples/Multimedia/VBSamples/Demos/AirHockey/cAudioFile.cls

@@ -0,0 +1,79 @@
+VERSION 1.0 CLASS
+BEGIN
+  MultiUse = -1  'True
+  Persistable = 0  'NotPersistable
+  DataBindingBehavior = 0  'vbNone
+  DataSourceBehavior  = 0  'vbNone
+  MTSTransactionMode  = 0  'NotAnMTSObject
+END
+Attribute VB_Name = "cAudioFile"
+Attribute VB_GlobalNameSpace = False
+Attribute VB_Creatable = True
+Attribute VB_PredeclaredId = False
+Attribute VB_Exposed = False
+Option Explicit
+
+'Here we will control a 'set' of audio files
+Private mlNumSounds As Long
+Private dmSegments() As DirectMusicSegment8
+Private moPath As DirectMusicAudioPath8
+
+Public Sub InitSounds(dmPerf As DirectMusicPerformance8, dmLoader As DirectMusicLoader8, ByVal sPath As String, ByVal sFirstPart As String, ByVal sExtenstion As String, Optional fSingleFile As Boolean = False)
+    Dim sFile As String
+    Dim lCount As Long
+    
+    'Here we will take a 'group' of files (that group could only be 1 file)
+    'and load them into our array
+    Set moPath = dmPerf.GetDefaultAudioPath
+    lCount = 1
+    If fSingleFile Then
+        sFile = Dir$(sPath & sFirstPart & sExtenstion)
+    Else
+        sFile = Dir$(sPath & sFirstPart & format$(CStr(lCount), "00") & sExtenstion)
+    End If
+    Do While sFile <> vbNullString
+        ReDim Preserve dmSegments(1 To lCount)
+        Set dmSegments(lCount) = dmLoader.LoadSegment(sPath & sFile)
+        dmSegments(lCount).Download moPath
+        lCount = lCount + 1
+        If fSingleFile Then
+            sFile = vbNullString
+        Else
+            sFile = Dir$
+        End If
+    Loop
+    mlNumSounds = lCount - 1
+End Sub
+
+Public Sub Play(dmPerf As DirectMusicPerformance8)
+    Dim lRnd As Long
+    
+    'Pick a valid sound randomly and play it
+    Randomize
+    lRnd = CLng(Rnd * mlNumSounds) + 1
+    Do While lRnd < 1 Or lRnd > mlNumSounds
+        lRnd = CLng(Rnd * mlNumSounds) + 1
+    Loop
+    dmPerf.PlaySegmentEx dmSegments(lRnd), DMUS_SEGF_SECONDARY, 0
+
+End Sub
+
+Private Sub Class_Initialize()
+    'This should already have happened for us from VB, but just in case
+    Erase dmSegments
+    mlNumSounds = 0
+End Sub
+
+Private Sub Class_Terminate()
+    Dim lCount As Long
+    'Let's clean everything up
+    For lCount = 1 To mlNumSounds
+        'Unload and release all the segments
+        If Not (dmSegments(lCount) Is Nothing) Then
+            dmSegments(lCount).Unload moPath
+            Set dmSegments(lCount) = Nothing
+        End If
+    Next
+    'Clear up any data left over
+    Erase dmSegments
+End Sub

Library/dxx8/samples/Multimedia/VBSamples/Demos/AirHockey/cCamera.cls

@@ -0,0 +1,213 @@
+VERSION 1.0 CLASS
+BEGIN
+  MultiUse = -1  'True
+  Persistable = 0  'NotPersistable
+  DataBindingBehavior = 0  'vbNone
+  DataSourceBehavior  = 0  'vbNone
+  MTSTransactionMode  = 0  'NotAnMTSObject
+END
+Attribute VB_Name = "cCamera"
+Attribute VB_GlobalNameSpace = False
+Attribute VB_Creatable = True
+Attribute VB_PredeclaredId = False
+Attribute VB_Exposed = False
+Option Explicit
+
+'Here we will encapsulate all of the code needed for the camera
+
+Private Enum DefaultCameraViews
+    DefaultView
+    OverHeadView
+    SideOverheadView1
+    SideOverheadView2
+    OpponentView
+    CustomView
+End Enum
+
+'Here are the constants for the default view
+Private Const mnDefaultX As Single = 0
+Private Const mnDefaultY As Single = 10
+Private Const mnDefaultZ As Single = -25
+'Here are the constants for the overhead views
+Private Const mnOverheadX As Single = 0
+Private Const mnOverheadY As Single = 28
+Private Const mnOverheadZ As Single = -1
+'Here are the constants for the side overhead views
+Private Const mnSide1X As Single = 25
+Private Const mnSide1Y As Single = 12.5
+Private Const mnSide1Z As Single = 0
+Private Const mnSide2X As Single = -25
+Private Const mnSide2Y As Single = 12.5
+Private Const mnSide2Z As Single = 0
+'Here are the constants for the opponent views
+Private Const mnOpponentX As Single = 0
+Private Const mnOpponentY As Single = 10
+Private Const mnOpponentZ As Single = 25
+
+'Local variables for the properties of the puck
+Private moPosition As D3DVECTOR 'Current position of the camera
+Private moVelocity As D3DVECTOR 'Current velocity of the camera
+Private moDest As D3DVECTOR 'Destination of the camera
+Private mlCameraTime As Long 'Last time the puck was updated
+Private moLastPosition As D3DVECTOR 'Last position of the camera
+'The default camera views
+Public CameraView As Long
+
+'Position property
+Public Property Let Position(oPos As D3DVECTOR)
+    moPosition = oPos
+End Property
+
+Public Property Get Position() As D3DVECTOR
+    Position = moPosition
+End Property
+
+'Velocity property
+Public Property Let Velocity(oVel As D3DVECTOR)
+    moVelocity = oVel
+End Property
+
+Public Property Get Velocity() As D3DVECTOR
+    Velocity = moVelocity
+End Property
+
+'LastPosition prop
+Public Property Let LastPosition(oLastPos As D3DVECTOR)
+    moLastPosition = oLastPos
+End Property
+
+Public Property Get LastPosition() As D3DVECTOR
+    LastPosition = moLastPosition
+End Property
+
+'Dest property
+Public Property Let Dest(oPos As D3DVECTOR)
+    moDest = oPos
+End Property
+
+Public Property Get Dest() As D3DVECTOR
+    Dest = moDest
+End Property
+
+'Methods
+Public Sub UpdatePosition()
+    Dim RealVelocity As D3DVECTOR
+    Dim DistancePointX As Single
+    Dim DistancePointY As Single
+    Dim DistancePointZ As Single
+    
+    'Here we will update the position of the camera
+    'and move it based on the velocity assigned.
+    If mlCameraTime = 0 Then mlCameraTime = timeGetTime
+    'First calculate the 'real' velocity (based on the time)
+    RealVelocity.x = ((timeGetTime - mlCameraTime) / 100) * moVelocity.x
+    RealVelocity.y = ((timeGetTime - mlCameraTime) / 100) * moVelocity.y
+    RealVelocity.z = ((timeGetTime - mlCameraTime) / 100) * moVelocity.z
+    'Let's save our current position
+    moLastPosition = moPosition
+    'Now let's see if moving our position will move us past our destination
+    'if it does, move us to our destination
+    
+    'First check the X axis
+    DistancePointX = Sqr((moDest.x - moPosition.x) * (moDest.x - moPosition.x))
+    If DistancePointX < RealVelocity.x Then
+        moPosition.x = moDest.x 'We've arrived
+        moVelocity.x = 0
+    Else
+        moPosition.x = moPosition.x + RealVelocity.x 'We haven't got to our destination yet, keep going
+    End If
+    'Now check the Y axis
+    DistancePointY = Sqr((moDest.y - moPosition.y) * (moDest.y - moPosition.y))
+    If DistancePointY < RealVelocity.y Then
+        moPosition.y = moDest.y 'We've arrived
+        moVelocity.y = 0
+    Else
+        moPosition.y = moPosition.y + RealVelocity.y 'We haven't got to our destination yet, keep going
+    End If
+    'Now check the Z axis
+    DistancePointZ = Sqr((moDest.z - moPosition.z) * (moDest.z - moPosition.z))
+    If DistancePointZ < RealVelocity.z Then
+        moPosition.z = moDest.z 'We've arrived
+        moVelocity.z = 0
+    Else
+        moPosition.z = moPosition.z + RealVelocity.z 'We haven't got to our destination yet, keep going
+    End If
+    'Make sure our velocity is going in the right direction
+    If DistancePointX < Sqr((moDest.x - moPosition.x) * (moDest.x - moPosition.x)) Then
+        'It's not, reverse it
+        moVelocity.x = moVelocity.x * -1
+    End If
+    If DistancePointY < Sqr((moDest.y - moPosition.y) * (moDest.y - moPosition.y)) Then
+        'It's not, reverse it
+        moVelocity.y = moVelocity.y * -1
+    End If
+    If DistancePointZ < Sqr((moDest.z - moPosition.z) * (moDest.z - moPosition.z)) Then
+        'It's not, reverse it
+        moVelocity.z = moVelocity.z * -1
+    End If
+    mlCameraTime = timeGetTime
+End Sub
+
+Public Sub NextCameraPosition(ByVal lPlayerID As Long)
+    If CameraView = CustomView Then
+        CameraView = DefaultView
+    Else
+        CameraView = CameraView + 1
+        If CameraView = CustomView Then
+            CameraView = DefaultView
+        End If
+    End If
+    UpdateToNewPosition lPlayerID
+End Sub
+
+Public Sub SetCameraPosition(ByVal lCameraPos As Long, ByVal lPlayerID As Long)
+    CameraView = lCameraPos
+    If CameraView <> CustomView Then UpdateToNewPosition lPlayerID
+End Sub
+
+Private Sub UpdateToNewPosition(ByVal lPlayerID As Long)
+    
+    Select Case CameraView
+    Case DefaultView
+        If lPlayerID = 0 Then
+            moDest.x = mnDefaultX
+            moDest.y = mnDefaultY
+            moDest.z = mnDefaultZ
+        Else 'Default view should be the opponents view
+            moDest.x = mnOpponentX
+            moDest.y = mnOpponentY
+            moDest.z = mnOpponentZ
+        End If
+    Case OpponentView
+        If lPlayerID = 1 Then
+            moDest.x = mnDefaultX
+            moDest.y = mnDefaultY
+            moDest.z = mnDefaultZ
+        Else 'Default view should be the opponents view
+            moDest.x = mnOpponentX
+            moDest.y = mnOpponentY
+            moDest.z = mnOpponentZ
+        End If
+    Case OverHeadView
+        moDest.x = mnOverheadX
+        moDest.y = mnOverheadY
+        moDest.z = mnOverheadZ
+    Case SideOverheadView1
+        moDest.x = mnSide1X
+        moDest.y = mnSide1Y
+        moDest.z = mnSide1Z
+    Case SideOverheadView2
+        moDest.x = mnSide2X
+        moDest.y = mnSide2Y
+        moDest.z = mnSide2Z
+    End Select
+    'Set up a default velocity
+    moVelocity.x = 3
+    moVelocity.y = 3
+    moVelocity.z = 3
+
+End Sub
+
+Private Sub Class_Initialize()
+    CameraView = DefaultView
+End Sub

Library/dxx8/samples/Multimedia/VBSamples/Demos/AirHockey/cFade.cls

@@ -0,0 +1,46 @@
+VERSION 1.0 CLASS
+BEGIN
+  MultiUse = -1  'True
+  Persistable = 0  'NotPersistable
+  DataBindingBehavior = 0  'vbNone
+  DataSourceBehavior  = 0  'vbNone
+  MTSTransactionMode  = 0  'NotAnMTSObject
+END
+Attribute VB_Name = "cFade"
+Attribute VB_GlobalNameSpace = False
+Attribute VB_Creatable = True
+Attribute VB_PredeclaredId = False
+Attribute VB_Exposed = False
+Option Explicit
+
+'This is an 'effects' class, that will fade a scene in or out
+'by increasing the alpha channel on all objects
+Public FadeInterval As Single
+Public AmFading As Boolean
+Public CanFade As Boolean
+Private mlPixelShaderHandle As Long
+
+'Methods used during fading
+
+'This will update the global params for fading the scene in, or out
+'Fading is simply accomplished by adding or subtracting the amount of light in the scene until
+'it reaches a desired level.  Since the background is black anyway, we could have also
+'simply slowly turned up the alpha on each of the objects, this is just the way I chose.
+Public Sub Fade(ByVal nInterval As Long)
+    If Not CanFade Then Exit Sub
+    FadeInterval = nInterval
+    AmFading = True
+End Sub
+
+Public Sub UpdateFade(oPuck As cPuck, oPaddle() As cPaddle, oTable As cTable, oRoom As cRoom)
+    Dim fDoneFading As Boolean
+    fDoneFading = True
+    fDoneFading = oPuck.FadeMesh(FadeInterval) And oPaddle(0).FadeMesh(FadeInterval) And oPaddle(1).FadeMesh(FadeInterval) And oTable.FadeMesh(FadeInterval) And oRoom.FadeMesh(FadeInterval)
+    AmFading = Not fDoneFading
+End Sub
+
+Private Sub Class_Initialize()
+    'By default we will allow fading
+    CanFade = True
+End Sub
+

Library/dxx8/samples/Multimedia/VBSamples/Demos/AirHockey/cInput.cls

@@ -0,0 +1,397 @@
+VERSION 1.0 CLASS
+BEGIN
+  MultiUse = -1  'True
+  Persistable = 0  'NotPersistable
+  DataBindingBehavior = 0  'vbNone
+  DataSourceBehavior  = 0  'vbNone
+  MTSTransactionMode  = 0  'NotAnMTSObject
+END
+Attribute VB_Name = "cInput"
+Attribute VB_GlobalNameSpace = False
+Attribute VB_Creatable = True
+Attribute VB_PredeclaredId = False
+Attribute VB_Exposed = False
+Option Explicit
+
+'Here we will control all of the input, from any source
+'List of camera views (same enum listed in the camera class)
+Private Enum DefaultCameraViews
+    DefaultView
+    OverHeadView
+    SideOverheadView1
+    SideOverheadView2
+    OpponentView
+    CustomView
+End Enum
+
+'*NOTE*
+'
+'I may want to add Force Feedback support, if i do, I would do so here.
+
+'Mouse constants
+Private Const mlJoystickRange As Long = 35
+Private Const mnMaxZThresh As Single = 35
+Private Const mnMaxYThresh As Single = 50
+Private Const mnMaxXThresh As Single = 35
+
+'DirectInput variables, etc
+Private Const glBufferSize As Long = 10
+'DInput objects
+Private di As DirectInput8
+Private diMouse As DirectInputDevice8
+Private diKeyboard As DirectInputDevice8
+Private diJoystick As DirectInputDevice8
+'Is the camera moving?
+Private mfMovingCamera As Boolean
+
+'Local properties to determine what controls should be used
+Public UseMouse As Boolean
+Public UseKeyboard As Boolean
+Public UseJoystick As Boolean
+Public JoystickGuid As String
+Public JoystickSensitivity As Single
+Public MouseSensitivity As Single
+Public KeyboardSensitivity As Single
+
+Public Property Get InputObject() As DirectInput8
+    Set InputObject = di
+End Property
+
+Public Function InitDirectInput(oForm As Form) As Boolean
+  
+    Dim diProp As DIPROPLONG
+    Dim diProp_Dead As DIPROPLONG
+    Dim diProp_Range As DIPROPRANGE
+    Dim diProp_Saturation As DIPROPLONG
+    
+    On Error GoTo FailedInput
+    
+    InitDirectInput = True
+    'Create the DirectInput object, and all of the devices we need.
+    If UseMouse Then
+        Set diMouse = di.CreateDevice("guid_SysMouse")
+        diMouse.SetCommonDataFormat DIFORMAT_MOUSE
+        diMouse.SetCooperativeLevel oForm.hwnd, DISCL_FOREGROUND Or DISCL_EXCLUSIVE
+    
+        ' Set the buffer size
+        diProp.lHow = DIPH_DEVICE
+        diProp.lObj = 0
+        diProp.lData = glBufferSize
+        Call diMouse.SetProperty("DIPROP_BUFFERSIZE", diProp)
+        'Acquire the mouse
+        diMouse.Acquire
+    End If
+    
+    If UseKeyboard Then
+        Set diKeyboard = di.CreateDevice("GUID_SysKeyboard")
+        
+        diKeyboard.SetCommonDataFormat DIFORMAT_KEYBOARD
+        diKeyboard.SetCooperativeLevel oForm.hwnd, DISCL_FOREGROUND Or DISCL_NONEXCLUSIVE
+        'Acquire the keyboard
+        diKeyboard.Acquire
+    End If
+    
+    If UseJoystick Then
+        On Error Resume Next
+        Set diJoystick = di.CreateDevice(JoystickGuid)
+        If Err Then 'This joystick doesn't exist anymore
+            UseJoystick = False
+            Exit Function
+        End If
+        On Error GoTo FailedInput
+        diJoystick.SetCommonDataFormat DIFORMAT_JOYSTICK
+        diJoystick.SetCooperativeLevel oForm.hwnd, DISCL_FOREGROUND Or DISCL_EXCLUSIVE
+        
+        'Set deadzone to 10 percent
+        With diProp_Dead
+            .lData = mlJoystickRange \ 20
+            .lHow = DIPH_BYOFFSET
+            .lObj = DIJOFS_X
+            diJoystick.SetProperty "DIPROP_DEADZONE", diProp_Dead
+            .lObj = DIJOFS_Y
+            diJoystick.SetProperty "DIPROP_DEADZONE", diProp_Dead
+        End With
+        
+        'Set saturation zones to 5 percent
+        With diProp_Saturation
+            .lData = mlJoystickRange \ 40
+            .lHow = DIPH_BYOFFSET
+            .lObj = DIJOFS_X
+             diJoystick.SetProperty "DIPROP_SATURATION", diProp_Saturation
+            .lObj = DIJOFS_Y
+             diJoystick.SetProperty "DIPROP_SATURATION", diProp_Saturation
+        End With
+    
+        'Just in case this device doesn't let us set the range
+        On Error Resume Next
+        'Set range for all axes
+        With diProp_Range
+            .lHow = DIPH_DEVICE
+            .lMin = -mlJoystickRange
+            .lMax = mlJoystickRange
+        End With
+        diJoystick.SetProperty "DIPROP_RANGE", diProp_Range
+        On Error GoTo FailedInput
+        
+        diJoystick.Acquire
+    End If
+    
+    Exit Function
+  
+FailedInput:
+    InitDirectInput = False
+
+End Function
+
+Private Sub ProcessMouseData(oPaddle As cPaddle, oPuck As cPuck)
+    'This is where we respond to any change in mouse state. Usually this will be an axis movement
+    'or button press or release
+
+    Dim diDeviceData(1 To glBufferSize) As DIDEVICEOBJECTDATA
+    Dim lNumItems As Long
+    Dim lCount As Integer
+    Dim lTempX As Single, lTempZ As Single
+  
+    On Error GoTo INPUTLOST 'In case we lost the mouse
+    diMouse.Acquire 'Just in case
+    lNumItems = diMouse.GetDeviceData(diDeviceData, 0)
+    On Error GoTo 0 'Reset our error
+    
+    ' Process data
+    For lCount = 1 To lNumItems
+        Select Case diDeviceData(lCount).lOfs
+        Case DIMOFS_X 'We moved the X axis
+            If mfMovingCamera Then
+                With goCamera.Position
+                    If lTempZ = 0 Then lTempZ = .z
+                    lTempX = .X + (diDeviceData(lCount).lData * MouseSensitivity)
+                    goCamera.SetCameraPosition CustomView, oPaddle.PaddleID
+                    If Abs(lTempX) > mnMaxXThresh Then
+                        'Whoops too much
+                        lTempX = mnMaxXThresh * (lTempX / Abs(lTempX))
+                    End If
+                End With
+            Else
+                With oPaddle.Position
+                    If lTempZ = 0 Then lTempZ = .z
+                    lTempX = .X + (diDeviceData(lCount).lData * MouseSensitivity)
+                End With
+            End If
+        Case DIMOFS_Y 'We moved the Y axis
+            If mfMovingCamera Then
+                With goCamera.Position
+                    If lTempX = 0 Then lTempX = .X
+                    lTempZ = .z - (diDeviceData(lCount).lData * MouseSensitivity)
+                    goCamera.SetCameraPosition CustomView, oPaddle.PaddleID
+                    If Abs(lTempZ) > mnMaxZThresh Then
+                        'Whoops too much
+                        lTempZ = mnMaxZThresh * (lTempZ / Abs(lTempZ))
+                    End If
+                End With
+            Else
+                With oPaddle.Position
+                    If lTempX = 0 Then lTempX = .X
+                    lTempZ = .z - (diDeviceData(lCount).lData * MouseSensitivity)
+                End With
+            End If
+        Case DIMOFS_BUTTON1
+            mfMovingCamera = (diDeviceData(lCount).lData And &H80 = &H80)
+        End Select
+    Next lCount
+    'Ok, this sequence is done, process the info, and move on
+    If lTempX <> 0 And lTempZ <> 0 Then
+        If mfMovingCamera Then
+            goCamera.Position = vec3(lTempX, goCamera.Position.Y, lTempZ)
+        Else
+            oPaddle.LastPosition = oPaddle.Position
+            oPaddle.Position = vec3(lTempX, oPaddle.Position.Y, lTempZ)
+            oPaddle.Velocity = vec3(oPaddle.Position.X - oPaddle.LastPosition.X, oPaddle.Velocity.Y, oPaddle.Position.z - oPaddle.LastPosition.z)
+            oPaddle.LastVelocityTick = timeGetTime
+        End If
+    End If
+    MakeSurePaddleIsOnBoard oPaddle
+    Exit Sub
+    
+INPUTLOST:
+    If (Err.Number = DIERR_INPUTLOST) Or (Err.Number = DIERR_NOTACQUIRED) Then
+        'We no longer have the mouse..
+    End If
+End Sub
+
+Private Sub ProcessKeyBoardData(oPaddle As cPaddle, oPuck As cPuck)
+    
+    'This is where we respond to any change in keyboard state. Usually this will be an axis movement
+    'or button press or release
+    
+    Dim diKeys As DIKEYBOARDSTATE
+    Dim lTempX As Single, lTempZ As Single
+    
+    On Error GoTo INPUTLOST 'In case we lost focus
+    diKeyboard.Acquire 'Just in case
+    diKeyboard.GetDeviceStateKeyboard diKeys
+    
+    If KeyPressed(diKeys, DIK_LEFTARROW) Or KeyPressed(diKeys, DIK_NUMPAD4) Then
+        oPaddle.LastPosition = oPaddle.Position
+        With oPaddle.Position
+            lTempX = .X - KeyboardSensitivity
+            oPaddle.Position = vec3(lTempX, .Y, .z)
+        End With
+        oPaddle.Velocity = vec3(oPaddle.Position.X - oPaddle.LastPosition.X, oPaddle.Velocity.Y, oPaddle.Velocity.z)
+        oPaddle.LastVelocityTick = timeGetTime
+    End If
+    If KeyPressed(diKeys, DIK_RIGHTARROW) Or KeyPressed(diKeys, DIK_NUMPAD6) Then
+        oPaddle.LastPosition = oPaddle.Position
+        With oPaddle.Position
+            lTempX = .X + KeyboardSensitivity
+            oPaddle.Position = vec3(lTempX, .Y, .z)
+        End With
+        oPaddle.Velocity = vec3(oPaddle.Position.X - oPaddle.LastPosition.X, oPaddle.Velocity.Y, oPaddle.Velocity.z)
+        oPaddle.LastVelocityTick = timeGetTime
+    End If
+    If KeyPressed(diKeys, DIK_UPARROW) Or KeyPressed(diKeys, DIK_NUMPAD8) Then
+        oPaddle.LastPosition = oPaddle.Position
+        With oPaddle.Position
+            lTempZ = .z + KeyboardSensitivity
+            oPaddle.Position = vec3(.X, .Y, lTempZ)
+        End With
+        oPaddle.Velocity = vec3(oPaddle.Velocity.X, oPaddle.Velocity.Y, oPaddle.Position.z - oPaddle.LastPosition.z)
+        oPaddle.LastVelocityTick = timeGetTime
+    End If
+    If KeyPressed(diKeys, DIK_DOWNARROW) Or KeyPressed(diKeys, DIK_NUMPAD2) Then
+        oPaddle.LastPosition = oPaddle.Position
+        With oPaddle.Position
+            lTempZ = .z - KeyboardSensitivity
+            oPaddle.Position = vec3(.X, .Y, lTempZ)
+        End With
+        oPaddle.Velocity = vec3(oPaddle.Velocity.X, oPaddle.Velocity.Y, oPaddle.Position.z - oPaddle.LastPosition.z)
+        oPaddle.LastVelocityTick = timeGetTime
+    End If
+    
+    MakeSurePaddleIsOnBoard oPaddle
+    Exit Sub
+    
+INPUTLOST:
+    If (Err.Number = DIERR_INPUTLOST) Or (Err.Number = DIERR_NOTACQUIRED) Then
+        'We no longer have the mouse..
+    End If
+End Sub
+
+Private Sub ProcessJoystickData(oPaddle As cPaddle, oPuck As cPuck)
+    
+    'This is where we respond to any change in keyboard state. Usually this will be an axis movement
+    'or button press or release
+    
+    Dim diJoy As DIJOYSTATE
+    Dim lTempX As Single, lTempZ As Single
+    
+    On Error GoTo INPUTLOST 'In case we lost focus
+    diJoystick.Acquire 'Just in case
+    diJoystick.Poll
+    diJoystick.GetDeviceStateJoystick diJoy
+    
+    If diJoy.X <> 0 Then
+        oPaddle.LastPosition = oPaddle.Position
+        With oPaddle.Position
+            lTempX = .X + (diJoy.X * JoystickSensitivity)
+            oPaddle.Position = vec3(lTempX, .Y, .z)
+        End With
+        oPaddle.Velocity = vec3(oPaddle.Position.X - oPaddle.LastPosition.X, oPaddle.Velocity.Y, oPaddle.Velocity.z)
+        oPaddle.LastVelocityTick = timeGetTime
+    End If
+    If diJoy.Y <> 0 Then
+        oPaddle.LastPosition = oPaddle.Position
+        With oPaddle.Position
+            lTempZ = .z - (diJoy.Y * JoystickSensitivity)
+            oPaddle.Position = vec3(.X, .Y, lTempZ)
+        End With
+        oPaddle.Velocity = vec3(oPaddle.Velocity.X, oPaddle.Velocity.Y, oPaddle.Position.z - oPaddle.LastPosition.z)
+        oPaddle.LastVelocityTick = timeGetTime
+    End If
+    
+    MakeSurePaddleIsOnBoard oPaddle
+    Exit Sub
+    
+INPUTLOST:
+    If (Err.Number = DIERR_INPUTLOST) Or (Err.Number = DIERR_NOTACQUIRED) Then
+        'We no longer have the joystick..
+    End If
+End Sub
+
+Public Sub GetAndHandleInput(oPaddle As cPaddle, oPuck As cPuck)
+
+    Dim vOldPaddle As D3DVECTOR
+    
+    oPaddle.Velocity = vec3(0, 0, 0)
+    vOldPaddle = oPaddle.Position
+    If UseMouse Then
+        'First let's handle the mouse
+        ProcessMouseData oPaddle, oPuck
+    End If
+        
+    If UseKeyboard Then
+        'Now we can worry about keyboard
+        ProcessKeyBoardData oPaddle, oPuck
+    End If
+    
+    If UseJoystick Then
+        'If we have a joystick selected check that too
+        ProcessJoystickData oPaddle, oPuck
+    End If
+    oPaddle.EnsureReality vOldPaddle, oPuck
+End Sub
+
+'Helper function to determine if a key is pressed
+Private Function KeyPressed(diKeys As DIKEYBOARDSTATE, Key As Byte)
+    KeyPressed = (diKeys.Key(Key) And &H80 = &H80)
+End Function
+
+Private Function MakeSurePaddleIsOnBoard(oPaddle As cPaddle)
+    Dim lTempZ As Single, lTempX As Single
+    lTempX = oPaddle.Position.X
+    lTempZ = oPaddle.Position.z
+    
+    'Don't let the paddle leave the left or right sides of the table
+    If lTempX > (gnSideLeftWallEdge - (gnPaddleRadius)) Then
+        lTempX = (gnSideLeftWallEdge - (gnPaddleRadius))
+    ElseIf lTempX < (gnSideRightWallEdge + (gnPaddleRadius)) Then
+        lTempX = (gnSideRightWallEdge + (gnPaddleRadius))
+    End If
+    'Depending on which end of the table we are *supposed* to be on,
+    'restrict our movement.
+    If oPaddle.PaddleID = 0 Then
+        If lTempZ > -(gnPaddleRadius * 1.5) Then
+            lTempZ = -(gnPaddleRadius * 1.5)
+        ElseIf lTempZ < (gnFarWallEdge + (gnPaddleRadius)) Then
+            lTempZ = (gnFarWallEdge + (gnPaddleRadius))
+        End If
+    Else
+        If lTempZ > (gnNearWallEdge - (gnPaddleRadius)) Then
+            lTempZ = (gnNearWallEdge - (gnPaddleRadius))
+        ElseIf lTempZ < (gnPaddleRadius * 1.5) Then
+            lTempZ = (gnPaddleRadius * 1.5)
+        End If
+    End If
+    
+    oPaddle.Position = vec3(lTempX, oPaddle.Position.Y, lTempZ)
+End Function
+
+Private Sub Class_Initialize()
+    Set diMouse = Nothing
+    Set diKeyboard = Nothing
+    Set diJoystick = Nothing
+    Set di = Nothing
+    Set di = dx.DirectInputCreate
+End Sub
+
+Private Sub Class_Terminate()
+    On Error Resume Next 'Ignore any errors, we're cleaning everything up
+    'Unacquire the mouse
+    If Not (diMouse Is Nothing) Then diMouse.Unacquire
+    If Not (diKeyboard Is Nothing) Then diKeyboard.Unacquire
+    If Not (diJoystick Is Nothing) Then diJoystick.Unacquire
+    'Destroy our objects
+    Set diMouse = Nothing
+    Set diKeyboard = Nothing
+    Set diJoystick = Nothing
+    Set di = Nothing
+End Sub

Library/dxx8/samples/Multimedia/VBSamples/Demos/AirHockey/cPaddle.cls

@@ -0,0 +1,268 @@
+VERSION 1.0 CLASS
+BEGIN
+  MultiUse = -1  'True
+  Persistable = 0  'NotPersistable
+  DataBindingBehavior = 0  'vbNone
+  DataSourceBehavior  = 0  'vbNone
+  MTSTransactionMode  = 0  'NotAnMTSObject
+END
+Attribute VB_Name = "cPaddle"
+Attribute VB_GlobalNameSpace = False
+Attribute VB_Creatable = True
+Attribute VB_PredeclaredId = False
+Attribute VB_Exposed = False
+Option Explicit
+
+'Here we will encapsulate all of the code needed for the Paddle
+'Local variables for the properties of the Paddle
+Private moPosition As D3DVECTOR 'Current position of the Paddle
+Private moVelocity As D3DVECTOR 'Current velocity of the Paddle
+Private moLastPosition As D3DVECTOR 'Last position of the Paddle
+Private moPaddle As CD3DFrame 'D3D Mesh for the Paddle
+Private mlPaddleTime As Long 'Last time the Paddle was updated
+Private mlTransparantPaddle As Boolean
+Public LastVelocityTick As Long 'Last time the paddle's velocity changed
+Public PaddleID As Long
+
+'Position property
+Public Property Let Position(oPos As D3DVECTOR)
+    moPosition = oPos
+End Property
+
+Public Property Get Position() As D3DVECTOR
+    Position = moPosition
+End Property
+
+'Velocity property
+Public Property Let Velocity(oVel As D3DVECTOR)
+    moVelocity = oVel
+End Property
+
+Public Property Get Velocity() As D3DVECTOR
+    Velocity = moVelocity
+End Property
+
+'LastPosition prop
+Public Property Let LastPosition(oLastPos As D3DVECTOR)
+    moLastPosition = oLastPos
+End Property
+
+Public Property Get LastPosition() As D3DVECTOR
+    LastPosition = moLastPosition
+End Property
+
+'Transparent property
+Public Property Let Transparent(ByVal fTrans As Boolean)
+    Dim oMesh As CD3DMesh, oMaterial As D3DMATERIAL8
+    Dim lNumMaterial As Long, lCount As Long
+    
+    mlTransparantPaddle = fTrans
+    'now set the property
+    Set oMesh = moPaddle.FindChildObject("paddle", 0)
+    lNumMaterial = oMesh.GetMaterialCount
+    For lCount = 0 To lNumMaterial - 1
+        oMaterial = oMesh.GetMaterial(lCount)
+        If fTrans Then
+            oMaterial.diffuse.a = 0.5
+        Else
+            oMaterial.diffuse.a = 1
+        End If
+        oMesh.SetMaterial lCount, oMaterial
+    Next
+End Property
+
+Public Property Get Transparent() As Boolean
+    Transparent = mlTransparantPaddle
+End Property
+
+'Methods
+Public Sub Init(ByVal sMedia As String, sFile As String)
+    Set moPaddle = D3DUtil_LoadFromFile(AddDirSep(sMedia) & sFile, Nothing, Nothing)
+End Sub
+
+Public Sub UpdateTime()
+    mlPaddleTime = timeGetTime
+End Sub
+
+Public Sub UpdatePosition()
+    Dim RealVelocity As D3DVECTOR
+    
+    'Here we will update the position of the paddle
+    'and move it based on the velocity assigned.
+    If mlPaddleTime = 0 Then mlPaddleTime = timeGetTime
+    'First calculate the 'real' velocity (based on the time)
+    RealVelocity.X = ((timeGetTime - mlPaddleTime) / 100) * moVelocity.X
+    RealVelocity.Y = ((timeGetTime - mlPaddleTime) / 100) * moVelocity.Y
+    RealVelocity.z = ((timeGetTime - mlPaddleTime) / 100) * moVelocity.z
+    'Let's save our current position
+    moLastPosition = moPosition
+        
+    moPosition.X = moPosition.X + RealVelocity.X
+    moPosition.Y = moPosition.Y + RealVelocity.Y
+    moPosition.z = moPosition.z + RealVelocity.z
+    
+    mlPaddleTime = timeGetTime
+End Sub
+
+Public Sub Render(dev As Direct3DDevice8)
+    Dim matPaddle As D3DMATRIX
+    
+    D3DXMatrixIdentity matPaddle
+    D3DXMatrixTranslation matPaddle, moPosition.X, moPosition.Y, moPosition.z
+    moPaddle.SetMatrix matPaddle
+    moPaddle.Render dev
+End Sub
+
+Public Sub CleanupFrame()
+    Set moPaddle = Nothing
+End Sub
+
+Public Sub EnsureReality(oldPos As D3DVECTOR, oPuck As cPuck)
+    Dim vecDif As D3DVECTOR, nDistance As Single
+    Dim vNewVel As D3DVECTOR, nVel As Single
+    Dim fMovePaddle As Boolean
+    
+    'We do *not* want to go 'inside' the puck, don't let it happen
+    D3DXVec3Subtract vecDif, oPuck.Position, moPosition
+    nDistance = D3DXVec3Length(vecDif)
+    If nDistance < (gnPuckRadius + gnPaddleRadius) Then
+        'Ok, we are within the puck, now who should move?  The puck or the paddle?
+        With moPosition
+            fMovePaddle = False
+            If .z < (gnFarWallEdge + (gnPaddleRadius + gnPuckRadius)) Then
+                fMovePaddle = True
+            End If
+            If .z > (gnNearWallEdge - (gnPaddleRadius + gnPuckRadius)) Then
+                fMovePaddle = True
+            End If
+            If .X < (gnSideRightWallEdge + (gnPaddleRadius + gnPuckRadius)) Then
+                fMovePaddle = True
+            End If
+            If .X > (gnSideLeftWallEdge - (gnPaddleRadius + gnPuckRadius)) Then
+                fMovePaddle = True
+            End If
+        End With
+        
+        If fMovePaddle Then
+            'Move the paddle back out so it's not hitting the puck
+            Dim vDir As D3DVECTOR, vScale As D3DVECTOR, vPaddleVel As D3DVECTOR
+            Dim vPaddleDif As D3DVECTOR
+    
+            D3DXVec3Subtract vPaddleDif, oPuck.Position, moPosition
+            D3DXVec3Subtract vPaddleVel, oldPos, moPosition
+            'Get the direction vector by normalizing the pucks velocity
+            D3DXVec3Normalize vDir, vPaddleVel
+            'Scale the length of the two vectors, plus a little more.
+            D3DXVec3Scale vScale, vDir, D3DXVec3Length(vPaddleDif) '(gnPaddleRadius / 4)
+            'Move the paddle to it's new location
+            D3DXVec3Add moPosition, oldPos, vScale
+        'Else We can ignore the case of the puck needing to move because that will
+              'happen in checkcollisions call for the puck
+        End If
+    End If
+End Sub
+
+Public Sub DoComputerAI(oPuck As cPuck)
+
+    Dim vOldPos As D3DVECTOR
+    Dim nTempX As Single, nTempZ As Single
+    
+    'We'll create a simplistic AI opponent
+    vOldPos = moPosition
+    'Let's just set the velocity of the paddle
+    moLastPosition = moPosition
+    With moPosition
+        If Abs(oPuck.Position.X > .X) Then
+            nTempX = Min(oPuck.Velocity.X, gnComputerMaximumVelocity)
+        Else
+            nTempX = Min(oPuck.Velocity.X, -gnComputerMaximumVelocity)
+        End If
+        If Abs(oPuck.Position.z - .z) > Abs(oPuck.LastPosition.z - .z) Then
+            nTempZ = gnComputerMaximumVelocity
+        Else
+            nTempZ = -gnComputerMaximumVelocity
+        End If
+    End With
+    moVelocity = vec3(nTempX, 0, nTempZ)
+    'If the puck is in *front* of the paddle, just move the paddle directly backwards
+    If moPosition.z < oPuck.Position.z Then
+        moVelocity = vec3(0, 0, gnComputerMaximumVelocity)
+    End If
+    UpdatePosition
+    EnsureReality vOldPos, oPuck
+    
+    With moPosition
+        nTempX = .X
+        nTempZ = .z
+        If PaddleID = 0 Then
+            If nTempZ > -(gnPaddleRadius * 1.5) Then
+                nTempZ = -(gnPaddleRadius * 1.5)
+            ElseIf nTempZ < (gnFarWallEdge + (gnPaddleRadius)) Then
+                nTempZ = (gnFarWallEdge + (gnPaddleRadius))
+            End If
+        Else
+            If nTempZ > (gnNearWallEdge - (gnPaddleRadius)) Then
+                nTempZ = (gnNearWallEdge - (gnPaddleRadius))
+            ElseIf nTempZ < (gnPaddleRadius * 1.5) Then
+                nTempZ = (gnPaddleRadius * 1.5)
+            End If
+        End If
+        If nTempX < (gnSideRightWallEdge + (gnPaddleRadius)) Then
+            nTempX = (gnSideRightWallEdge + (gnPaddleRadius))
+        End If
+        If nTempX > (gnSideLeftWallEdge - (gnPaddleRadius)) Then
+            nTempX = (gnSideLeftWallEdge - (gnPaddleRadius))
+        End If
+        moPosition = vec3(nTempX, moPosition.Y, nTempZ)
+    End With
+End Sub
+
+Public Function FadeMesh(FadeInterval As Single) As Boolean
+    Dim lNumMaterial As Long
+    Dim lCount As Long
+    Dim oMaterial As D3DMATERIAL8
+    Dim fDoneFading As Boolean
+    Dim oMesh As CD3DMesh
+    Dim nInternalInterval As Single
+    Static lFadeTime As Long
+    
+    nInternalInterval = FadeInterval
+    If lFadeTime = 0 Then
+        lFadeTime = timeGetTime
+        Exit Function 'We'll do the fade next render pass
+    End If
+    nInternalInterval = (((timeGetTime - lFadeTime) / 1000000) * nInternalInterval)
+    
+    Set oMesh = moPaddle.FindChildObject("paddle", 0)
+    fDoneFading = True
+    lNumMaterial = oMesh.GetMaterialCount
+    For lCount = 0 To lNumMaterial - 1
+        oMaterial = oMesh.GetMaterial(lCount)
+        If nInternalInterval > 0 And oMaterial.diffuse.a <= 1 Then
+            oMaterial.diffuse.a = oMaterial.diffuse.a + nInternalInterval
+            fDoneFading = False
+        ElseIf nInternalInterval < 0 And oMaterial.diffuse.a >= -1 Then
+            oMaterial.diffuse.a = oMaterial.diffuse.a + nInternalInterval
+            fDoneFading = False
+        End If
+        oMesh.SetMaterial lCount, oMaterial
+    Next
+    FadeMesh = fDoneFading
+End Function
+
+Private Sub Class_Initialize()
+    Set moPaddle = Nothing
+End Sub
+
+Private Sub Class_Terminate()
+    Set moPaddle = Nothing
+End Sub
+
+Private Function Min(ByVal nVal As Single, nVal2 As Single) As Single
+    If Abs(nVal) < Abs(nVal2) Then
+        Min = nVal
+    Else
+        Min = nVal2
+    End If
+End Function
+

Library/dxx8/samples/Multimedia/VBSamples/Demos/AirHockey/cPuck.cls

@@ -0,0 +1,454 @@
+VERSION 1.0 CLASS
+BEGIN
+  MultiUse = -1  'True
+  Persistable = 0  'NotPersistable
+  DataBindingBehavior = 0  'vbNone
+  DataSourceBehavior  = 0  'vbNone
+  MTSTransactionMode  = 0  'NotAnMTSObject
+END
+Attribute VB_Name = "cPuck"
+Attribute VB_GlobalNameSpace = False
+Attribute VB_Creatable = True
+Attribute VB_PredeclaredId = False
+Attribute VB_Exposed = False
+Option Explicit
+
+Private Const mnMaxSpinSpeed As Single = 0.9
+'Here we will encapsulate all of the code needed for the puck
+'Local variables for the properties of the puck
+Private moPosition As D3DVECTOR 'Current position of the puck
+Private moVelocity As D3DVECTOR 'Current velocity of the puck
+Private moLastPosition As D3DVECTOR 'Last position of the puck
+
+Public Spinning As Boolean 'Is the puck currently spinning?
+Public MaximumPuckVelocity As Single
+
+Private mnSpinDir As Single 'Direction of the pucks spinning
+Private mlPuckTime As Long 'Last time the puck was updated
+Private mnPuckSpin As Single
+
+Private moPuck As CD3DFrame 'D3D Mesh for the puck
+'Default spin speed
+Private mnDefaultSpin As Single
+
+'Position property
+Public Property Let Position(oPos As D3DVECTOR)
+    moPosition = oPos
+End Property
+
+Public Property Get Position() As D3DVECTOR
+    Position = moPosition
+End Property
+
+'Velocity property
+Public Property Let Velocity(oVel As D3DVECTOR)
+    moVelocity = oVel
+    'Update the velocity, but make sure it isn't too high
+    EnsurePuckVelocityIsBelowMax
+End Property
+
+Public Property Get Velocity() As D3DVECTOR
+    Velocity = moVelocity
+End Property
+
+'LastPosition prop
+Public Property Let LastPosition(oLastPos As D3DVECTOR)
+    moLastPosition = oLastPos
+End Property
+
+Public Property Get LastPosition() As D3DVECTOR
+    LastPosition = moLastPosition
+End Property
+
+'Different methods from the puck.
+Public Sub Init(ByVal sMedia As String, sFile As String)
+    Set moPuck = D3DUtil_LoadFromFile(AddDirSep(sMedia) & sFile, Nothing, Nothing)
+End Sub
+
+Public Sub UpdatePosition()
+    Dim RealVelocity As D3DVECTOR
+    
+    'Here we will update the position of the puck
+    'and move it based on the velocity assigned.
+    If mlPuckTime = 0 Then mlPuckTime = timeGetTime
+    'First calculate the 'real' velocity (based on the time)
+    RealVelocity.X = ((timeGetTime - mlPuckTime) / 100) * moVelocity.X
+    RealVelocity.Y = ((timeGetTime - mlPuckTime) / 100) * moVelocity.Y
+    RealVelocity.z = ((timeGetTime - mlPuckTime) / 100) * moVelocity.z
+    'Let's save our current position
+    moLastPosition = moPosition
+        
+    moPosition.X = moPosition.X + RealVelocity.X
+    moPosition.Y = moPosition.Y + RealVelocity.Y
+    moPosition.z = moPosition.z + RealVelocity.z
+    
+    If Spinning Then
+        'Update Puck Spin
+        mnPuckSpin = mnPuckSpin + ((((timeGetTime - mlPuckTime) / 100) * mnDefaultSpin) * mnSpinDir)
+        If mnPuckSpin > 2 * g_pi Then mnPuckSpin = 0
+    End If
+    
+    mlPuckTime = timeGetTime
+End Sub
+
+Public Sub Render(dev As Direct3DDevice8)
+    Dim matRot As D3DMATRIX, matTrans As D3DMATRIX
+    Dim matPuck As D3DMATRIX
+    
+    D3DXMatrixRotationAxis matRot, vec3(0, 1, 0), mnPuckSpin
+    D3DXMatrixTranslation matTrans, moPosition.X, moPosition.Y, moPosition.z
+    D3DXMatrixMultiply matPuck, matRot, matTrans
+    
+    moPuck.SetMatrix matPuck
+    moPuck.Render dev
+
+End Sub
+
+Public Sub LaunchPuck()
+    Randomize
+    DefaultStartPosition
+    Do While (D3DXVec3Length(moVelocity) < (MaximumPuckVelocity / 4)) And (Abs(moVelocity.z) < 0.2) 'Make sure there is *some* z movement
+        moVelocity.z = Rnd * (MaximumPuckVelocity / 3)
+        moVelocity.X = Rnd * (MaximumPuckVelocity / 3)
+        If Rnd > 0.5 Then moVelocity.X = moVelocity.X * -1
+        If Rnd < 0.5 Then moVelocity.z = moVelocity.z * -1
+    Loop
+End Sub
+
+Public Sub DefaultStartPosition()
+    moPosition = vec3(0, 2.5, 0)
+    moVelocity = vec3(0, 0, 0)
+    moLastPosition = vec3(0, 0, 0)
+End Sub
+
+Public Sub ChangePuckVelocity(oPaddle As cPaddle, oAudio As cAudio, Optional ByVal fIgnoreMax As Boolean = False)
+
+    Dim vDir As D3DVECTOR
+    Dim a As Single, b As Single, c As Single
+    Dim t0 As Single, t1 As Single
+    Dim vIntersect As D3DVECTOR, vIntersectHigh As D3DVECTOR
+    Dim oPlane As D3DPLANE, matReflect As D3DMATRIX
+    Dim oPoint As D3DVECTOR, vNewVelDir As D3DVECTOR
+    Dim vPuck As D3DVECTOR, tSmall As Single
+    Dim nVelocity As Single, nVelocityPaddle As Single
+    Dim vNewVelPad As D3DVECTOR
+  
+    'We hit with the paddle, randomly change the spin direction
+    UpdatePuckSpin
+    glPaddleCollideTime = timeGetTime
+    'gfRecentlyHitPaddle = True
+    'Notify the user that the puck hit the paddle by playing a sound
+    If Not (oAudio Is Nothing) Then oAudio.PlayHitSound
+    'Let's store the original velocity
+    nVelocity = D3DXVec3Length(moVelocity)
+    nVelocityPaddle = D3DXVec3Length(oPaddle.Velocity) * gnPaddleMass
+    'First we need to find the intersection point
+    'To do that we first need to solve for t:
+    'x = Dxt + x0
+    'z = Dzt + z0
+    D3DXVec3Subtract vPuck, moPosition, oPaddle.Position
+    D3DXVec3Normalize vDir, moVelocity
+    a = 1 ' (vDir.x ^ 2) + (vDir.z ^ 2) will always be one since the vector is normalized
+    b = (2 * vPuck.X * vDir.X) + (2 * vPuck.z * vDir.z)
+    c = ((vPuck.X ^ 2) + (vPuck.z ^ 2) - ((gnPaddleRadius + gnPuckRadius) ^ 2))
+    't = (-b <20> SQR(b<>-4ac))/2a
+    If (b ^ 2) - (4 * a * c) > 0 Then
+        t0 = (-b + Sqr((b ^ 2) - (4 * a * c))) / (2 * a)
+        t1 = (-b - Sqr((b ^ 2) - (4 * a * c))) / (2 * a)
+    Else 'We shouldn't hit this case, but just in case.
+        t0 = 0
+        t1 = 0
+    End If
+    
+    Dim vInt1 As D3DVECTOR, vInt2 As D3DVECTOR
+    Dim vDifInt1 As D3DVECTOR, vDifInt2 As D3DVECTOR
+    'Find both possible intersection points
+    vInt1.X = (vDir.X * t0) + vPuck.X: vInt1.z = (vDir.z * t0) + vPuck.z
+    vInt2.X = (vDir.X * t1) + vPuck.X: vInt2.z = (vDir.z * t1) + vPuck.z
+    'Find the difference from the starting location
+    D3DXVec3Subtract vDifInt1, oPaddle.Position, vInt1
+    D3DXVec3Subtract vDifInt2, oPaddle.Position, vInt2
+        
+    'Find the smallest t
+    'If t0 > t1 Then
+    If D3DXVec3Length(vDifInt1) < D3DXVec3Length(vDifInt2) Then
+        tSmall = t1
+    Else
+        tSmall = t0
+    End If
+    'Let's get the intersected point
+    vIntersect.X = (vDir.X * tSmall) + vPuck.X
+    vIntersect.z = (vDir.z * tSmall) + vPuck.z
+    
+    'Create a new vector with an enormously high Y field to create our reflection plane
+    vIntersectHigh = vIntersect
+    vIntersectHigh.Y = 500
+    'Let's create a plane from this point
+    D3DXPlaneFromPoints oPlane, vec3(0, 0, 0), vIntersect, vIntersectHigh
+    
+    'Now we can create a reflection matrix based on this plane
+    D3DXMatrixReflect matReflect, oPlane
+    'Create a new point that is reflected
+    D3DXVec3TransformCoord oPoint, vPuck, matReflect
+    D3DXVec3Subtract vNewVelDir, oPoint, vIntersect
+    'Normalize the vector
+    D3DXVec3Normalize vNewVelDir, vNewVelDir
+    vNewVelDir.X = -vNewVelDir.X
+    vNewVelDir.z = -vNewVelDir.z
+    D3DXVec3Scale moVelocity, vNewVelDir, nVelocity
+    If nVelocityPaddle > 0 Then 'The paddle is moving, add it's velocity
+        'Now let's add the velocity of the paddle to our resulting velocity
+        D3DXVec3Normalize vNewVelPad, oPaddle.Velocity
+        D3DXVec3Scale vNewVelPad, vNewVelPad, nVelocityPaddle
+        D3DXVec3Add moVelocity, moVelocity, vNewVelPad
+    End If
+    Debug.Print "Old Velocity:"; nVelocity; "  - New Velocity:"; D3DXVec3Length(moVelocity)
+    'If we are limiting the velocity to it's maximum (most times), do so
+    If Not fIgnoreMax Then EnsurePuckVelocityIsBelowMax
+End Sub
+
+Public Sub CheckCollisions(oPaddle() As cPaddle, Optional oAudio As cAudio = Nothing)
+    'First we should check to see if we are scoring in this frame.
+    Dim nDistance As Single
+    Dim lCount As Long, fCollided As Boolean
+    Dim lCollided As Long, nCollideDist As Single
+    
+    If gfScored Then Exit Sub
+    'Check to see if the puck has collided with any of the walls
+    'We could do an exhaustive check to see if any of the polygons collide, but since the table
+    'is static, in the name of faster calculations, we will use a group of constants defining the
+    'edges of the walls.  We will check those instead.
+        
+    'If the puck does hit one of the walls, we can easily calculate it's new direction by simply reversing
+    'it's velocity (of that vector).  If we want to be even more accurate we can lower the velocity by a small amount as well
+    
+    'The left and right walls are bound to the X axis
+    If moPosition.X > (gnSideLeftWallEdge - (gnPuckRadius)) Then
+        'We hit the wall
+        'Reverse the velocity of the X axis
+        moVelocity = vec3((moVelocity.X * -1) * gnVelocityDamp, 0, moVelocity.z)
+        moPosition = vec3((gnSideLeftWallEdge - (gnPuckRadius)), moPosition.Y, moPosition.z)
+        If Not (oAudio Is Nothing) Then oAudio.PlayBankSound
+        gfRecentlyHitPaddle = False
+    ElseIf moPosition.X < (gnSideRightWallEdge + (gnPuckRadius)) Then
+        'We hit the wall
+        moVelocity = vec3((moVelocity.X * -1) * gnVelocityDamp, 0, moVelocity.z)
+        moPosition = vec3((gnSideRightWallEdge + (gnPuckRadius)), moPosition.Y, moPosition.z)
+        If Not (oAudio Is Nothing) Then oAudio.PlayBankSound
+        gfRecentlyHitPaddle = False
+    End If
+    
+    'The front and rear walls are count to the Z axis
+    If moPosition.z > (gnNearWallEdge - (gnPuckRadius)) Then
+        'Only reverse the velocity if we hit the sides of the 'scoring area'
+        If (moPosition.X > (gnScoringEdgeLeft - (gnPuckRadius))) Or (moPosition.X < (gnScoringEdgeRight + (gnPuckRadius))) Then
+            'We hit the wall
+            'Reverse the velocity of the Z axis
+            moVelocity = vec3(moVelocity.X, 0, (moVelocity.z * -1) * gnVelocityDamp)
+            moPosition = vec3(moPosition.X, moPosition.Y, gnNearWallEdge - (gnPuckRadius))
+            If Not (oAudio Is Nothing) Then oAudio.PlayBankSound
+            gfRecentlyHitPaddle = False
+        End If
+    ElseIf moPosition.z < (gnFarWallEdge + (gnPuckRadius)) Then
+        If (moPosition.X > (gnScoringEdgeLeft - (gnPuckRadius))) Or (moPosition.X < (gnScoringEdgeRight - (gnPuckRadius))) Then
+            'We hit the wall
+            moVelocity = vec3(moVelocity.X, 0, (moVelocity.z * -1) * gnVelocityDamp)
+            moPosition = vec3(moPosition.X, moPosition.Y, gnFarWallEdge + (gnPuckRadius))
+            If Not (oAudio Is Nothing) Then oAudio.PlayBankSound
+            gfRecentlyHitPaddle = False
+        End If
+    End If
+    
+    'Next we should check to see if the puck has collided with either of the paddles
+    'We will use a simple formula to determine if the puck has collided with one of the
+    'paddles.  Simply put if the distance between the center of the puck, and the center
+    'of the paddle in question is greater than the radius of the puck + the radius of the
+    'paddle, they haven't collided
+    Dim vecDif As D3DVECTOR
+    
+    If ((timeGetTime - glPaddleCollideTime) > glMinDelayPaddleHit) Or (Not gfRecentlyHitPaddle) Then
+        gfRecentlyHitPaddle = False
+        For lCount = 0 To 1 'Both paddles
+            'We only check the X/Z coords because in this demo the puck will never leave the table
+            'so it will maintain a constant Y coord.
+            D3DXVec3Subtract vecDif, moPosition, oPaddle(lCount).Position
+            nDistance = D3DXVec3Length(vecDif)
+            If nDistance < (gnPaddleRadius + gnPuckRadius) Then 'They have collided
+                nCollideDist = nDistance
+                lCollided = lCount
+                fCollided = True
+                If gfMultiplayer Then
+                    'Let each client handle it's own collision detection
+                    'in a multiplayer game.  This balances the load between
+                    'the host machine, and the client machine and gives the
+                    'most realistic playing feel.
+                    If glMyPaddleID = lCount Then 'We collided with our paddle
+                        ChangePuckVelocity oPaddle(lCount), oAudio
+                        SendPuck
+                        SendCollidePaddle
+                    End If
+                Else
+                    ChangePuckVelocity oPaddle(lCount), oAudio
+                End If
+            End If
+        Next
+    End If
+    ' Make sure we aren't colliding anymore
+    If fCollided Then EnsurePuckIsNotInPaddle nCollideDist, oPaddle(lCollided)
+    'Lastly we should check if we have scored (on either side)
+    If gfMultiplayer And (Not gfHost) Then Exit Sub 'Only the host should check for scoring
+    If moPosition.z > (gnNearWallEdge) Then
+        'We scored!
+        goPuck.DropPuckIntoScoringPosition goAudio
+    ElseIf moPosition.z < (gnFarWallEdge) Then
+        'We scored!
+        goPuck.DropPuckIntoScoringPosition goAudio
+    End If
+End Sub
+
+Public Sub EnsurePuckIsNotInPaddle(ByVal nDistance As Single, oPaddle As cPaddle, Optional ByVal fSentPaddle As Boolean = False)
+    'Move the paddle back out so it's not hitting the puck
+    Dim vDir As D3DVECTOR, vScale As D3DVECTOR, vPaddleVel As D3DVECTOR
+
+    If fSentPaddle Then
+        D3DXVec3Subtract vPaddleVel, oPaddle.LastPosition, oPaddle.Position
+        'Get the direction vector by normalizing the paddle's velocity
+        D3DXVec3Normalize vDir, vPaddleVel
+    Else
+        'Get the direction vector by normalizing the pucks velocity
+        D3DXVec3Normalize vDir, moVelocity
+    End If
+    'Scale the vector, just enough to get it out of the paddle
+    D3DXVec3Scale vScale, vDir, (gnPuckRadius + gnPaddleRadius) - nDistance
+    'Move the puck to it's new location
+    D3DXVec3Add moPosition, moPosition, vScale
+    'Now, let's increase the pucks velocity that much as well..
+    If fSentPaddle Then D3DXVec3Add moVelocity, moVelocity, vScale
+End Sub
+
+Private Sub UpdatePuckSpin()
+    Randomize
+    If Rnd > 0.5 Then
+        mnSpinDir = mnSpinDir * -1
+        'Update the spin, change speed from 75%-125% of current speed..
+        mnDefaultSpin = (Rnd * (mnSpinDir * 0.75)) + (mnSpinDir * 0.5)
+        If Abs(mnDefaultSpin) > mnMaxSpinSpeed Then
+            mnDefaultSpin = mnMaxSpinSpeed * (Abs(mnDefaultSpin) \ mnDefaultSpin)
+        End If
+    End If
+End Sub
+
+Public Sub CleanupFrame()
+    moPuck.Destroy
+    Set moPuck = Nothing
+End Sub
+
+Public Sub DropPuckIntoScoringPosition(oAudio As cAudio, Optional ByVal fFromReceive As Boolean = False)
+    
+    gfScored = True
+    glTimeCompPaddle = 0
+    If Not gfMultiplayer Then
+        With goPaddle(1).Velocity
+            .X = 0: .z = 0
+        End With
+    End If
+    glTimePuckScored = timeGetTime
+    oAudio.PlayScoreSound
+    If gfMultiplayer Then
+        If Not gfHost And Not fFromReceive Then Exit Sub
+    End If
+    'First stop the velocity
+    moVelocity = vec3(0, 0, 0)
+    
+    With moPosition
+        'Now position the puck
+        If .z < 0 Then
+            gPlayer(1).Score = gPlayer(1).Score + 1
+            .z = gnFarWallEdge - 1.2
+        ElseIf .z > 0 Then
+            .z = gnNearWallEdge + 1.2
+            gPlayer(0).Score = gPlayer(0).Score + 1
+        End If
+        If Abs(.X) > gnScoringEdgeLeft / 3 Then
+            If Abs(.X) <> .X Then
+                .X = gnScoringEdgeRight / 3
+            Else
+                .X = gnScoringEdgeLeft / 3
+            End If
+        End If
+        .Y = gnPuckScored
+    End With
+    
+    Spinning = False
+    'If we are the host, notify everyone that we've scored
+    If gfMultiplayer Then NotifyPlayersWeScored
+    
+End Sub
+
+Public Function FadeMesh(FadeInterval As Single) As Boolean
+    Dim lNumMaterial As Long
+    Dim lCount As Long
+    Dim oMaterial As D3DMATERIAL8
+    Dim fDoneFading As Boolean
+    Dim oMesh As CD3DMesh
+    Dim nInternalInterval As Single
+    Static lFadeTime As Long
+    
+    nInternalInterval = FadeInterval
+    If lFadeTime = 0 Then
+        lFadeTime = timeGetTime
+        Exit Function 'We'll do the fade next render pass
+    End If
+    nInternalInterval = (((timeGetTime - lFadeTime) / 1000000) * nInternalInterval)
+    
+    Set oMesh = moPuck.FindChildObject("puck", 0)
+    fDoneFading = True
+    lNumMaterial = oMesh.GetMaterialCount
+    For lCount = 0 To lNumMaterial - 1
+        oMaterial = oMesh.GetMaterial(lCount)
+        If nInternalInterval > 0 And oMaterial.diffuse.a <= 1 Then
+            oMaterial.diffuse.a = oMaterial.diffuse.a + nInternalInterval
+            fDoneFading = False
+        ElseIf nInternalInterval < 0 And oMaterial.diffuse.a >= -1 Then
+            oMaterial.diffuse.a = oMaterial.diffuse.a + nInternalInterval
+            fDoneFading = False
+        End If
+        oMesh.SetMaterial lCount, oMaterial
+    Next
+    FadeMesh = fDoneFading
+End Function
+
+Public Sub PauseSystem(ByVal fPause As Boolean)
+    If Not fPause Then
+        mlPuckTime = timeGetTime
+    End If
+End Sub
+
+'************
+'Private functions that the public subs here will call, but the main application doesn't need to know about
+
+Private Sub EnsurePuckVelocityIsBelowMax()
+    Dim VelVec As D3DVECTOR
+    'Let's make sure the puck's velocity isn't above the max,
+    'and if it is, lower it to the max velocity
+    If D3DXVec3Length(moVelocity) > MaximumPuckVelocity Then
+        'Yup, lower the velocity to the max
+        Dim vNrm As D3DVECTOR
+        
+        D3DXVec3Normalize vNrm, moVelocity
+        D3DXVec3Scale VelVec, vNrm, MaximumPuckVelocity
+        moVelocity = VelVec
+    End If
+End Sub
+
+Private Sub Class_Initialize()
+    mnSpinDir = 1
+    mnDefaultSpin = 0.15
+    Set moPuck = Nothing
+    DefaultStartPosition
+End Sub
+
+Private Sub Class_Terminate()
+    If Not moPuck Is Nothing Then moPuck.Destroy
+    Set moPuck = Nothing
+End Sub

Library/dxx8/samples/Multimedia/VBSamples/Demos/AirHockey/cRoom.cls

@@ -0,0 +1,121 @@
+VERSION 1.0 CLASS
+BEGIN
+  MultiUse = -1  'True
+  Persistable = 0  'NotPersistable
+  DataBindingBehavior = 0  'vbNone
+  DataSourceBehavior  = 0  'vbNone
+  MTSTransactionMode  = 0  'NotAnMTSObject
+END
+Attribute VB_Name = "cRoom"
+Attribute VB_GlobalNameSpace = False
+Attribute VB_Creatable = True
+Attribute VB_PredeclaredId = False
+Attribute VB_Exposed = False
+Option Explicit
+Private Const mnRoomX As Single = 0
+Private Const mnRoomY As Single = 2
+Private Const mnRoomZ As Single = 0
+
+Private Const mnBarRoomX As Single = 0
+Private Const mnBarRoomY As Single = -5
+Private Const mnBarRoomZ As Single = 0
+
+Private Const mnLobbyScaleX As Single = 8
+Private Const mnLobbyScaleY As Single = 5
+Private Const mnLobbyScaleZ As Single = 9
+
+Private moRoom As CD3DFrame               ' Our Room frame
+Private moOfficeRoom As CD3DFrame               ' Our Room frame
+
+Public DrawRoom As Boolean 'Should we draw the room at all
+Public BarRoom As Boolean 'Should we draw the bar or the MS lobby
+
+'Methods
+Public Sub Init(ByVal sMedia As String, sRoom As String, sLobby As String)
+    Set moRoom = D3DUtil_LoadFromFile(AddDirSep(sMedia) & sRoom, Nothing, Nothing)
+    Set moOfficeRoom = D3DUtil_LoadFromFile(AddDirSep(sMedia) & sLobby, Nothing, Nothing)
+End Sub
+
+Public Sub CleanupFrame()
+    If Not (moRoom Is Nothing) Then moRoom.Destroy
+    If Not (moOfficeRoom Is Nothing) Then moOfficeRoom.Destroy
+    Set moRoom = Nothing
+    Set moOfficeRoom = Nothing
+End Sub
+
+Public Sub Render(dev As Direct3DDevice8)
+    Dim matRoom As D3DMATRIX
+    Dim matScale As D3DMATRIX
+    
+    If DrawRoom Then
+        If BarRoom Then
+            'First the room
+            D3DXMatrixIdentity matRoom
+            D3DXMatrixTranslation matRoom, mnBarRoomX, mnBarRoomY, mnBarRoomZ
+            moRoom.SetMatrix matRoom
+            moRoom.Render g_dev
+        Else
+            'First the room
+            D3DXMatrixIdentity matRoom
+            D3DXMatrixTranslation matRoom, mnRoomX, mnRoomY, mnRoomZ
+            D3DXMatrixScaling matScale, mnLobbyScaleX, mnLobbyScaleY, mnLobbyScaleZ
+            D3DXMatrixMultiply matRoom, matRoom, matScale
+            moOfficeRoom.SetMatrix matRoom
+            moOfficeRoom.Render g_dev
+        End If
+    End If
+End Sub
+
+Public Function FadeMesh(FadeInterval As Single) As Boolean
+    Dim lNumMaterial As Long
+    Dim lCount As Long
+    Dim oMaterial As D3DMATERIAL8
+    Dim fDoneFading As Boolean
+    Dim oMesh As CD3DMesh
+    Dim nInternalInterval As Single
+    Static lFadeTime As Long
+    
+    FadeMesh = True
+    nInternalInterval = FadeInterval
+    If lFadeTime = 0 Then
+        lFadeTime = timeGetTime
+        Exit Function 'We'll do the fade next render pass
+    End If
+    nInternalInterval = (((timeGetTime - lFadeTime) / 1000000) * nInternalInterval)
+    
+    If Not DrawRoom Then Exit Function
+    fDoneFading = True
+    If BarRoom Then
+        Set oMesh = moRoom.FindChildObject("room", 0)
+    Else
+        Set oMesh = moOfficeRoom.FindChildObject("Unnamed_0", 0)
+    End If
+    lNumMaterial = oMesh.GetMaterialCount
+    For lCount = 0 To lNumMaterial - 1
+        oMaterial = oMesh.GetMaterial(lCount)
+        If nInternalInterval > 0 And oMaterial.diffuse.a <= 1 Then
+            oMaterial.diffuse.a = oMaterial.diffuse.a + nInternalInterval
+            fDoneFading = False
+        ElseIf nInternalInterval < 0 And oMaterial.diffuse.a >= -1 Then
+            oMaterial.diffuse.a = oMaterial.diffuse.a + nInternalInterval
+            fDoneFading = False
+        End If
+        oMesh.SetMaterial lCount, oMaterial
+    Next
+    FadeMesh = fDoneFading
+End Function
+
+
+Private Sub Class_Initialize()
+    DrawRoom = True
+    Set moRoom = Nothing
+    Set moOfficeRoom = Nothing
+End Sub
+
+Private Sub Class_Terminate()
+    If Not (moRoom Is Nothing) Then moRoom.Destroy
+    If Not (moOfficeRoom Is Nothing) Then moOfficeRoom.Destroy
+    
+    Set moRoom = Nothing
+    Set moOfficeRoom = Nothing
+End Sub

Library/dxx8/samples/Multimedia/VBSamples/Demos/AirHockey/cTable.cls

@@ -0,0 +1,120 @@
+VERSION 1.0 CLASS
+BEGIN
+  MultiUse = -1  'True
+  Persistable = 0  'NotPersistable
+  DataBindingBehavior = 0  'vbNone
+  DataSourceBehavior  = 0  'vbNone
+  MTSTransactionMode  = 0  'NotAnMTSObject
+END
+Attribute VB_Name = "cTable"
+Attribute VB_GlobalNameSpace = False
+Attribute VB_Creatable = True
+Attribute VB_PredeclaredId = False
+Attribute VB_Exposed = False
+Option Explicit
+
+'Here we will encapsulate all of the code needed for the table
+'Local variables for the properties of the table
+Private moPosition As D3DVECTOR 'Current position of the table
+Private moTable As CD3DFrame 'D3D Mesh for the table
+Private mlTransparantPaddle As Boolean
+Public DrawTable As Boolean ' You can also turn off the table (dunno why, but let'em)
+
+'Position property
+Public Property Let Position(oPos As D3DVECTOR)
+    moPosition = oPos
+End Property
+
+Public Property Get Position() As D3DVECTOR
+    Position = moPosition
+End Property
+
+'Transparent property
+Public Property Let Transparent(ByVal fTrans As Boolean)
+    Dim oMesh As CD3DMesh, oMaterial As D3DMATERIAL8
+    Dim lNumMaterial As Long, lCount As Long
+    
+    mlTransparantPaddle = fTrans
+    'now set the property
+    Set oMesh = moTable.FindChildObject("table", 0)
+    lNumMaterial = oMesh.GetMaterialCount
+    For lCount = 0 To lNumMaterial - 1
+        oMaterial = oMesh.GetMaterial(lCount)
+        If fTrans Then
+            oMaterial.diffuse.a = 0.5
+        Else
+            oMaterial.diffuse.a = 1
+        End If
+        oMesh.SetMaterial lCount, oMaterial
+    Next
+End Property
+
+Public Property Get Transparent() As Boolean
+    Transparent = mlTransparantPaddle
+End Property
+
+'Methods
+Public Sub Init(ByVal sMedia As String, sFile As String)
+    Set moTable = D3DUtil_LoadFromFile(AddDirSep(sMedia) & sFile, Nothing, Nothing)
+End Sub
+
+Public Sub Render(dev As Direct3DDevice8)
+    Dim matTable As D3DMATRIX
+    If DrawTable Then
+        'Now the table
+        D3DXMatrixIdentity matTable
+        D3DXMatrixTranslation matTable, moPosition.X, moPosition.Y, moPosition.z
+        moTable.SetMatrix matTable
+        moTable.Render g_dev
+    End If
+End Sub
+
+Public Sub CleanupFrame()
+    moTable.Destroy
+    Set moTable = Nothing
+End Sub
+
+Public Function FadeMesh(FadeInterval As Single) As Boolean
+    Dim lNumMaterial As Long
+    Dim lCount As Long
+    Dim oMaterial As D3DMATERIAL8
+    Dim fDoneFading As Boolean
+    Dim oMesh As CD3DMesh
+    Dim nInternalInterval As Single
+    Static lFadeTime As Long
+    
+    FadeMesh = True
+    nInternalInterval = FadeInterval
+    If lFadeTime = 0 Then
+        lFadeTime = timeGetTime
+        Exit Function 'We'll do the fade next render pass
+    End If
+    nInternalInterval = (((timeGetTime - lFadeTime) / 1000000) * nInternalInterval)
+    
+    fDoneFading = True
+    If Not DrawTable Then Exit Function
+    Set oMesh = moTable.FindChildObject("table", 0)
+    lNumMaterial = oMesh.GetMaterialCount
+    For lCount = 0 To lNumMaterial - 1
+        oMaterial = oMesh.GetMaterial(lCount)
+        If nInternalInterval > 0 And oMaterial.diffuse.a <= 1 Then
+            oMaterial.diffuse.a = oMaterial.diffuse.a + nInternalInterval
+            fDoneFading = False
+        ElseIf nInternalInterval < 0 And oMaterial.diffuse.a >= -1 Then
+            oMaterial.diffuse.a = oMaterial.diffuse.a + nInternalInterval
+            fDoneFading = False
+        End If
+        oMesh.SetMaterial lCount, oMaterial
+    Next
+    FadeMesh = fDoneFading
+End Function
+
+Private Sub Class_Initialize()
+    DrawTable = True
+    Set moTable = Nothing
+End Sub
+
+Private Sub Class_Terminate()
+    If Not moTable Is Nothing Then moTable.Destroy
+    Set moTable = Nothing
+End Sub

Library/dxx8/samples/Multimedia/VBSamples/Demos/AirHockey/cText.cls

@@ -0,0 +1,56 @@
+VERSION 1.0 CLASS
+BEGIN
+  MultiUse = -1  'True
+  Persistable = 0  'NotPersistable
+  DataBindingBehavior = 0  'vbNone
+  DataSourceBehavior  = 0  'vbNone
+  MTSTransactionMode  = 0  'NotAnMTSObject
+END
+Attribute VB_Name = "cText"
+Attribute VB_GlobalNameSpace = False
+Attribute VB_Creatable = True
+Attribute VB_PredeclaredId = False
+Attribute VB_Exposed = False
+Option Explicit
+'Helper class to encapsulate text drawing
+
+'Here we will keep the font information and the calls to draw the text
+Private moD3DXFont As D3DXFont
+
+Public Sub InitText(d3dx As D3DX8, dev As Direct3DDevice8, ByVal sFontName As String, lSize As Long, fBold As Boolean)
+    Dim oMyFont As IFont
+    
+    Set oMyFont = New StdFont
+    oMyFont.Name = "Times New Roman"
+    oMyFont.size = 8
+    oMyFont.Bold = True
+    
+    Set moD3DXFont = d3dx.CreateFont(dev, oMyFont.hFont)
+
+End Sub
+
+Public Sub BeginText()
+    moD3DXFont.Begin
+End Sub
+
+Public Sub EndText()
+    moD3DXFont.End
+End Sub
+
+Public Sub DrawText(ByVal sText As String, X As Long, Y As Long, lColor As Long)
+    Dim rcText As RECT
+    
+    'X and Y are in screen coords
+    rcText.Left = X
+    rcText.Top = Y
+    'actually draw the text now, telling d3dx to build the rectangle based on the text and the x,y coord
+    moD3DXFont.DrawTextW sText, -1, rcText, 0, lColor
+End Sub
+
+Private Sub Class_Initialize()
+    Set moD3DXFont = Nothing
+End Sub
+
+Private Sub Class_Terminate()
+    Set moD3DXFont = Nothing
+End Sub

Library/dxx8/samples/Multimedia/VBSamples/Demos/AirHockey/d3dAnimation.cls

@@ -0,0 +1,572 @@
+VERSION 1.0 CLASS
+BEGIN
+  MultiUse = -1  'True
+  Persistable = 0  'NotPersistable
+  DataBindingBehavior = 0  'vbNone
+  DataSourceBehavior  = 0  'vbNone
+  MTSTransactionMode  = 0  'NotAnMTSObject
+END
+Attribute VB_Name = "CD3DAnimation"
+Attribute VB_GlobalNameSpace = False
+Attribute VB_Creatable = True
+Attribute VB_PredeclaredId = False
+Attribute VB_Exposed = False
+
+'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
+'
+'  Copyright (C) 1999-2001 Microsoft Corporation.  All Rights Reserved.
+'
+'  File:       D3DAnimation.cls
+'  Content:    D3D Visual Basic Framework Animation Class
+'
+'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
+
+Option Explicit
+
+Public ObjectName As String
+
+Private Type KEYHEADER
+    keytype As Long
+    keycount As Long
+End Type
+
+Private Type RMROTATEKEY
+    time As Long
+    nFloats As Long
+    w As Single
+    x As Single
+    y As Single
+    z As Single
+End Type
+
+Private Type D3DMATRIXKEY
+    time As Long
+    nFloats As Long
+    matrix As D3DMATRIX
+End Type
+
+
+Const kAnimGrowSize = 10
+
+Dim m_RotateKeys() As D3DROTATEKEY
+Dim m_ScaleKeys() As D3DVECTORKEY
+Dim m_PositionKeys() As D3DVECTORKEY
+Dim m_RMRotateKeys() As RMROTATEKEY
+Dim m_MatrixKeys() As D3DMATRIXKEY
+
+Dim m_NumRotateKeys As Long
+Dim m_NumScaleKeys As Long
+Dim m_NumPositionKeys As Long
+Dim m_NumMatrixKeys As Long
+Dim m_strFrameName As String
+Dim m_frame As CD3DFrame
+Dim m_iMatrixKey As Long
+
+
+Dim m_Children() As CD3DAnimation
+Dim m_NumChildren As Long
+Dim m_MaxChildren As Long
+
+'-----------------------------------------------------------------------------
+' Name: ParseAnimSet
+' Desc: called from D3DUtil_LoadFromFile
+'-----------------------------------------------------------------------------
+Friend Sub ParseAnimSet(FileData As DirectXFileData, parentFrame As CD3DFrame)
+    On Local Error Resume Next
+    ObjectName = FileData.GetName()
+    
+    Dim ChildData As DirectXFileData
+    Dim NewAnim As CD3DAnimation
+    Dim ChildObj As DirectXFileObject
+    Dim ChildRef As DirectXFileReference
+    
+    Set ChildObj = FileData.GetNextObject()
+    
+     Do While Not ChildObj Is Nothing
+    
+        Set ChildData = ChildObj
+        If Err.Number = 0 Then
+  
+            If ChildData.GetType = "TID_D3DRMAnimation" Then
+                Set NewAnim = New CD3DAnimation
+                AddChild NewAnim
+                NewAnim.ParseAnim ChildData, Me, parentFrame
+            End If
+        End If
+        
+        Err.Clear
+        Set ChildRef = ChildObj
+        
+        If Err.Number = 0 Then
+            Set ChildData = ChildRef.Resolve
+           
+            Set NewAnim = New CD3DAnimation
+            AddChild NewAnim
+            NewAnim.ParseAnim ChildData, Me, parentFrame
+        End If
+        
+        Err.Clear
+        
+        Set ChildObj = FileData.GetNextObject()
+    Loop
+    
+End Sub
+
+'-----------------------------------------------------------------------------
+' Name: GetChild
+' Desc: return child Animation
+'-----------------------------------------------------------------------------
+
+Public Function GetChild(i As Long) As CD3DAnimation
+    Set GetChild = m_Children(i)
+End Function
+
+'-----------------------------------------------------------------------------
+' Name: GetChildCount
+' Desc: return number of child animations
+'-----------------------------------------------------------------------------
+
+Public Function GetChildCount() As Long
+    GetChildCount = m_NumChildren
+End Function
+
+
+'-----------------------------------------------------------------------------
+' Name: AddChild
+' Desc: Add child animation
+'-----------------------------------------------------------------------------
+
+Public Sub AddChild(child As CD3DAnimation)
+    If child Is Nothing Then Exit Sub
+    
+    If m_MaxChildren = 0 Then
+        m_MaxChildren = kAnimGrowSize
+        ReDim m_Children(m_MaxChildren)
+    ElseIf m_NumChildren >= m_MaxChildren Then
+        m_MaxChildren = m_MaxChildren + kAnimGrowSize
+        ReDim Preserve m_Children(m_MaxChildren)
+    End If
+    
+    Set m_Children(m_NumChildren) = child
+    m_NumChildren = m_NumChildren + 1
+End Sub
+
+
+'-----------------------------------------------------------------------------
+' Name: SetFrame
+' Desc: set Frame to be animated
+'-----------------------------------------------------------------------------
+Public Sub SetFrame(frame As CD3DFrame)
+    Set m_frame = frame
+    m_strFrameName = frame.ObjectName
+End Sub
+
+'-----------------------------------------------------------------------------
+' Name: GetFrame
+' Desc: return frame being animated
+'-----------------------------------------------------------------------------
+Public Function GetFrame() As CD3DFrame
+    Set GetFrame = m_frame
+End Function
+
+
+'-----------------------------------------------------------------------------
+' Name: ParseAnim
+' Desc: Called by ParseAnimSet
+'-----------------------------------------------------------------------------
+
+Friend Sub ParseAnim(FileData As DirectXFileData, parentAnimation As CD3DAnimation, parentFrame As CD3DFrame)
+    On Local Error Resume Next
+    ObjectName = FileData.GetName()
+    
+    Dim dataSize As Long
+    Dim KeyHead As KEYHEADER
+    Dim size As Long
+    Dim newFrame As CD3DFrame
+    Dim ChildObj As DirectXFileObject
+    Dim ChildData As DirectXFileData
+    Dim ChildReference As DirectXFileReference
+    Dim strChunkType As String
+    Dim i As Long
+    
+    Set ChildObj = FileData.GetNextObject()
+    
+    Do While Not ChildObj Is Nothing
+    
+        Set ChildReference = ChildObj
+        If Err.Number = 0 Then
+        
+            Set ChildData = ChildReference.Resolve()
+                    
+            
+            If ChildData.GetType = "TID_D3DRMFrame" Then
+                m_strFrameName = ChildData.GetName()
+                Set m_frame = parentFrame.FindChildObject(m_strFrameName, 0)
+            End If
+            
+            Set ChildReference = Nothing
+        End If
+        Err.Clear
+        
+        Set ChildData = ChildObj
+        If Err.Number = 0 Then
+        
+            strChunkType = ChildData.GetType
+            Select Case strChunkType
+                Case "TID_D3DRMFrame"
+                    Set newFrame = New CD3DFrame
+                    newFrame.InitFromXOF g_dev, ChildData, parentFrame
+                    Set newFrame = Nothing
+                
+                Case "TID_D3DRMAnimationOptions"
+                    
+                Case "TID_D3DRMAnimationKey"
+                    dataSize = ChildData.GetDataSize("")
+                    ChildData.GetDataFromOffset "", 0, 8, KeyHead
+
+                    Select Case KeyHead.keytype
+                        Case 0      'ROTATEKEY
+                            ReDim m_RMRotateKeys(KeyHead.keycount)
+                            ReDim m_RotateKeys(KeyHead.keycount)
+                            size = Len(m_RMRotateKeys(0)) * KeyHead.keycount
+                            ChildData.GetDataFromOffset "", 8, size, m_RMRotateKeys(0)
+                            m_NumRotateKeys = KeyHead.keycount
+                            
+                            'NOTE x files are w x y z and QUATERNIONS are x y z w
+                            'so we loop through on load and copy the values
+                            For i = 0 To m_NumRotateKeys - 1
+                                With m_RotateKeys(i)
+                                    .time = m_RMRotateKeys(i).time
+                                    If g_InvertRotateKey Then
+                                        .quat.w = -m_RMRotateKeys(i).w
+                                    Else
+                                        .quat.w = m_RMRotateKeys(i).w
+                                    End If
+                                    .quat.x = m_RMRotateKeys(i).x
+                                    .quat.y = m_RMRotateKeys(i).y
+                                    .quat.z = m_RMRotateKeys(i).z
+                                End With
+                            Next
+                            ReDim m_RMRotateKeys(0)
+                            
+                        Case 1      'SCALE KEY
+                            ReDim m_ScaleKeys(KeyHead.keycount)
+                            size = Len(m_ScaleKeys(0)) * KeyHead.keycount
+                            ChildData.GetDataFromOffset "", 8, size, m_ScaleKeys(0)
+                            m_NumScaleKeys = KeyHead.keycount
+                
+                        Case 2      'POSITION KEY
+                            ReDim m_PositionKeys(KeyHead.keycount)
+                            size = Len(m_PositionKeys(0)) * KeyHead.keycount
+                            ChildData.GetDataFromOffset "", 8, size, m_PositionKeys(0)
+                            m_NumPositionKeys = KeyHead.keycount
+                            
+                        Case 4      'MATRIX KEY
+                            ReDim m_MatrixKeys(KeyHead.keycount)
+                            size = Len(m_MatrixKeys(0)) * KeyHead.keycount
+                            ChildData.GetDataFromOffset "", 8, size, m_MatrixKeys(0)
+                            m_NumMatrixKeys = KeyHead.keycount
+                            
+                End Select
+
+                    
+            End Select
+        End If
+                    
+        Set ChildData = Nothing
+        Set ChildReference = Nothing
+        
+        Set ChildObj = FileData.GetNextObject()
+    Loop
+          
+
+
+End Sub
+
+
+
+'-----------------------------------------------------------------------------
+' Name: ComputeP1234
+' Desc: Aux function to compute 4 nearest keys
+'-----------------------------------------------------------------------------
+Private Sub ComputeP1234(j As Long, maxNum As Long, ByRef p1 As Long, ByRef p2 As Long, ByRef p3 As Long, ByRef p4 As Long)
+
+        p1 = j: p2 = j: p3 = j: p4 = j
+            
+            If j > 0 Then
+                p1 = j - 2: p2 = j - 1
+            End If
+            If j = 1 Then
+                p1 = j - 1: p2 = j - 1
+            End If
+            If j < (maxNum) - 1 Then p4 = j + 1
+End Sub
+        
+        
+'-----------------------------------------------------------------------------
+' Name: SetTime
+' Desc: Sets the matrix of the frame being animated
+'-----------------------------------------------------------------------------
+Public Sub SetTime(t As Single)
+    Dim t2 As Single
+    Dim i As Long, j As Long
+    Dim p1 As Long, p2 As Long, p3 As Long, p4 As Long
+    Dim f1 As Single, f2 As Single, f3 As Single, f4 As Single
+    Dim rM As D3DMATRIX, rQuat As D3DQUATERNION, rPos As D3DVECTOR, rScale As D3DVECTOR
+
+    Dim a As D3DVECTOR, b As D3DVECTOR
+    Dim q1 As D3DQUATERNION, q2 As D3DQUATERNION
+    Dim s As Single
+    
+    Dim child As CD3DAnimation
+    Dim LastT As Single
+    
+    'Check children
+    For i = 1 To m_NumChildren
+        Set child = m_Children(i - 1)
+        If Not child Is Nothing Then
+            child.SetTime t
+        End If
+        Set child = Nothing
+    Next
+        
+    If m_frame Is Nothing Then Exit Sub
+    
+    'set components to identity  incase we dont have any keys.
+    D3DXMatrixIdentity rM
+    rScale = vec3(1, 1, 1)
+    
+    D3DXQuaternionIdentity rQuat
+        
+    
+    t2 = t
+    
+    'loop matrix keys
+    If m_NumMatrixKeys > 0 Then
+        t2 = t
+        LastT = m_MatrixKeys(m_NumMatrixKeys - 1).time
+        If t > LastT Then
+            i = t \ LastT
+            t2 = t - i * LastT
+        Else
+            
+        End If
+       
+       
+        'optimizations
+        Dim tAt As Single, tNext1 As Single, tNext2 As Single
+        
+        If m_iMatrixKey < m_NumMatrixKeys - 2 Then
+            tAt = m_MatrixKeys(m_iMatrixKey).time
+            tNext1 = m_MatrixKeys(m_iMatrixKey + 1).time
+            tNext2 = m_MatrixKeys(m_iMatrixKey + 2).time
+            If tAt < t2 And t2 <= tNext1 Then Exit Sub
+               
+            If tNext1 < t2 And t2 <= tNext2 Then
+               m_iMatrixKey = m_iMatrixKey + 1
+               If m_iMatrixKey > m_NumMatrixKeys Then m_iMatrixKey = 0
+               m_frame.SetMatrix m_MatrixKeys(m_iMatrixKey).matrix
+            End If
+
+        End If
+        
+        'linear search
+        For i = 1 To m_NumMatrixKeys
+            If m_MatrixKeys(i - 1).time > t2 Then
+                m_frame.SetMatrix m_MatrixKeys(i - 1).matrix
+                m_iMatrixKey = i - 1
+           
+                Exit Sub
+            End If
+        Next
+        
+     End If
+    
+    '.................
+    
+    
+    'loop position keys
+    If m_NumPositionKeys > 0 Then
+        t2 = t
+        LastT = m_PositionKeys(m_NumPositionKeys - 1).time
+        If t > LastT Then
+            i = t \ LastT
+            t2 = t - i * LastT
+        End If
+    End If
+    
+    'Check Position Keys
+    For i = 1 To m_NumPositionKeys
+        j = i - 1
+        
+        If m_PositionKeys(j).time > t2 Then
+                
+            ComputeP1234 j, m_NumPositionKeys, p1, p2, p3, p4
+            f1 = m_PositionKeys(p1).time
+            f2 = m_PositionKeys(p2).time
+            f3 = m_PositionKeys(p3).time
+            f4 = m_PositionKeys(p4).time
+                            
+                
+            If ((f3 - f2) = 0) Then
+                s = 1
+            Else
+                s = (t2 - f2) / (f3 - f2)
+            End If
+    
+            a = m_PositionKeys(p2).vec
+            b = m_PositionKeys(p3).vec
+            
+            
+            D3DXVec3Lerp rPos, a, b, s
+            Exit For
+        End If
+    Next
+        
+        
+        
+    'loop scale keys
+    If m_NumScaleKeys > 0 Then
+        t2 = t
+        LastT = m_ScaleKeys(m_NumScaleKeys - 1).time
+        If t > LastT Then
+            i = t \ LastT
+            t2 = t - i * LastT
+        End If
+    End If
+        
+        
+    'Check Scale Keys
+    For i = 1 To m_NumScaleKeys
+        j = i - 1
+        If m_ScaleKeys(j).time > t2 Then
+                
+            ComputeP1234 j, m_NumScaleKeys, p1, p2, p3, p4
+            f1 = m_ScaleKeys(p1).time
+            f2 = m_ScaleKeys(p2).time
+            f3 = m_ScaleKeys(p3).time
+            f4 = m_ScaleKeys(p4).time
+                
+            If ((f3 - f2) = 0) Then
+                s = 1
+            Else
+                s = (t2 - f2) / (f3 - f2)
+            End If
+    
+            a = m_ScaleKeys(p2).vec
+            b = m_ScaleKeys(p3).vec
+            
+            
+            D3DXVec3Lerp rScale, a, b, s
+            Exit For
+        End If
+    Next
+        
+
+    'loop rotate keys
+    If m_NumRotateKeys > 0 Then
+        t2 = t
+        LastT = m_RotateKeys(m_NumRotateKeys - 1).time
+        If t > LastT Then
+            i = t \ LastT
+            t2 = t - i * LastT
+        End If
+    End If
+                
+    'Check Rotate Keys
+    For i = 1 To m_NumRotateKeys
+        j = i - 1
+            
+        If m_RotateKeys(j).time > t2 Then
+            
+            
+            
+            ComputeP1234 j, m_NumRotateKeys, p1, p2, p3, p4
+            f1 = m_RotateKeys(p1).time
+            f2 = m_RotateKeys(p2).time
+            f3 = m_RotateKeys(p3).time
+            f4 = m_RotateKeys(p4).time
+                
+            If ((f3 - f2) = 0) Then
+                s = 1
+            Else
+                s = (t2 - f2) / (f3 - f2)
+            End If
+    
+            q1 = m_RotateKeys(p2).quat
+            q2 = m_RotateKeys(p3).quat
+            
+            D3DXQuaternionSlerp rQuat, q1, q2, s
+            Exit For
+        End If
+    Next
+        
+    Dim temp1 As D3DMATRIX
+    Dim temp2 As D3DMATRIX
+    Dim temp3 As D3DMATRIX
+    
+    D3DXMatrixScaling temp1, rScale.x, rScale.y, rScale.z
+    D3DXMatrixRotationQuaternion temp2, rQuat
+    D3DXMatrixTranslation temp3, rPos.x, rPos.y, rPos.z
+    D3DXMatrixMultiply rM, temp1, temp2
+    D3DXMatrixMultiply rM, rM, temp3
+        
+    m_frame.SetMatrix rM
+    
+End Sub
+
+
+'-----------------------------------------------------------------------------
+' Name: AddRotateKey
+' Desc:
+'-----------------------------------------------------------------------------
+
+Sub AddRotateKey(t As Long, quat As D3DQUATERNION)
+
+    ReDim Preserve m_RotateKeys(m_NumRotateKeys)
+                   
+    With m_RotateKeys(m_NumRotateKeys)
+        .time = t
+        .quat = quat
+    End With
+    m_NumRotateKeys = m_NumRotateKeys + 1
+End Sub
+
+'-----------------------------------------------------------------------------
+' Name: AddScaleKey
+' Desc:
+'-----------------------------------------------------------------------------
+                            
+Sub AddScaleKey(t As Long, scalevec As D3DVECTOR)
+
+    ReDim Preserve m_ScaleKeys(m_NumScaleKeys)
+    
+    
+                   
+    With m_ScaleKeys(m_NumScaleKeys)
+        .time = t
+        .vec = scalevec
+    End With
+    
+    m_NumScaleKeys = m_NumScaleKeys + 1
+End Sub
+                        
+'-----------------------------------------------------------------------------
+' Name: AddPositionKey
+' Desc:
+'-----------------------------------------------------------------------------
+Sub AddPositionKey(t As Long, posvec As D3DVECTOR)
+
+    ReDim Preserve m_PositionKeys(m_NumPositionKeys)
+    
+   
+                   
+    With m_PositionKeys(m_NumPositionKeys)
+        .time = t
+        .vec = posvec
+    End With
+    m_NumPositionKeys = m_NumPositionKeys + 1
+End Sub
+
+
+

Library/dxx8/samples/Multimedia/VBSamples/Demos/AirHockey/d3dMesh.cls

@@ -0,0 +1,745 @@
+VERSION 1.0 CLASS
+BEGIN
+  MultiUse = -1  'True
+  Persistable = 0  'NotPersistable
+  DataBindingBehavior = 0  'vbNone
+  DataSourceBehavior  = 0  'vbNone
+  MTSTransactionMode  = 0  'NotAnMTSObject
+END
+Attribute VB_Name = "CD3DMesh"
+Attribute VB_GlobalNameSpace = False
+Attribute VB_Creatable = True
+Attribute VB_PredeclaredId = False
+Attribute VB_Exposed = False
+
+'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
+'
+'  Copyright (C) 1999-2001 Microsoft Corporation.  All Rights Reserved.
+'
+'  File:       D3DMesh.cls
+'  Content:    D3D VB Framework Mesh
+'
+'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
+
+
+Option Explicit
+
+Private Type BoneComboIdList
+    List(4) As Long
+End Type
+
+
+' Base Objects
+Public mesh As D3DXMesh                         'if not skinned, regular mesh object
+Public skinmesh As D3DXSkinMesh                 'if skinned - skinned mesh object
+Public bUseMaterials As Boolean                 'Use materials in object
+Public bUseMaterialOverride As Boolean          'Use only override material
+Public ObjectName As String                     'Name of object
+Public bSkinned As Boolean                      'Inidicates if the object is a skin
+
+' Culling objects
+Dim m_SphereCenter As D3DVECTOR                 'center of bounding sphere
+Public SphereRadius As Single                   'radius of bounding sphere
+Public bHasSphere As Boolean                    'Inidcatges if bounding sphere is calculated
+
+' Material and Adjacency information
+Dim m_MaterialOverride As D3DMATERIAL8          'Override material to use if bUseMaterialOverride set
+Dim m_NumMaterials As Long                      'Number of materials in object
+Dim m_Materials() As D3DMATERIAL8               'Material List
+Dim m_Textures() As Direct3DTexture8            'Texture List
+Dim m_TextureNames() As String                  'Texture List Names
+Dim m_AdjBuffer As D3DXBuffer                   'Adjacency buffer for the mesh
+
+
+' Bone and skinning informatin
+Dim m_BoneNames As D3DXBuffer                   'Names of Frame objects that are bones
+Dim m_BoneMatrices As D3DXBuffer                'Matrix object per bone
+Dim m_BoneComboTable As D3DXBuffer              'Groupings of bone material and triangles
+Dim m_BoneFrames() As CD3DFrame                 'Frame objects that are bones
+Dim m_maxFaceInfl As Long                       'Number of matrices that will influence a vertex
+Dim m_worldMatHandles(4) As Long                'handle to multiple world matrices
+Dim m_BoneOffsetMat() As D3DMATRIX              'Bone offset matrices from D3DXBuffers
+Dim m_NumBoneCombos As Long                     'Size of bonecombo table
+Dim m_BoneCombos() As D3DXBONECOMBINATION       'Combo table as returned from D3DX
+Dim m_BoneComboIds() As BoneComboIdList         'BoneId portion of combotable
+Dim m_BoneCount As Long                         'Number of bones
+Dim m_bonesAttached As Boolean                  'Indicates if bones have been attached to the mesh
+
+'-----------------------------------------------------------------------------
+' Init
+'-----------------------------------------------------------------------------
+Sub Init()
+    bUseMaterials = True
+End Sub
+
+'-----------------------------------------------------------------------------
+' SphereCenter()
+' returns Sphere Center since D3DVECTOR can not be public variable return value
+'-----------------------------------------------------------------------------
+Property Get SphereCenter() As D3DVECTOR
+    SphereCenter = m_SphereCenter
+End Property
+
+'-----------------------------------------------------------------------------
+' Name: InitFromFile
+' Desc: Tries first to load mesh in current directory or using explicit path
+'       If that fails loads mesh from SDK media path
+'-----------------------------------------------------------------------------
+
+Public Function InitFromFile(dev As Direct3DDevice8, Name As String) As Boolean
+    Dim mtrlBuffer As D3DXBuffer
+    Dim strPath As String
+    Destroy
+    
+'    On Local Error Resume Next
+    Set m_AdjBuffer = Nothing
+    bSkinned = False
+    
+    Set mesh = g_d3dx.LoadMeshFromX(Name, D3DXMESH_MANAGED, dev, m_AdjBuffer, mtrlBuffer, m_NumMaterials)
+    If Err.Number <> 0 Then
+        Err.Clear
+        On Local Error GoTo ErrOut
+        strPath = g_mediaPath + Name
+        Set mesh = g_d3dx.LoadMeshFromX(strPath, D3DXMESH_MANAGED, dev, m_AdjBuffer, mtrlBuffer, m_NumMaterials)
+    
+    End If
+    
+    Call InitMaterials(g_dev, mtrlBuffer)
+    
+    InitFromFile = True
+    Exit Function
+    
+ErrOut:
+    InitFromFile = False
+End Function
+
+
+
+'-----------------------------------------------------------------------------
+' Name: InitFromXOF
+' Desc: Load mesh from data provided by XOF api
+'       Called from D3DUtil_LoadFromFile
+'-----------------------------------------------------------------------------
+
+Public Function InitFromXOF(dev As Direct3DDevice8, meshdata As DirectXFileData) As Boolean
+    Dim mtrlBuffer As D3DXBuffer
+    Dim bonename As String
+    Dim i As Long
+    Dim q As Long
+        
+        
+    Destroy
+    
+    
+    Set m_AdjBuffer = Nothing
+    Set m_BoneMatrices = Nothing
+    Set m_BoneNames = Nothing
+    Set mesh = Nothing
+    Set skinmesh = Nothing
+    Set m_BoneMatrices = Nothing
+    Set m_BoneComboTable = Nothing
+    
+    ObjectName = meshdata.GetName()
+    
+'    On Local Error GoTo errOut
+    bSkinned = False
+    
+    'Users can set this variable to TRUE try the skinned load path
+    If g_bLoadSkins = True Then
+        Set skinmesh = g_d3dx.LoadSkinMeshFromXof(meshdata, D3DXMESH_MANAGED, dev, m_AdjBuffer, mtrlBuffer, m_NumMaterials, m_BoneNames, m_BoneMatrices)
+        
+        
+        Dim pAdj As Long, AdjOut As D3DXBuffer
+        pAdj = m_AdjBuffer.GetBufferPointer
+        
+        m_BoneCount = skinmesh.GetNumBones()
+        
+        If m_BoneCount = 0 Then
+            
+            ''''''''''''''''''''''''''''''''''''''''''''''''''''
+            ' a skinned mesh with no bones is just a regular mesh
+            ''''''''''''''''''''''''''''''''''''''''''''''''''''
+            
+            bSkinned = False
+            Set mesh = skinmesh.GetOriginalMesh()
+            'Set skinmesh = Nothing
+            
+        Else
+        
+            '''''''''''''''''''''''''''''''''''''''''''''''
+            ' code specific to x files with skinning data in them
+            '''''''''''''''''''''''''''''''''''''''''''''''
+            
+            bSkinned = True
+            
+            Set mesh = skinmesh.ConvertToBlendedMesh(D3DXMESH_MANAGED, ByVal pAdj, ByVal 0, m_NumBoneCombos, m_BoneComboTable, ByVal 0&, Nothing)
+            Set m_AdjBuffer = Nothing
+            Set m_AdjBuffer = AdjOut
+            Set AdjOut = Nothing
+            
+            'retrieve number of influence (matrices) that a vertices could have
+            'we support up to 4 corresponding to the 4 world matrices that can be set
+            m_maxFaceInfl = skinmesh.GetMaxFaceInfluences()
+            
+            m_worldMatHandles(0) = D3DTS_WORLD
+            m_worldMatHandles(1) = D3DTS_WORLD1
+            m_worldMatHandles(2) = D3DTS_WORLD2
+            m_worldMatHandles(3) = D3DTS_WORLD3
+            
+            ReDim m_BoneCombos(m_NumBoneCombos)
+            ReDim m_BoneComboIds(m_NumBoneCombos)
+            
+            ' fill in our private table for bone combo data
+            ' this inidicates which bones (matrices) need to be blended
+            ' for a given subset in the mesh
+            For q = 0 To m_NumBoneCombos - 1
+                g_d3dx.BufferGetBoneCombo m_BoneComboTable, q, m_BoneCombos(q)
+                g_d3dx.BufferGetBoneComboBoneIds m_BoneComboTable, q, m_maxFaceInfl, m_BoneComboIds(q).List(0)
+            Next
+            Set m_BoneComboTable = Nothing
+                    
+            ' fill in our private table for bone offset matrices
+            ' these are the matrices that give the intitial displacement of mesh subsets
+            ' release the d3dx buffer to save memory
+            ReDim m_BoneOffsetMat(m_BoneCount)
+            g_d3dx.BufferGetData m_BoneMatrices, 0, Len(m_BoneOffsetMat(0)), m_BoneCount, m_BoneOffsetMat(0)
+            Set m_BoneMatrices = Nothing
+            
+            
+        End If
+    Else
+    
+         Set mesh = g_d3dx.LoadMeshFromXof(meshdata, D3DXMESH_MANAGED, dev, m_AdjBuffer, mtrlBuffer, m_NumMaterials)
+         
+    End If
+    
+    
+    Call InitMaterials(g_dev, mtrlBuffer)
+    
+    InitFromXOF = True
+    Exit Function
+    
+ErrOut:
+    InitFromXOF = False
+End Function
+
+
+'-----------------------------------------------------------------------------
+' Name: AttatchBonesToMesh
+' Desc: Called to attach bones to a skin.
+'       The BoneNames table is used to search out bone frames
+'       in the children of the given parent frame
+'
+'       This must be done for any skinning animation to work
+'-----------------------------------------------------------------------------
+
+Friend Sub AttatchBonesToMesh(parent As CD3DFrame)
+      ' get links to all the frames (bones)
+        Dim i As Long
+        Dim bonename As String
+        ReDim m_BoneFrames(m_BoneCount)
+        For i = 0 To m_BoneCount - 1
+            bonename = g_d3dx.BufferGetBoneName(m_BoneNames, i)
+            Set m_BoneFrames(i) = parent.FindChildObject(bonename, 0)
+            If m_BoneFrames(i) Is Nothing Then
+                'Debug.Print "unable to find " + bonename
+                Stop
+            End If
+        Next
+        m_bonesAttached = True
+        Set m_BoneNames = Nothing
+End Sub
+
+
+'-----------------------------------------------------------------------------
+' Name: Optimize
+' Desc: Re-organize the mesh for better performance
+'
+'-----------------------------------------------------------------------------
+
+Sub Optimize()
+    Dim s As Long
+    Dim adjBuf1() As Long
+    Dim adjBuf2() As Long
+    Dim facemap() As Long
+    Dim newmesh As D3DXMesh
+    Dim vertexMap As D3DXBuffer
+    
+    s = m_AdjBuffer.GetBufferSize
+    ReDim adjBuf1(s / 4)
+    ReDim adjBuf2(s / 4)
+    
+    s = mesh.GetNumFaces
+    ReDim facemap(s)
+    
+    g_d3dx.BufferGetData m_AdjBuffer, 0, 4, s * 3, adjBuf1(0)
+    
+    Set newmesh = mesh.Optimize(D3DXMESHOPT_ATTRSORT Or D3DXMESHOPT_VERTEXCACHE, adjBuf1(0), adjBuf2(0), facemap(0), vertexMap)
+    
+    If Not newmesh Is Nothing Then
+        Set mesh = Nothing
+        Set mesh = newmesh
+    End If
+
+End Sub
+
+
+
+
+'-----------------------------------------------------------------------------
+' Name: InitMaterials
+' Desc: Helper function for creating mesh materials
+'       called after initialization
+'-----------------------------------------------------------------------------
+Private Sub InitMaterials(d3ddevice As Direct3DDevice8, mtrlBuffer As D3DXBuffer)
+    Dim i As Long
+    
+    If m_NumMaterials <= 0 Then Exit Sub
+    
+    ReDim m_Materials(m_NumMaterials)
+    ReDim m_Textures(m_NumMaterials)
+    ReDim m_TextureNames(m_NumMaterials)
+
+    For i = 0 To m_NumMaterials - 1
+        'copy material out of material buffer into our own structure
+        g_d3dx.BufferGetMaterial mtrlBuffer, i, m_Materials(i)
+
+        If g_bLoadNoAlpha Then m_Materials(i).diffuse.a = 1
+        
+        m_Materials(i).Ambient = m_Materials(i).diffuse
+        
+        m_TextureNames(i) = g_d3dx.BufferGetTextureName(mtrlBuffer, i)
+        
+        If g_bUseTextureLoadCallback Then
+            Set m_Textures(i) = g_TextureLoadCallback.TextureLoadCallback(m_TextureNames(i))
+        Else
+            Set m_Textures(i) = D3DUtil_CreateTextureInPool(g_dev, m_TextureNames(i), D3DFMT_UNKNOWN)
+        End If
+    Next
+    
+    
+End Sub
+
+
+
+'-----------------------------------------------------------------------------
+' Name: SetFVF
+' Desc: Change the FVF of the current mesh
+'----------------------------------------------------------------------------
+Public Sub SetFVF(dev As Direct3DDevice8, fvf As Long)
+    
+    Dim tempMesh As D3DXMesh
+    Dim verts() As D3DVERTEX
+
+    If mesh Is Nothing Then Exit Sub
+    
+    Set tempMesh = mesh.CloneMeshFVF(D3DXMESH_MANAGED, fvf, dev)
+    
+        
+    Set mesh = tempMesh
+    
+    
+End Sub
+
+'-----------------------------------------------------------------------------
+' Name: GenerateNormals
+' Desc: if the current mesh Flexible Vertex Format (FVF) has normals in it
+'       that are not initialized. This function will fill them.
+'       if no normals are present in the FVF this function will fire an
+'       exception
+'----------------------------------------------------------------------------
+Public Sub ComputeNormals()
+    Dim bm As D3DXBaseMesh
+    Set bm = mesh
+    g_d3dx.ComputeNormals bm
+End Sub
+
+
+'-----------------------------------------------------------------------------
+' Name: FlipNormals
+' Desc: Convenience function that flips normals for a D3DVERTEX mesh (default)
+'----------------------------------------------------------------------------
+Public Sub FlipNormals()
+    Dim count As Long
+    Dim size As Long
+    Dim i As Long
+    
+    Dim verts() As D3DVERTEX
+    
+    Dim vb As Direct3DVertexBuffer8
+    Set vb = mesh.GetVertexBuffer()
+    
+    
+    
+    
+    size = g_d3dx.GetFVFVertexSize(mesh.GetFVF())
+    count = mesh.GetNumVertices()
+    
+    
+    
+    If mesh.GetFVF() = D3DFVF_VERTEX Then
+        ReDim verts(count)
+        
+        D3DVertexBuffer8GetData vb, 0, size * count, 0, verts(0)
+        
+        For i = 0 To count - 1
+            verts(i).nx = -verts(i).nx
+            verts(i).ny = -verts(i).ny
+            verts(i).nz = -verts(i).nz
+        Next
+        
+        D3DVertexBuffer8SetData vb, 0, size * count, 0, verts(0)
+    Else
+        Stop
+    End If
+    
+
+End Sub
+
+
+'-----------------------------------------------------------------------------
+' Name: Translate
+' Desc: all vertices are moved by x,y,z
+'       note that object will still rotate about 0,0,0
+'
+'----------------------------------------------------------------------------
+Public Sub Translate(X As Single, Y As Single, z As Single)
+    Dim count As Long
+    Dim size As Long
+    Dim i As Long
+    
+    Dim verts() As D3DVERTEX
+    
+    Dim vb As Direct3DVertexBuffer8
+    Set vb = mesh.GetVertexBuffer()
+    
+    
+    
+    size = g_d3dx.GetFVFVertexSize(mesh.GetFVF())
+    count = mesh.GetNumVertices()
+
+    
+    If mesh.GetFVF() = D3DFVF_VERTEX Then
+        ReDim verts(count)
+        
+        D3DVertexBuffer8GetData vb, 0, size * count, 0, verts(0)
+        
+        For i = 0 To count - 1
+            verts(i).X = verts(i).X + X
+            verts(i).Y = verts(i).Y + Y
+            verts(i).z = verts(i).z + z
+        Next
+        
+        D3DVertexBuffer8SetData vb, 0, size * count, 0, verts(0)
+        
+    End If
+    
+
+End Sub
+
+
+'-----------------------------------------------------------------------------
+' Name: GetLocalBox
+' Desc: Returns the extent of the mesh in the local coordinate system
+'----------------------------------------------------------------------------
+Public Sub GetLocalBox(MinExt As D3DVECTOR, MaxExt As D3DVECTOR)
+    g_d3dx.ComputeBoundingBoxFromMesh mesh, MinExt, MaxExt
+End Sub
+
+'-----------------------------------------------------------------------------
+' Name: Destroy
+' Desc: release any reference to frame and texture objects
+'-----------------------------------------------------------------------------
+Sub Destroy()
+    
+    'Releases all objects (does leave 1 element in the array)
+    ReDim m_Textures(0)
+    ReDim m_Materials(0)
+    ReDim m_TextureNames(0)
+    ReDim m_BoneFrames(0)
+    ReDim m_BoneOffsetMat(0)
+    ReDim m_BoneCombos(0)
+    m_NumMaterials = 0
+    bUseMaterials = True
+    Set mesh = Nothing
+    Set skinmesh = Nothing
+End Sub
+
+
+'-----------------------------------------------------------------------------
+' Name: ComputeBoundingVolumes
+' Desc: Makes BoundingSphere valid
+'-----------------------------------------------------------------------------
+Public Sub ComputeBoundingVolumes()
+    g_d3dx.ComputeBoundingSphereFromMesh mesh, m_SphereCenter, SphereRadius
+    bHasSphere = True
+End Sub
+
+
+'-----------------------------------------------------------------------------
+' Name: RenderEx
+' Desc: Render Mesh
+' Params:
+'   dev                         the device to draw to
+'   bDrawOpaqueSubsets          draws all triangles that do not have alpha
+'   bDrawOpaqueSubsets          draws all triangles that have alpha
+'                               (note Blending renderstates are modified)
+'
+' Note: do not use for skinned meshes
+'-----------------------------------------------------------------------------
+Sub RenderEx(dev As Direct3DDevice8, bDrawOpaqueSubsets As Boolean, bDrawAlphaSubsets As Boolean)
+    If mesh Is Nothing Then Exit Sub
+    Dim i As Long
+    
+    'If bSkinned = True Then Exit Sub
+
+    ' Frist, draw the subsets without alpha
+    If (bDrawOpaqueSubsets) Then
+        For i = 0 To m_NumMaterials - 1
+        
+                
+        
+            If (bUseMaterials) Then
+                If m_Materials(i).diffuse.a = 1# Then
+                    g_dev.SetMaterial m_Materials(i)
+                    
+                    If g_bDontDrawTextures Then
+                        g_dev.SetTexture 0, Nothing
+                    Else
+                        g_dev.SetTexture 0, m_Textures(i)
+                    End If
+                    
+                    mesh.DrawSubset i
+                End If
+            ElseIf (bUseMaterialOverride) Then
+                If m_MaterialOverride.diffuse.a = 1# Then
+                    If g_bDontDrawTextures Then
+                        g_dev.SetTexture 0, Nothing
+                    Else
+                        g_dev.SetTexture 0, m_Textures(i)
+                    End If
+                    g_dev.SetMaterial m_MaterialOverride
+                    mesh.DrawSubset i
+                End If
+            Else
+                mesh.DrawSubset i
+            End If
+                    
+        Next
+    End If
+
+    
+    ' Then, draw the subsets with alpha
+    If (bDrawAlphaSubsets And (bUseMaterialOverride Or bUseMaterials)) Then
+        For i = 0 To m_NumMaterials - 1
+        
+            If (bUseMaterials) Then
+                    If (m_Materials(i).diffuse.a < 1#) Then
+                          g_dev.SetMaterial m_Materials(i)
+                          g_dev.SetTexture 0, m_Textures(i)
+                          mesh.DrawSubset i
+                    End If
+            ElseIf (bUseMaterialOverride) Then
+                    If (m_MaterialOverride.diffuse.a < 1#) Then
+                          g_dev.SetMaterial m_MaterialOverride
+                          g_dev.SetTexture 0, m_Textures(i)
+                          mesh.DrawSubset i
+                    End If
+            End If
+        Next
+    End If
+    
+End Sub
+
+'-----------------------------------------------------------------------------
+' Name: Render
+' Desc: Render the mesh to the given device
+'
+' Note: Do not use for skinned meshes
+'
+'-----------------------------------------------------------------------------
+Sub Render(dev As Direct3DDevice8)
+    Dim i As Long
+    
+    If mesh Is Nothing Then Exit Sub
+    
+    If bSkinned = True Then Exit Sub
+    
+    If (bUseMaterials) Then
+        For i = 0 To m_NumMaterials - 1
+            g_dev.SetMaterial m_Materials(i)
+            g_dev.SetTexture 0, m_Textures(i)
+            mesh.DrawSubset i
+        Next
+    Else
+        For i = 0 To m_NumMaterials - 1
+            mesh.DrawSubset i
+        Next
+
+    End If
+        
+End Sub
+
+'-----------------------------------------------------------------------------
+' Name: RenderSkin
+' Desc: Render the Mesh as skin
+' Note: The mesh must have been loaded as a skin and bones must have been attached
+'-----------------------------------------------------------------------------
+Sub RenderSkin()
+
+    If Not bSkinned Then Exit Sub
+    
+    Dim ipAttr As Long  'bonecombo attribute
+    Dim matId As Long   'matrix id
+    
+    Dim i As Long
+    Dim mat2 As D3DMATRIX
+    Dim mat1 As D3DMATRIX
+    Dim mat0 As D3DMATRIX
+
+    
+    g_dev.SetRenderState D3DRS_VERTEXBLEND, m_maxFaceInfl - 1
+        
+    For ipAttr = 0 To m_NumBoneCombos - 1
+        For i = 0 To m_maxFaceInfl - 1
+                matId = m_BoneComboIds(ipAttr).List(i)
+                
+                'If we get a MatId of -1 then all the vertex weights are 0
+                'and we dont need to set the transform for this bone
+                If matId <> -1 Then
+                    mat0 = m_BoneFrames(matId).GetUpdatedMatrix()
+                    mat1 = m_BoneOffsetMat(matId)
+                    D3DXMatrixMultiply mat2, mat1, mat0
+                    g_dev.SetTransform m_worldMatHandles(i), mat2
+                End If
+        Next
+        g_dev.SetTexture 0, m_Textures(m_BoneCombos(ipAttr).AttribId)
+        g_dev.SetMaterial m_Materials(m_BoneCombos(ipAttr).AttribId)
+        
+        mesh.DrawSubset ipAttr
+        
+    Next
+    
+    g_dev.SetRenderState D3DRS_VERTEXBLEND, 0
+    
+    
+End Sub
+
+'-----------------------------------------------------------------------------
+' Name: GetMaterialCount
+'
+'---------------------------------------------------------------------------
+Public Function GetMaterialCount() As Long
+    GetMaterialCount = m_NumMaterials
+End Function
+
+
+'-----------------------------------------------------------------------------
+' Name: SetMaterialOverride
+' Desc: Sets the materail to be used in place of the ones loaded from file
+' Note: to disable set bUseMaterialOverride to false
+'-----------------------------------------------------------------------------
+Public Sub SetMaterialOverride(m As D3DMATERIAL8)
+    m_MaterialOverride = m
+    bUseMaterialOverride = True
+End Sub
+
+'-----------------------------------------------------------------------------
+' Name: GetMaterialOverride
+' Desc:
+'-----------------------------------------------------------------------------
+Public Sub GetMaterialOverride(m As D3DMATERIAL8)
+      m = m_MaterialOverride
+End Sub
+
+
+'-----------------------------------------------------------------------------
+' Name: ClassName
+' Desc:
+'-----------------------------------------------------------------------------
+Public Function ClassName() As String
+    ClassName = "CD3DMesh"
+End Function
+
+
+'-----------------------------------------------------------------------------
+' Name: InvalidateDeviceObjects
+' Desc: Release reference to device dependent objects
+'-----------------------------------------------------------------------------
+Public Sub InvalidateDeviceObjects()
+   'all framework objects are managed so nothing to do here
+End Sub
+
+
+
+'-----------------------------------------------------------------------------
+' Name: RestoreDeviceObjects
+' Desc: If we had any video memory objects they would need
+'       to be reloaded here
+'-----------------------------------------------------------------------------
+Public Sub RestoreDeviceObjects(dev As Direct3DDevice8)
+    
+End Sub
+
+
+'-----------------------------------------------------------------------------
+' Name: InitFromD3DXMesh
+' Desc: Allow mesh objects to be created from external D3DXMesh objects
+'
+'-----------------------------------------------------------------------------
+Sub InitFromD3DXMesh(d3dxmeshIn As D3DXMesh)
+    bUseMaterials = False
+    ReDim m_Materials(1)
+    ReDim m_Textures(1)
+    m_NumMaterials = 1
+    Set mesh = d3dxmeshIn
+End Sub
+
+
+'-----------------------------------------------------------------------------
+' Name: SetMaterialCount
+' Desc: If a mesh was initialized with InitFromD3DXMesh
+'       This function can allocate space for Materials and Textures
+'-----------------------------------------------------------------------------
+Sub SetMaterialCount(n As Long)
+    m_NumMaterials = n
+    ReDim Preserve m_Materials(n)
+    ReDim Preserve m_Textures(n)
+End Sub
+
+'-----------------------------------------------------------------------------
+' Name: SetMaterialTexture
+' Desc: Sets the texture for a given material subset
+' Note: use nothing to remove a texture
+'-----------------------------------------------------------------------------
+Sub SetMaterialTexture(n As Long, tex As Direct3DTexture8)
+    Set m_Textures(n) = tex
+End Sub
+
+'-----------------------------------------------------------------------------
+' Name: GetMaterialTexture
+' Desc: returns a given texture for a material subset
+'-----------------------------------------------------------------------------
+Function GetMaterialTexture(n As Long) As Direct3DTexture8
+    Set GetMaterialTexture = m_Textures(n)
+End Function
+
+
+'-----------------------------------------------------------------------------
+' Name: SetMaterial
+' Desc: Sets the material properties for a given material subset
+'-----------------------------------------------------------------------------
+Sub SetMaterial(n As Long, material As D3DMATERIAL8)
+    m_Materials(n) = material
+End Sub
+
+
+'-----------------------------------------------------------------------------
+' Name: GetMaterial
+' Desc: returns material properties for a material subset
+'-----------------------------------------------------------------------------
+Function GetMaterial(n As Long) As D3DMATERIAL8
+    GetMaterial = m_Materials(n)
+End Function
+
+

Library/dxx8/samples/Multimedia/VBSamples/Demos/AirHockey/d3dPick.cls

@@ -0,0 +1,334 @@
+VERSION 1.0 CLASS
+BEGIN
+  MultiUse = -1  'True
+  Persistable = 0  'NotPersistable
+  DataBindingBehavior = 0  'vbNone
+  DataSourceBehavior  = 0  'vbNone
+  MTSTransactionMode  = 0  'NotAnMTSObject
+END
+Attribute VB_Name = "CD3DPick"
+Attribute VB_GlobalNameSpace = False
+Attribute VB_Creatable = True
+Attribute VB_PredeclaredId = False
+Attribute VB_Exposed = False
+
+'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
+'
+'  Copyright (C) 1999-2001 Microsoft Corporation.  All Rights Reserved.
+'
+'  File:       D3DPick.cls
+'  Content:    D3D Visual Basic Framework Pick object
+'              See raypack and viewport pick entrypoints
+'
+'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
+
+Option Explicit
+
+Dim m_item() As D3D_PICK_RECORD
+Dim m_frame() As CD3DFrame
+Dim m_mesh() As CD3DMesh
+Dim m_count As Long
+Dim m_maxsize As Long
+Const kGrowSize = 10
+
+'-----------------------------------------------------------------------------
+' Name: GetCount
+' Dest: returns number of items picked
+'-----------------------------------------------------------------------------
+Public Function GetCount() As Long
+    GetCount = m_count
+End Function
+
+'-----------------------------------------------------------------------------
+' Name: GetRecord
+' Desc: returns the properties of a given pick item
+'-----------------------------------------------------------------------------
+Public Sub GetRecord(i As Long, ByRef a As Single, ByRef b As Single, ByRef dist As Single, ByRef triFaceid As Long)
+    a = m_item(i).a
+    b = m_item(i).b
+    dist = m_item(i).dist
+    triFaceid = m_item(i).triFaceid
+End Sub
+
+'-----------------------------------------------------------------------------
+' Name: GetFrame
+' Desc: returns the frame of a given pick item
+'-----------------------------------------------------------------------------
+Public Function GetFrame(i As Long) As CD3DFrame
+    Set GetFrame = m_frame(i)
+End Function
+
+'-----------------------------------------------------------------------------
+' Name: GetMesh
+' Desc: returns the mesh of a given pick item
+'-----------------------------------------------------------------------------
+Public Function GetMesh(i As Long) As CD3DMesh
+    Set GetMesh = m_mesh(i)
+End Function
+
+'-----------------------------------------------------------------------------
+' Name: FindNearest
+' Desc: returns the index of the pick with the smallest distance (closest to viewer)
+'-----------------------------------------------------------------------------
+Public Function FindNearest() As Long
+    Dim q As Long, mindist As Single, i As Long
+    q = -1
+    mindist = 1E+38
+    For i = 0 To m_count - 1
+        If m_item(i).dist < mindist Then
+            q = i
+            mindist = m_item(i).dist
+        End If
+    Next
+    FindNearest = q
+End Function
+
+
+'-----------------------------------------------------------------------------
+' Name: FindFurthest
+' Desc: returns the index of the pick with the largest distance
+'-----------------------------------------------------------------------------
+Public Function FindFurthest() As Long
+    Dim q As Long, maxdist As Single, i As Long
+    q = -1
+    maxdist = -1E+38
+    For i = 0 To m_count - 1
+        If m_item(i).dist < maxdist Then
+            q = i
+            maxdist = m_item(i).dist
+        End If
+    Next
+    FindFurthest = q
+End Function
+
+
+'-----------------------------------------------------------------------------
+' Name: Destroy
+' Desc: Release all references
+'-----------------------------------------------------------------------------
+Public Function Destroy()
+    ReDim m_mesh(0)
+    ReDim m_frame(0)
+    m_count = 0
+    m_maxsize = 0
+    
+End Function
+
+
+'-----------------------------------------------------------------------------
+' Name: ViewportPick
+' Params:
+'    frame      parent of frame heirarchy to pick from
+'    x          x screen coordinate in pixels
+'    y          y screen coordinate in pixels
+'
+' Note: After call GetCount to see if any objets where hit
+'-----------------------------------------------------------------------------
+Public Function ViewportPick(frame As CD3DFrame, X As Single, Y As Single)
+    Destroy
+    
+    Dim viewport As D3DVIEWPORT8
+    Dim world As D3DMATRIX
+    Dim proj As D3DMATRIX
+    Dim view As D3DMATRIX
+    
+    'NOTE the following functions will fail on PURE HAL devices
+    'use ViewportPickEx if working with pureHal devices
+    
+    g_dev.GetViewport viewport
+    world = g_identityMatrix
+    g_dev.GetTransform D3DTS_VIEW, view
+    g_dev.GetTransform D3DTS_PROJECTION, proj
+    
+    ViewportPick = ViewportPickEx(frame, viewport, proj, view, world, X, Y)
+    
+End Function
+
+'-----------------------------------------------------------------------------
+' Name: ViewportPickEx
+' Desc: Aux function for ViewportPick
+'-----------------------------------------------------------------------------
+Public Function ViewportPickEx(frame As CD3DFrame, viewport As D3DVIEWPORT8, proj As D3DMATRIX, view As D3DMATRIX, world As D3DMATRIX, X As Single, Y As Single) As Boolean
+    
+    If frame.Enabled = False Then Exit Function
+    
+    Dim vIn As D3DVECTOR, vNear As D3DVECTOR, vFar As D3DVECTOR, vDir As D3DVECTOR
+    Dim bHit As Boolean, i As Long
+    
+    If frame Is Nothing Then Exit Function
+        
+                        
+    Dim currentMatrix As D3DMATRIX
+    Dim NewWorldMatrix As D3DMATRIX
+    
+    currentMatrix = frame.GetMatrix
+        
+    'Setup our basis matrix for this frame
+    D3DXMatrixMultiply NewWorldMatrix, currentMatrix, world
+    
+    vIn.X = X:    vIn.Y = Y
+    
+    'Compute point on Near Clip plane at cursor
+    vIn.z = 0
+    D3DXVec3Unproject vNear, vIn, viewport, proj, view, NewWorldMatrix
+    
+    'compute point on far clip plane at cursor
+    vIn.z = 1
+    D3DXVec3Unproject vFar, vIn, viewport, proj, view, NewWorldMatrix
+
+    'Comput direction vector
+    D3DXVec3Subtract vDir, vFar, vNear
+                
+    
+    
+    Dim item As D3D_PICK_RECORD
+    
+    
+    'Check all child meshes
+    'Even if we got a hit we continue as the next mesh may be closer
+    Dim childMesh As CD3DMesh
+    For i = 0 To frame.GetChildMeshCount() - 1
+        
+        Set childMesh = frame.GetChildMesh(i)
+        
+        If Not childMesh Is Nothing Then
+            g_d3dx.Intersect childMesh.mesh, vNear, vDir, item.hit, item.triFaceid, item.a, item.b, item.dist, 0
+        End If
+        
+        If item.hit <> 0 Then
+            InternalAddItem frame, childMesh, item
+            item.hit = 0
+        End If
+        bHit = True
+    Next
+    
+    'check pick for all child frame
+    Dim childFrame As CD3DFrame
+    For i = 0 To frame.GetChildFrameCount() - 1
+        Set childFrame = frame.GetChildFrame(i)
+        bHit = bHit Or _
+                ViewportPickEx(childFrame, viewport, proj, view, NewWorldMatrix, X, Y)
+    Next
+
+    ViewportPickEx = bHit
+
+End Function
+
+
+
+'-----------------------------------------------------------------------------
+' Name: RayPick
+' Desc: given a ray cast it into a scene graph
+' Params:
+'    frame      parent of frame heirarchy to pick from
+'    vOrig      origen of the ray to cast
+'    vDir       direction of the ray
+'
+' Note: the following functions will fail on PURE HAL devices
+'       use RayPickEx if working with pureHal devices
+'       Call getCount to see if the ray hit any objects
+'
+'-----------------------------------------------------------------------------
+Public Function RayPick(frame As CD3DFrame, vOrig As D3DVECTOR, vDir As D3DVECTOR)
+    Destroy
+        
+    Dim world As D3DMATRIX
+    
+    
+    g_dev.GetTransform D3DTS_WORLD, world
+    
+    RayPick = RayPickEx(frame, world, vOrig, vDir)
+    
+End Function
+
+'-----------------------------------------------------------------------------
+' Name: RayPickEx
+' Desc: Aux function for RayPickEx
+'-----------------------------------------------------------------------------
+Public Function RayPickEx(frame As CD3DFrame, worldmatrix As D3DMATRIX, vOrig As D3DVECTOR, vDir As D3DVECTOR) As Boolean
+
+    Dim NewWorldMatrix As D3DMATRIX     'world matrix for this stack frame
+    Dim InvWorldMatrix As D3DMATRIX     'world matrix for this stack frame
+    Dim currentMatrix As D3DMATRIX
+    Dim i As Long, det As Single, bHit As Boolean
+    Dim vNewDir As D3DVECTOR, vNewOrig As D3DVECTOR
+        
+    If frame Is Nothing Then Exit Function
+        
+    currentMatrix = frame.GetMatrix
+        
+    'Setup our basis matrix for this frame
+    D3DXMatrixMultiply NewWorldMatrix, currentMatrix, worldmatrix
+    D3DXMatrixInverse InvWorldMatrix, det, NewWorldMatrix
+    
+    
+    ' we want to compute vdir and vOrig in model space
+    ' note we use TransformNormal so we dont translate vDir
+    ' just rotate it into a new dir
+    Call D3DXVec3TransformNormal(vNewDir, vDir, InvWorldMatrix)
+    Call D3DXVec3TransformCoord(vNewOrig, vOrig, InvWorldMatrix)
+            
+                
+    Dim item As D3D_PICK_RECORD
+    
+    
+    'Check all child meshes
+    'Even if we got a hit we continue as the next mesh may be closer
+    Dim childMesh As CD3DMesh
+    For i = 0 To frame.GetChildMeshCount() - 1
+        
+        Set childMesh = frame.GetChildMesh(i)
+        
+        If Not childMesh Is Nothing Then
+            Call D3DXVec3Scale(vDir, vDir, 1000) 'Workaround for d3dx Intersect bug
+            g_d3dx.Intersect childMesh.mesh, vNewOrig, vDir, item.hit, item.triFaceid, item.a, item.b, item.dist, 0
+        End If
+        
+        If item.hit <> 0 Then
+            InternalAddItem frame, childMesh, item
+            item.hit = 0
+        End If
+        bHit = True
+    Next
+    
+    'check pick for all child frame
+    Dim childFrame As CD3DFrame
+    For i = 0 To frame.GetChildFrameCount() - 1
+        Set childFrame = frame.GetChildFrame(i)
+        bHit = bHit Or _
+            RayPickEx(childFrame, NewWorldMatrix, vOrig, vDir)
+    Next
+
+    RayPickEx = bHit
+
+End Function
+
+
+
+
+'-----------------------------------------------------------------------------
+' InternalAddItem
+'-----------------------------------------------------------------------------
+Private Sub InternalAddItem(parentFrame As CD3DFrame, mesh As CD3DMesh, item As D3D_PICK_RECORD)
+    Dim maxsize As Long
+    If m_maxsize = 0 Then
+        ReDim m_item(kGrowSize)
+        ReDim m_mesh(kGrowSize)
+        ReDim m_frame(kGrowSize)
+        m_maxsize = kGrowSize
+    ElseIf m_count >= m_maxsize Then
+        ReDim Preserve m_item(m_maxsize + kGrowSize)
+        ReDim Preserve m_frame(m_maxsize + kGrowSize)
+        ReDim Preserve m_mesh(m_maxsize + kGrowSize)
+        m_maxsize = m_maxsize + kGrowSize
+    End If
+    
+    Set m_mesh(m_count) = mesh
+    Set m_frame(m_count) = parentFrame
+    m_item(m_count) = item
+                             
+    m_count = m_count + 1
+End Sub
+
+
+

Library/dxx8/samples/Multimedia/VBSamples/Demos/AirHockey/frmAir.frm

@@ -0,0 +1,528 @@
+VERSION 5.00
+Object = "{831FDD16-0C5C-11D2-A9FC-0000F8754DA1}#2.0#0"; "MSCOMCTL.OCX"
+Begin VB.Form frmAir 
+   BackColor       =   &H00000000&
+   BorderStyle     =   1  'Fixed Single
+   Caption         =   "Air Hockey"
+   ClientHeight    =   4500
+   ClientLeft      =   45
+   ClientTop       =   330
+   ClientWidth     =   6000
+   BeginProperty Font 
+      Name            =   "Comic Sans MS"
+      Size            =   9.75
+      Charset         =   0
+      Weight          =   700
+      Underline       =   0   'False
+      Italic          =   0   'False
+      Strikethrough   =   0   'False
+   EndProperty
+   Icon            =   "frmAir.frx":0000
+   KeyPreview      =   -1  'True
+   LinkTopic       =   "Form1"
+   MaxButton       =   0   'False
+   MinButton       =   0   'False
+   ScaleHeight     =   300
+   ScaleMode       =   3  'Pixel
+   ScaleWidth      =   400
+   StartUpPosition =   2  'CenterScreen
+   Begin MSComctlLib.ProgressBar barProg 
+      Height          =   540
+      Left            =   225
+      TabIndex        =   0
+      Top             =   3390
+      Visible         =   0   'False
+      Width           =   5490
+      _ExtentX        =   9684
+      _ExtentY        =   953
+      _Version        =   393216
+      Appearance      =   1
+      Scrolling       =   1
+   End
+   Begin VB.Label lblSplash 
+      Alignment       =   2  'Center
+      BackStyle       =   0  'Transparent
+      Caption         =   "Visual Basic Air Hockey, loading...."
+      ForeColor       =   &H00FFFFFF&
+      Height          =   360
+      Left            =   1095
+      TabIndex        =   1
+      Top             =   390
+      Visible         =   0   'False
+      Width           =   4110
+   End
+   Begin VB.Image imgSplash 
+      Height          =   4395
+      Left            =   30
+      Picture         =   "frmAir.frx":030A
+      Stretch         =   -1  'True
+      Top             =   60
+      Visible         =   0   'False
+      Width           =   5925
+   End
+End
+Attribute VB_Name = "frmAir"
+Attribute VB_GlobalNameSpace = False
+Attribute VB_Creatable = False
+Attribute VB_PredeclaredId = True
+Attribute VB_Exposed = False
+Option Explicit
+'Sleep declare
+Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
+Private Enum SplashScreenMode
+    SplashShow
+    SplashHide
+    SplashResize
+End Enum
+
+'We need to implement our event interfaces
+Implements DirectPlay8Event
+Private mlSendTime As Long
+Private mlNumSend As Long
+Private mfGotGameSettings As Boolean
+Private mfGameStarted As Boolean
+
+Private Sub Form_KeyDown(KeyCode As Integer, Shift As Integer)
+    'We need to be able to handle F2 keys for resolution changes
+     Select Case KeyCode
+     Case vbKeyF2
+        PauseSystem True
+        goDev.SelectDevice Me
+    Case vbKeyF1
+        'Toggle the ability to draw the room
+        goRoom.DrawRoom = Not goRoom.DrawRoom
+    Case vbKeyF4
+        'Toggle the transparency of the paddles
+        goTable.Transparent = Not goTable.Transparent
+    Case vbKeyF5
+        'Toggle the ability to draw the room
+        goTable.DrawTable = Not goTable.DrawTable
+    Case vbKeyF6
+        'Toggle the transparency of the paddles
+        goPaddle(0).Transparent = Not goPaddle(0).Transparent
+        goPaddle(1).Transparent = Not goPaddle(1).Transparent
+    Case vbKeyF3
+        'Restart the game if it's available
+        If gfGameOver Then
+            gPlayer(0).Score = 0: gPlayer(1).Score = 0
+            goPuck.DefaultStartPosition
+            gfGameOver = False
+            NotifyGameRestart
+        End If
+    Case vbKeyReturn
+    
+        ' Check for Alt-Enter if not pressed exit
+        If Shift <> 4 Then Exit Sub
+        PauseSystem True
+        ' If we are windowed go fullscreen
+        ' If we are fullscreen returned to windowed
+        SaveOrRestoreObjectSettings True
+        InvalidateDeviceObjects
+        Cleanup True, True
+        If g_d3dpp.Windowed Then
+             D3DUtil_ResetFullscreen
+        Else
+             D3DUtil_ResetWindowed
+        End If
+        
+        ' Call Restore after ever mode change
+        ' because calling reset looses state that needs to
+        ' be reinitialized
+        Me.RestoreDeviceObjects False
+        SaveOrRestoreObjectSettings False
+        PauseSystem False
+    End Select
+End Sub
+
+Private Sub Form_KeyPress(KeyAscii As Integer)
+    Dim nVel As Single
+    Dim vNewVel As D3DVECTOR
+    
+    If KeyAscii = vbKeyEscape Then
+        Unload Me
+    ElseIf LCase(Chr$(KeyAscii)) = "v" Then
+        'Scroll through the different 'default' views.  If there is currently a custom view on
+        'turn on the default view.
+        goCamera.NextCameraPosition glMyPaddleID
+    ElseIf KeyAscii = vbKeySpace Then
+        'We want to launch the puck.  We should only be able to do this if
+        'we have recently scored, or if we haven't started the game yet.
+        If gfGameCanBeStarted And gfScored And (Not gfGameOver) Then
+            goPuck.LaunchPuck
+            If gfMultiplayer Then
+                SendPuck
+            End If
+            'Start the puck spinning
+            goPuck.Spinning = True
+            gfScored = False
+            glTimeCompPaddle = 0
+        End If
+    ElseIf LCase(Chr$(KeyAscii)) = "w" Then
+        gfWireFrame = Not gfWireFrame
+    'These two cases should be removed in the final version
+    ElseIf LCase(Chr$(KeyAscii)) = "+" Then
+        If Not gfScored Then
+            nVel = D3DXVec3Length(goPuck.Velocity) * 1.2
+            D3DXVec3Normalize vNewVel, goPuck.Velocity
+            D3DXVec3Scale vNewVel, vNewVel, nVel
+            goPuck.Velocity = vNewVel
+            SendPuck
+        End If
+    ElseIf LCase(Chr$(KeyAscii)) = "-" Then
+        If Not gfScored Then
+            nVel = D3DXVec3Length(goPuck.Velocity) * 0.8
+            D3DXVec3Normalize vNewVel, goPuck.Velocity
+            D3DXVec3Scale vNewVel, vNewVel, nVel
+            goPuck.Velocity = vNewVel
+            SendPuck
+        End If
+    End If
+End Sub
+
+Private Sub Form_Load()
+    
+    glMyPaddleID = 0
+    mfGotGameSettings = False
+    'We've got here now.  Go ahead and init our 3D device
+    If gfMultiplayer Then
+        'Oh good, we want to play a multiplayer game.
+        'First lets get the dplay connection started
+        
+        'Here we will init our DPlay objects
+        InitDPlay
+        'Now we can create a new Connection Form (which will also be our message pump)
+        Set DPlayEventsForm = New DPlayConnect
+        'Start the connection form (it will either create or join a session)
+        If Not DPlayEventsForm.StartConnectWizard(dx, dpp, AppGuid, 2, Me, False) Then
+            CleanupDPlay
+            End
+        Else 'We did choose to play a game
+            gsUserName = DPlayEventsForm.UserName
+            If DPlayEventsForm.IsHost Then
+                Me.Caption = Me.Caption & " (HOST)"
+                mfGotGameSettings = True
+            End If
+            gfHost = DPlayEventsForm.IsHost
+        End If
+    End If
+        
+    'Do a quick switch to windowed mode just to initialize all the vars
+    If Not D3DUtil_Init(frmAir.hwnd, True, 0, 0, D3DDEVTYPE_HAL, Me) Then
+        MsgBox "Could not initialize Direct3D.  This sample will now exit", vbOKOnly Or vbInformation, "Exiting..."
+        Unload Me
+        Exit Sub
+    End If
+    'Now update to the 'correct' resolution (or windowed)
+    goDev.UpdateNow Me
+    glScreenHeight = Me.ScaleHeight: glScreenWidth = Me.ScaleWidth
+    If g_d3dpp.Windowed = 0 Then
+        Me.Move 0, 0, g_d3dpp.BackBufferWidth * Screen.TwipsPerPixelX, g_d3dpp.BackBufferHeight * Screen.TwipsPerPixelY
+    End If
+    Me.Show
+    SplashScreenMode SplashShow
+    DoEvents
+    barProg.Min = 0: barProg.Max = 9
+    InitDeviceObjects
+    IncreaseProgressBar
+    RestoreDeviceObjects
+    IncreaseProgressBar
+    'Start up our Input devices
+    If Not goInput.InitDirectInput(Me) Then
+        Cleanup 'This should restore our state so we can complain that we couldn't Init Dinput
+        MsgBox "Unable to Initialize DirectInput, this sample will now exit.", vbOKOnly Or vbInformation, "No DirectInput"
+        Unload Me
+        Exit Sub
+    End If
+    IncreaseProgressBar
+    'Start up our sounds
+    If Not goAudio.InitAudio Then
+        MsgBox "Unable to Initialize Audio, this sample will not have audio capablities.", vbOKOnly Or vbInformation, "No Audio"
+        goAudio.PlayMusic = False
+        goAudio.PlaySounds = False
+    End If
+    IncreaseProgressBar
+    'Here we will load the initial positions for our objects
+    LoadDefaultStartPositions
+    'Get rid of the splash screen
+    Unload frmSplash
+    glTimePuckScored = timeGetTime
+    SplashScreenMode SplashHide
+    'Wait a brief period of time
+    Sleep 100
+    'Do the intro
+    ShowStartup
+    goAudio.StartBackgroundMusic
+    glTimePuckScored = timeGetTime
+    
+    Me.Show
+    
+    'Start the puck spinning
+    goPuck.Spinning = True
+    'Now, if we're in a multiplayer game, and we're the client
+    'let the host know that we are ready to play the game, and he can launch the puck at any time.
+    If gfMultiplayer Then
+        Do While Not mfGotGameSettings
+            DPlayEventsForm.DoSleep 10 'Wait until we receive the game settings
+        Loop
+        NotifyClientReady
+    End If
+    glTimePuckScored = timeGetTime
+    MainGameLoop
+    
+End Sub
+
+Private Sub Form_Resize()
+
+    If Me.WindowState = vbMinimized Then
+        PauseSystem True
+    Else
+        PauseSystem False
+        glScreenHeight = Me.ScaleHeight: glScreenWidth = Me.ScaleWidth
+        SplashScreenMode SplashResize
+    End If
+End Sub
+
+Private Sub Form_Unload(Cancel As Integer)
+    goFade.Fade -5
+    Do While goFade.AmFading
+        Render
+        goFade.UpdateFade goPuck, goPaddle, goTable, goRoom
+        DoEvents
+    Loop
+    SaveDrawingSettings
+    CleanupDPlay
+    Cleanup True
+    End
+End Sub
+
+Private Sub SaveDrawingSettings()
+    SaveSetting gsKeyName, gsSubKey, "DrawRoom", goRoom.DrawRoom
+    SaveSetting gsKeyName, gsSubKey, "DrawTable", goTable.DrawTable
+End Sub
+
+Public Function VerifyDevice(flags As Long, format As CONST_D3DFORMAT) As Boolean
+    'All the checks we care about are already done, always return true
+    VerifyDevice = True
+End Function
+
+Public Sub InvalidateDeviceObjects()
+    InitDeviceObjects False
+End Sub
+
+Public Sub RestoreDeviceObjects(Optional ByVal fSplash As Boolean = True)
+    modAirHockey.RestoreDeviceObjects
+    InitDeviceObjects (Not fSplash)
+    glScreenHeight = Me.ScaleHeight: glScreenWidth = Me.ScaleWidth
+    If fSplash Then SplashScreenMode SplashResize
+End Sub
+
+Public Sub DeleteDeviceObjects()
+    Cleanup
+End Sub
+
+Public Sub InitDeviceObjects(Optional fLoadGeometry As Boolean = True)
+    'Check caps for lights
+    Dim d3dcaps As D3DCAPS8
+    
+    g_dev.GetDeviceCaps d3dcaps
+    If (d3dcaps.VertexProcessingCaps And D3DVTXPCAPS_DIRECTIONALLIGHTS) <> 0 Then  'We can use directional lights
+        InitDefaultLights d3dcaps.MaxActiveLights 'Set up the lights for the room
+    Else
+        'We could render the whole scene just using ambient light
+        '(which we'll have too since we can't position our direction
+        'lights), but the user will miss out on the shading of the table
+        InitDefaultLights 0 'Set up a default ambiant only light
+    End If
+    'Make sure the device supports alpha blending
+    If (d3dcaps.TextureCaps And D3DPTEXTURECAPS_ALPHA) Then
+        If Not (goFade Is Nothing) Then goFade.CanFade = True
+        g_dev.SetRenderState D3DRS_ALPHABLENDENABLE, 1
+    Else
+        If Not (goFade Is Nothing) Then goFade.CanFade = False
+    End If
+    
+    'Load our objects now
+    If fLoadGeometry Then InitGeometry 'Set up the room geometry
+End Sub
+
+Public Sub IncreaseProgressBar()
+    On Error Resume Next
+    barProg.Value = barProg.Value + 1
+    DoEvents
+End Sub
+
+Private Sub SplashScreenMode(ByVal Mode As SplashScreenMode)
+    Select Case Mode
+    Case SplashHide
+        imgSplash.Visible = False
+        barProg.Visible = False
+        lblSplash.Visible = False
+    Case SplashResize
+        'Move the splash screen to cover the entire client area
+        imgSplash.Move 0, 0, Me.ScaleWidth, Me.ScaleHeight
+        'Move the progress bar
+        barProg.Move 15, Me.ScaleHeight - ((Me.ScaleHeight / 10) + 20), Me.ScaleWidth - 30, Me.ScaleHeight / 10
+        lblSplash.Move 15, ((Me.ScaleHeight / 10) + 20), Me.ScaleWidth - 30, Me.ScaleHeight / 10
+    Case SplashShow
+        imgSplash.Visible = True
+        barProg.Visible = True
+        lblSplash.Visible = True
+        lblSplash.ZOrder
+    End Select
+End Sub
+
+Private Sub DirectPlay8Event_AddRemovePlayerGroup(ByVal lMsgID As Long, ByVal lPlayerID As Long, ByVal lGroupID As Long, fRejectMsg As Boolean)
+    'VB requires that we implement *all* members of an interface
+End Sub
+
+Private Sub DirectPlay8Event_AppDesc(fRejectMsg As Boolean)
+    'VB requires that we implement *all* members of an interface
+End Sub
+
+Private Sub DirectPlay8Event_AsyncOpComplete(dpnotify As DxVBLibA.DPNMSG_ASYNC_OP_COMPLETE, fRejectMsg As Boolean)
+    'VB requires that we implement *all* members of an interface
+End Sub
+
+Private Sub DirectPlay8Event_ConnectComplete(dpnotify As DxVBLibA.DPNMSG_CONNECT_COMPLETE, fRejectMsg As Boolean)
+    If dpnotify.hResultCode <> 0 Then 'There was a problem
+        MsgBox "Failed to connect to host." & vbCrLf & "Error:" & CStr(dpnotify.hResultCode), vbOKOnly Or vbInformation, "Exiting..."
+        Unload Me
+        Exit Sub
+    End If
+    'If we are receiving this event we must know that we are the client, since the server never receives this message.
+    'Make sure we are assigned paddle ID #1
+    glMyPaddleID = 1 'We are the second paddle
+End Sub
+
+Private Sub DirectPlay8Event_CreateGroup(ByVal lGroupID As Long, ByVal lOwnerID As Long, fRejectMsg As Boolean)
+    'VB requires that we implement *all* members of an interface
+End Sub
+
+Private Sub DirectPlay8Event_CreatePlayer(ByVal lPlayerID As Long, fRejectMsg As Boolean)
+    'We've got the create player message, so someone has just joined.  Send them the
+    'Setup message (if it's not us)
+    Dim dpPlayer As DPN_PLAYER_INFO
+    
+    dpPlayer = dpp.GetPeerInfo(lPlayerID)
+    If (dpPlayer.lPlayerFlags And DPNPLAYER_HOST) = 0 Then 'This isn't the host, let them know
+        SendGameSettings
+    End If
+    If (dpPlayer.lPlayerFlags And DPNPLAYER_LOCAL) = 0 Then 'This isn't the local player, save this id
+        glOtherPlayerID = lPlayerID
+    End If
+End Sub
+
+Private Sub DirectPlay8Event_DestroyGroup(ByVal lGroupID As Long, ByVal lReason As Long, fRejectMsg As Boolean)
+    'VB requires that we implement *all* members of an interface
+End Sub
+
+Private Sub DirectPlay8Event_DestroyPlayer(ByVal lPlayerID As Long, ByVal lReason As Long, fRejectMsg As Boolean)
+    'If we receive a DestroyPlayer msg, then the other player must have quit.
+    'We have been disconnected, stop sending data
+    gfNoSendData = True
+End Sub
+
+Private Sub DirectPlay8Event_EnumHostsQuery(dpnotify As DxVBLibA.DPNMSG_ENUM_HOSTS_QUERY, fRejectMsg As Boolean)
+    'If the game has started don't even bother answering the enum query.
+    If mfGameStarted Then fRejectMsg = True
+End Sub
+
+Private Sub DirectPlay8Event_EnumHostsResponse(dpnotify As DxVBLibA.DPNMSG_ENUM_HOSTS_RESPONSE, fRejectMsg As Boolean)
+    'VB requires that we implement *all* members of an interface
+End Sub
+
+Private Sub DirectPlay8Event_HostMigrate(ByVal lNewHostID As Long, fRejectMsg As Boolean)
+    'VB requires that we implement *all* members of an interface
+End Sub
+
+Private Sub DirectPlay8Event_IndicateConnect(dpnotify As DxVBLibA.DPNMSG_INDICATE_CONNECT, fRejectMsg As Boolean)
+    If Not mfGameStarted Then
+        'We haven't started the game yet, go ahead and allow this
+        mfGameStarted = True
+    Else
+        fRejectMsg = True
+    End If
+End Sub
+
+Private Sub DirectPlay8Event_IndicatedConnectAborted(fRejectMsg As Boolean)
+    'Uh oh, the person who indicated connect has now aborted, reset our flag
+    fRejectMsg = False
+End Sub
+
+Private Sub DirectPlay8Event_InfoNotify(ByVal lMsgID As Long, ByVal lNotifyID As Long, fRejectMsg As Boolean)
+    'VB requires that we implement *all* members of an interface
+End Sub
+
+Private Sub DirectPlay8Event_Receive(dpnotify As DxVBLibA.DPNMSG_RECEIVE, fRejectMsg As Boolean)
+    'process what msgs we receive.
+    Dim lMsg As Byte, lOffset As Long
+    Dim lPaddleID As Byte
+    Dim vTemp As D3DVECTOR
+    
+    With dpnotify
+    GetDataFromBuffer .ReceivedData, lMsg, LenB(lMsg), lOffset
+    Select Case lMsg
+    Case MsgPaddleLocation
+        GetDataFromBuffer .ReceivedData, lPaddleID, LenB(lPaddleID), lOffset
+        GetDataFromBuffer .ReceivedData, vTemp, LenB(vTemp), lOffset
+        goPaddle(lPaddleID).Position = vTemp
+    Case MsgPuckLocation
+        GetDataFromBuffer .ReceivedData, vTemp, LenB(vTemp), lOffset
+        goPuck.Position = vTemp
+        GetDataFromBuffer .ReceivedData, vTemp, LenB(vTemp), lOffset
+        goPuck.Velocity = vTemp
+        'Start the puck spinning
+        goPuck.Spinning = True
+        gfScored = False
+    Case MsgClientConnectedAndReadyToPlay
+        gfGameCanBeStarted = True
+    Case MsgPlayerScored
+        goPuck.DropPuckIntoScoringPosition goAudio, True
+    Case MsgRestartGame
+        If gfGameOver Then
+            gPlayer(0).Score = 0: gPlayer(1).Score = 0
+            goPuck.DefaultStartPosition
+            gfGameOver = False
+        End If
+    Case MsgSendGameSettings
+        'Get the data that holds the game settings
+        GetDataFromBuffer .ReceivedData, gnVelocityDamp, LenB(gnVelocityDamp), lOffset
+        goPuck.MaximumPuckVelocity = gnVelocityDamp * 6.23
+        GetDataFromBuffer .ReceivedData, glUserWinningScore, LenB(glUserWinningScore), lOffset
+        GetDataFromBuffer .ReceivedData, gnPaddleMass, LenB(gnPaddleMass), lOffset
+        mfGotGameSettings = True
+    Case MsgCollidePaddle
+        'Notify the user that the puck hit the paddle by playing a sound
+        goAudio.PlayHitSound
+    End Select
+    End With
+End Sub
+
+Private Sub DirectPlay8Event_SendComplete(dpnotify As DxVBLibA.DPNMSG_SEND_COMPLETE, fRejectMsg As Boolean)
+    
+    'Here we can update our send frequency based on how quickly the messages are arriving
+    mlSendTime = mlSendTime + dpnotify.lSendTime
+    mlNumSend = mlNumSend + 1
+    If dpnotify.hResultCode = DPNERR_TIMEDOUT Then
+        'Add a little more delay, packets are timing out
+        mlSendTime = mlSendTime + dpnotify.lSendTime + (glMinimumSendFrequency \ 2)
+    End If
+    'Send them as fast as they can receive them, but not overly fast (20 times/second max)
+    'We will calculate this based on the average amount of time it takes to send the data
+    glSendFrequency = ((mlSendTime \ mlNumSend) + glSendFrequency) \ 2
+    
+    Debug.Print "Send Freq:"; glSendFrequency; mlSendTime; mlNumSend
+    glOneWaySendLatency = (mlSendTime \ mlNumSend) \ 2
+    If glSendFrequency < glMinimumSendFrequency Then glSendFrequency = glMinimumSendFrequency
+    'Check for the max value for long (just in case)
+    If (mlNumSend > 2147483647) Or (mlSendTime > 2147483647) Then 'You would have to run the app for like 3 years to reach this level, but just in case...
+        'If it does though, reset the average
+        mlNumSend = 0
+        mlSendTime = 0
+    End If
+End Sub
+
+Private Sub DirectPlay8Event_TerminateSession(dpnotify As DxVBLibA.DPNMSG_TERMINATE_SESSION, fRejectMsg As Boolean)
+    'We have been disconnected, stop sending data
+    gfNoSendData = True
+End Sub

Library/dxx8/samples/Multimedia/VBSamples/Demos/AirHockey/frmAudio.frm

@@ -0,0 +1,171 @@
+VERSION 5.00
+Object = "{831FDD16-0C5C-11D2-A9FC-0000F8754DA1}#2.0#0"; "MSCOMCTL.OCX"
+Begin VB.Form frmAudio 
+   BorderStyle     =   4  'Fixed ToolWindow
+   Caption         =   "Audio Options"
+   ClientHeight    =   3360
+   ClientLeft      =   45
+   ClientTop       =   285
+   ClientWidth     =   6405
+   LinkTopic       =   "Form1"
+   MaxButton       =   0   'False
+   MinButton       =   0   'False
+   ScaleHeight     =   3360
+   ScaleWidth      =   6405
+   ShowInTaskbar   =   0   'False
+   StartUpPosition =   1  'CenterOwner
+   Begin VB.CommandButton cmdOk 
+      Caption         =   "OK"
+      Default         =   -1  'True
+      Height          =   375
+      Left            =   5340
+      TabIndex        =   0
+      Top             =   2880
+      Width           =   975
+   End
+   Begin VB.CommandButton cmdCancel 
+      Cancel          =   -1  'True
+      Caption         =   "Cancel"
+      Height          =   375
+      Left            =   4260
+      TabIndex        =   5
+      Top             =   2880
+      Width           =   975
+   End
+   Begin VB.Frame Frame1 
+      Caption         =   "Audio details"
+      Height          =   2655
+      Left            =   60
+      TabIndex        =   6
+      Top             =   120
+      Width           =   6255
+      Begin MSComctlLib.Slider sldVolume 
+         Height          =   255
+         Left            =   120
+         TabIndex        =   2
+         Top             =   1140
+         Width           =   6075
+         _ExtentX        =   10716
+         _ExtentY        =   450
+         _Version        =   393216
+         LargeChange     =   10
+         SmallChange     =   5
+         Min             =   -100
+         Max             =   0
+         TickFrequency   =   10
+      End
+      Begin VB.CheckBox chkMusic 
+         Caption         =   "Play Background Music"
+         Height          =   255
+         Left            =   120
+         TabIndex        =   3
+         Top             =   1500
+         Width           =   5955
+      End
+      Begin VB.CheckBox chkPlaySounds 
+         Caption         =   "Play Sounds"
+         Height          =   255
+         Left            =   120
+         TabIndex        =   1
+         Top             =   540
+         Width           =   5955
+      End
+      Begin MSComctlLib.Slider sldMusic 
+         Height          =   255
+         Left            =   60
+         TabIndex        =   4
+         Top             =   2100
+         Width           =   6075
+         _ExtentX        =   10716
+         _ExtentY        =   450
+         _Version        =   393216
+         LargeChange     =   10
+         SmallChange     =   5
+         Min             =   -100
+         Max             =   0
+         TickFrequency   =   10
+      End
+      Begin VB.Label lblMusic 
+         BackStyle       =   0  'Transparent
+         Caption         =   "Volume of background music"
+         Height          =   255
+         Left            =   120
+         TabIndex        =   9
+         Top             =   1800
+         Width           =   3855
+      End
+      Begin VB.Label lblSound 
+         BackStyle       =   0  'Transparent
+         Caption         =   "Volume of ambient sounds (puck, scoring, etc)"
+         Height          =   255
+         Left            =   180
+         TabIndex        =   8
+         Top             =   840
+         Width           =   3855
+      End
+      Begin VB.Label Label2 
+         BackStyle       =   0  'Transparent
+         Caption         =   "Here you can control the few audio settings."
+         Height          =   255
+         Index           =   0
+         Left            =   120
+         TabIndex        =   7
+         Top             =   240
+         Width           =   6015
+      End
+   End
+End
+Attribute VB_Name = "frmAudio"
+Attribute VB_GlobalNameSpace = False
+Attribute VB_Creatable = False
+Attribute VB_PredeclaredId = True
+Attribute VB_Exposed = False
+Option Explicit
+
+Private Sub chkMusic_Click()
+    sldMusic.Enabled = (chkMusic.Value = vbChecked)
+    lblMusic.Enabled = (chkMusic.Value = vbChecked)
+End Sub
+
+Private Sub chkPlaySounds_Click()
+    sldVolume.Enabled = (chkPlaySounds.Value = vbChecked)
+    lblSound.Enabled = (chkPlaySounds.Value = vbChecked)
+End Sub
+
+Private Sub cmdCancel_Click()
+    Unload Me
+End Sub
+
+Private Sub cmdOk_Click()
+    SaveAudioSettings
+    Unload Me
+End Sub
+
+Private Sub Form_Load()
+    'Now update the display
+    chkMusic.Value = Abs(goAudio.PlayMusic)
+    chkPlaySounds.Value = Abs(goAudio.PlaySounds)
+    sldVolume.Value = goAudio.SoundVolume / 25
+    sldMusic.Value = goAudio.MusicVolume / 25
+
+    'Update the UI
+    sldMusic.Enabled = (chkMusic.Value = vbChecked)
+    lblMusic.Enabled = (chkMusic.Value = vbChecked)
+    sldVolume.Enabled = (chkPlaySounds.Value = vbChecked)
+    lblSound.Enabled = (chkPlaySounds.Value = vbChecked)
+End Sub
+
+Private Sub SaveAudioSettings()
+    goAudio.PlayMusic = (chkMusic.Value = vbChecked)
+    goAudio.PlaySounds = (chkPlaySounds.Value = vbChecked)
+    goAudio.MusicVolume = sldMusic.Value * 25
+    goAudio.SoundVolume = sldVolume.Value * 25
+End Sub
+
+Private Sub Form_Unload(Cancel As Integer)
+    'We're leaving the form, save the settings
+    SaveSetting gsKeyName, gsSubKeyAudio, "UseBackgroundMusic", goAudio.PlayMusic
+    SaveSetting gsKeyName, gsSubKeyAudio, "UseSound", goAudio.PlaySounds
+    SaveSetting gsKeyName, gsSubKeyAudio, "MusicVolume", goAudio.MusicVolume
+    SaveSetting gsKeyName, gsSubKeyAudio, "SoundVolume", goAudio.SoundVolume
+End Sub

Library/dxx8/samples/Multimedia/VBSamples/Demos/AirHockey/frmGraphics.frm

@@ -0,0 +1,177 @@
+VERSION 5.00
+Begin VB.Form frmGraphics 
+   BorderStyle     =   4  'Fixed ToolWindow
+   Caption         =   "Graphic Options"
+   ClientHeight    =   3360
+   ClientLeft      =   45
+   ClientTop       =   285
+   ClientWidth     =   6405
+   LinkTopic       =   "Form1"
+   MaxButton       =   0   'False
+   MinButton       =   0   'False
+   ScaleHeight     =   3360
+   ScaleWidth      =   6405
+   ShowInTaskbar   =   0   'False
+   StartUpPosition =   1  'CenterOwner
+   Begin VB.CommandButton cmdOk 
+      Caption         =   "OK"
+      Default         =   -1  'True
+      Height          =   375
+      Left            =   5340
+      TabIndex        =   0
+      Top             =   2880
+      Width           =   975
+   End
+   Begin VB.CommandButton cmdCancel 
+      Cancel          =   -1  'True
+      Caption         =   "Cancel"
+      Height          =   375
+      Left            =   4260
+      TabIndex        =   5
+      Top             =   2880
+      Width           =   975
+   End
+   Begin VB.Frame Frame1 
+      Caption         =   "Options"
+      Height          =   2655
+      Left            =   60
+      TabIndex        =   6
+      Top             =   120
+      Width           =   6255
+      Begin VB.CommandButton cmdChgMode 
+         Caption         =   "Change..."
+         Height          =   315
+         Left            =   180
+         TabIndex        =   1
+         Top             =   900
+         Width           =   1575
+      End
+      Begin VB.OptionButton optOffice 
+         Caption         =   "Office Lobby (Less detailed, higher performance)"
+         Height          =   255
+         Left            =   120
+         TabIndex        =   4
+         Top             =   2280
+         Width           =   4935
+      End
+      Begin VB.OptionButton optGame 
+         Caption         =   "Game Room (More detailed, lower performance)"
+         Height          =   255
+         Left            =   120
+         TabIndex        =   3
+         Top             =   1980
+         Value           =   -1  'True
+         Width           =   4935
+      End
+      Begin VB.CheckBox chkDrawRoom 
+         Caption         =   "Display the room where the game is taking place."
+         Height          =   315
+         Left            =   120
+         TabIndex        =   2
+         Top             =   1260
+         Width           =   4095
+      End
+      Begin VB.Label lblMode 
+         BackStyle       =   0  'Transparent
+         BorderStyle     =   1  'Fixed Single
+         Caption         =   "Label1"
+         Height          =   255
+         Left            =   1245
+         TabIndex        =   10
+         Top             =   570
+         Width           =   4815
+      End
+      Begin VB.Label Label2 
+         BackStyle       =   0  'Transparent
+         Caption         =   "Display Mode"
+         Height          =   255
+         Index           =   2
+         Left            =   180
+         TabIndex        =   9
+         Top             =   600
+         Width           =   1095
+      End
+      Begin VB.Label lblRoom 
+         BackStyle       =   0  'Transparent
+         Caption         =   "If the room is displayed, what type of room should be displayed?"
+         Height          =   255
+         Left            =   120
+         TabIndex        =   8
+         Top             =   1680
+         Width           =   4635
+      End
+      Begin VB.Label Label2 
+         BackStyle       =   0  'Transparent
+         Caption         =   "You can control different options here to improve graphic quality, or performance"
+         Height          =   255
+         Index           =   0
+         Left            =   120
+         TabIndex        =   7
+         Top             =   240
+         Width           =   6015
+      End
+   End
+End
+Attribute VB_Name = "frmGraphics"
+Attribute VB_GlobalNameSpace = False
+Attribute VB_Creatable = False
+Attribute VB_PredeclaredId = True
+Attribute VB_Exposed = False
+Option Explicit
+
+Private Sub chkDrawRoom_Click()
+    EnableRoomInfo (chkDrawRoom.Value = vbChecked)
+End Sub
+
+Private Sub cmdCancel_Click()
+    Unload Me
+End Sub
+
+Private Sub cmdChgMode_Click()
+    goDev.Show vbModal
+    'Now that we've potentially changed modes, update them
+    If goDev.Windowed Then
+        lblMode.Caption = "Windowed mode"
+    Else
+        lblMode.Caption = goDev.ModeString
+    End If
+End Sub
+
+Private Sub cmdOk_Click()
+    SaveAudioSettings
+    Unload Me
+End Sub
+
+Private Sub Form_Load()
+    'Now update the display
+    chkDrawRoom.Value = Abs(goRoom.DrawRoom)
+    optGame.Value = goRoom.BarRoom
+    optOffice.Value = Not goRoom.BarRoom
+    If goDev.Windowed Then
+        lblMode.Caption = "Windowed mode"
+    Else
+        lblMode.Caption = goDev.ModeString
+    End If
+    EnableRoomInfo (chkDrawRoom.Value = vbChecked)
+End Sub
+
+Private Sub SaveAudioSettings()
+    goRoom.DrawRoom = (chkDrawRoom.Value = vbChecked)
+    goRoom.BarRoom = optGame.Value
+End Sub
+
+Private Sub Form_Unload(Cancel As Integer)
+    'We're leaving the form, save the settings
+    SaveSetting gsKeyName, gsSubKey, "DrawRoom", goRoom.DrawRoom
+    SaveSetting gsKeyName, gsSubKey, "RoomIsBarRoom", goRoom.BarRoom
+    SaveSetting gsKeyName, gsSubKeyGraphics, "Windowed", goDev.Windowed
+    SaveSetting gsKeyName, gsSubKeyGraphics, "AdapterID", goDev.Adapter
+    SaveSetting gsKeyName, gsSubKeyGraphics, "Mode", goDev.Mode
+    
+End Sub
+
+Private Sub EnableRoomInfo(ByVal fEnable As Boolean)
+    lblRoom.Enabled = fEnable
+    optGame.Enabled = fEnable
+    optOffice.Enabled = fEnable
+End Sub

Library/dxx8/samples/Multimedia/VBSamples/Demos/AirHockey/frmInput.frm

@@ -0,0 +1,268 @@
+VERSION 5.00
+Object = "{831FDD16-0C5C-11D2-A9FC-0000F8754DA1}#2.0#0"; "MSCOMCTL.OCX"
+Begin VB.Form frmInput 
+   BorderStyle     =   4  'Fixed ToolWindow
+   Caption         =   "Input Options"
+   ClientHeight    =   3360
+   ClientLeft      =   45
+   ClientTop       =   285
+   ClientWidth     =   6405
+   LinkTopic       =   "Form1"
+   MaxButton       =   0   'False
+   MinButton       =   0   'False
+   ScaleHeight     =   3360
+   ScaleWidth      =   6405
+   ShowInTaskbar   =   0   'False
+   StartUpPosition =   1  'CenterOwner
+   Begin VB.Frame Frame1 
+      Caption         =   "Controllers"
+      Height          =   2715
+      Left            =   60
+      TabIndex        =   8
+      Top             =   120
+      Width           =   6255
+      Begin MSComctlLib.Slider sldSens 
+         Height          =   195
+         Left            =   1080
+         TabIndex        =   5
+         Top             =   2400
+         Width           =   4995
+         _ExtentX        =   8811
+         _ExtentY        =   344
+         _Version        =   393216
+         Min             =   1
+         Max             =   50
+         SelStart        =   1
+         TickFrequency   =   5
+         Value           =   1
+      End
+      Begin VB.ComboBox cboJoy 
+         Height          =   315
+         Left            =   300
+         Style           =   2  'Dropdown List
+         TabIndex        =   4
+         Top             =   1980
+         Width           =   5775
+      End
+      Begin VB.CheckBox chkJoy 
+         Caption         =   "Joystick"
+         Height          =   315
+         Left            =   60
+         TabIndex        =   3
+         Top             =   1665
+         Width           =   5655
+      End
+      Begin VB.CheckBox chkKeyboard 
+         Caption         =   "Keyboard"
+         Height          =   315
+         Left            =   60
+         TabIndex        =   2
+         Top             =   1080
+         Width           =   5655
+      End
+      Begin VB.CheckBox chkMouse 
+         Caption         =   "Mouse"
+         Height          =   315
+         Left            =   120
+         TabIndex        =   0
+         Top             =   420
+         Width           =   5655
+      End
+      Begin MSComctlLib.Slider sldMouseSens 
+         Height          =   195
+         Left            =   1140
+         TabIndex        =   1
+         Top             =   780
+         Width           =   4935
+         _ExtentX        =   8705
+         _ExtentY        =   344
+         _Version        =   393216
+         Min             =   1
+         Max             =   50
+         SelStart        =   1
+         TickFrequency   =   5
+         Value           =   1
+      End
+      Begin MSComctlLib.Slider sldKeyboard 
+         Height          =   195
+         Left            =   1125
+         TabIndex        =   12
+         Top             =   1410
+         Width           =   4935
+         _ExtentX        =   8705
+         _ExtentY        =   344
+         _Version        =   393216
+         Min             =   1
+         Max             =   100
+         SelStart        =   1
+         TickFrequency   =   5
+         Value           =   1
+      End
+      Begin VB.Label lblKeySens 
+         BackStyle       =   0  'Transparent
+         Caption         =   "Sensitivity"
+         Height          =   255
+         Left            =   345
+         TabIndex        =   13
+         Top             =   1410
+         Width           =   735
+      End
+      Begin VB.Label lblMouseSens 
+         BackStyle       =   0  'Transparent
+         Caption         =   "Sensitivity"
+         Height          =   255
+         Left            =   360
+         TabIndex        =   11
+         Top             =   780
+         Width           =   735
+      End
+      Begin VB.Label lblSens 
+         BackStyle       =   0  'Transparent
+         Caption         =   "Sensitivity"
+         Height          =   255
+         Left            =   300
+         TabIndex        =   10
+         Top             =   2400
+         Width           =   735
+      End
+      Begin VB.Label Label2 
+         BackStyle       =   0  'Transparent
+         Caption         =   "Here you will select the controllers you wish to use during gameplay."
+         Height          =   255
+         Index           =   0
+         Left            =   120
+         TabIndex        =   9
+         Top             =   180
+         Width           =   4875
+      End
+   End
+   Begin VB.CommandButton cmdOk 
+      Caption         =   "OK"
+      Default         =   -1  'True
+      Height          =   375
+      Left            =   5340
+      TabIndex        =   7
+      Top             =   2940
+      Width           =   975
+   End
+   Begin VB.CommandButton cmdCancel 
+      Cancel          =   -1  'True
+      Caption         =   "Cancel"
+      Height          =   375
+      Left            =   4260
+      TabIndex        =   6
+      Top             =   2940
+      Width           =   975
+   End
+End
+Attribute VB_Name = "frmInput"
+Attribute VB_GlobalNameSpace = False
+Attribute VB_Creatable = False
+Attribute VB_PredeclaredId = True
+Attribute VB_Exposed = False
+Option Explicit
+Private diDevEnum As DirectInputEnumDevices8
+
+Private Sub chkJoy_Click()
+    cboJoy.Enabled = (chkJoy.Value = vbChecked)
+    lblSens.Enabled = (chkJoy.Value = vbChecked)
+    sldSens.Enabled = (chkJoy.Value = vbChecked)
+End Sub
+
+Private Sub chkKeyboard_Click()
+    If chkMouse.Value = vbUnchecked And chkKeyboard.Value = vbUnchecked Then
+        MsgBox "You must leave at least the keyboard or the mouse enabled.", vbOKOnly Or vbInformation, "No basic input"
+        chkKeyboard.Value = vbChecked
+    End If
+    lblKeySens.Enabled = (chkKeyboard.Value = vbChecked)
+    sldKeyboard.Enabled = (chkKeyboard.Value = vbChecked)
+End Sub
+
+Private Sub chkMouse_Click()
+    If chkMouse.Value = vbUnchecked And chkKeyboard.Value = vbUnchecked Then
+        MsgBox "You must leave at least the keyboard or the mouse enabled.", vbOKOnly Or vbInformation, "No basic input"
+        chkMouse.Value = vbChecked
+    End If
+    lblMouseSens.Enabled = (chkMouse.Value = vbChecked)
+    sldMouseSens.Enabled = (chkMouse.Value = vbChecked)
+End Sub
+
+Private Sub cmdCancel_Click()
+    Unload Me
+End Sub
+
+Private Sub cmdOk_Click()
+    SaveAudioSettings
+    Unload Me
+End Sub
+
+Private Sub Form_Load()
+    Dim lIndex As Long
+    
+    'Now update the display
+    chkMouse.Value = Abs(goInput.UseMouse)
+    chkKeyboard.Value = Abs(goInput.UseKeyboard)
+    chkJoy.Value = Abs(goInput.UseJoystick)
+    sldSens.Value = (goInput.JoystickSensitivity * 100000)
+    sldMouseSens.Value = (goInput.MouseSensitivity * 1000)
+    sldKeyboard.Value = (goInput.KeyboardSensitivity * 1000)
+    
+    cboJoy.Enabled = (chkJoy.Value = vbChecked)
+    lblSens.Enabled = (chkJoy.Value = vbChecked)
+    sldSens.Enabled = (chkJoy.Value = vbChecked)
+    lblMouseSens.Enabled = (chkMouse.Value = vbChecked)
+    sldMouseSens.Enabled = (chkMouse.Value = vbChecked)
+    lblKeySens.Enabled = (chkKeyboard.Value = vbChecked)
+    sldKeyboard.Enabled = (chkKeyboard.Value = vbChecked)
+    
+    'Now, let's fill up the ui for the joysticks
+    Set diDevEnum = goInput.InputObject.GetDIDevices(DI8DEVCLASS_GAMECTRL, DIEDFL_ATTACHEDONLY)
+    If diDevEnum.GetCount = 0 Then
+        chkJoy.Enabled = False
+        cboJoy.Enabled = False
+    Else
+        'Ok, there *are* joysticks.  Load them into the combo box
+        Dim lCount As Long
+        lIndex = 0
+        For lCount = 1 To diDevEnum.GetCount
+            cboJoy.AddItem diDevEnum.GetItem(lCount).GetInstanceName
+            If diDevEnum.GetItem(lCount).GetGuidInstance = goInput.JoystickGuid Then lIndex = lCount - 1
+        Next
+        cboJoy.ListIndex = lIndex
+    End If
+End Sub
+
+Private Sub SaveAudioSettings()
+    goInput.UseMouse = (chkMouse.Value = vbChecked)
+    If goInput.UseMouse Then
+        goInput.MouseSensitivity = sldMouseSens.Value / 1000
+    End If
+    goInput.UseKeyboard = (chkKeyboard.Value = vbChecked)
+    If goInput.UseKeyboard Then
+        goInput.KeyboardSensitivity = sldKeyboard.Value / 1000
+    End If
+    goInput.UseJoystick = (chkJoy.Value = vbChecked)
+    If goInput.UseJoystick Then
+        goInput.JoystickGuid = diDevEnum.GetItem(cboJoy.ListIndex + 1).GetGuidInstance
+        goInput.JoystickSensitivity = sldSens.Value / 100000
+    End If
+
+End Sub
+
+Private Sub Form_Unload(Cancel As Integer)
+    'We're leaving the form, save the settings
+    SaveSetting gsKeyName, gsSubKeyInput, "UseMouse", goInput.UseMouse
+    SaveSetting gsKeyName, gsSubKeyInput, "UseKeyboard", goInput.UseKeyboard
+    SaveSetting gsKeyName, gsSubKeyInput, "UseJoystick", goInput.UseJoystick
+    If goInput.UseJoystick Then
+        SaveSetting gsKeyName, gsSubKeyInput, "JoystickGuid", goInput.JoystickGuid
+        SaveSetting gsKeyName, gsSubKeyInput, "JoystickSensitivity", goInput.JoystickSensitivity
+    End If
+    If goInput.UseMouse Then
+        SaveSetting gsKeyName, gsSubKeyInput, "MouseSensitivity", goInput.MouseSensitivity
+    End If
+    If goInput.UseKeyboard Then
+        SaveSetting gsKeyName, gsSubKeyInput, "KeyboardSensitivity", goInput.KeyboardSensitivity
+    End If
+End Sub
+

Library/dxx8/samples/Multimedia/VBSamples/Demos/AirHockey/frmSplash.frm

@@ -0,0 +1,290 @@
+VERSION 5.00
+Object = "{831FDD16-0C5C-11D2-A9FC-0000F8754DA1}#2.0#0"; "MSCOMCTL.OCX"
+Begin VB.Form frmSplash 
+   BorderStyle     =   3  'Fixed Dialog
+   Caption         =   "vb Air Hockey"
+   ClientHeight    =   5400
+   ClientLeft      =   45
+   ClientTop       =   330
+   ClientWidth     =   7200
+   Icon            =   "frmSplash.frx":0000
+   LinkTopic       =   "Form1"
+   MaxButton       =   0   'False
+   MinButton       =   0   'False
+   ScaleHeight     =   5400
+   ScaleWidth      =   7200
+   StartUpPosition =   3  'Windows Default
+   Begin VB.Frame Frame1 
+      Caption         =   "Options"
+      Height          =   2115
+      Left            =   60
+      TabIndex        =   5
+      Top             =   720
+      Width           =   7095
+      Begin VB.CommandButton cmdAudio 
+         Caption         =   "&Audio Options..."
+         Height          =   375
+         Left            =   5040
+         TabIndex        =   15
+         Top             =   1560
+         Width           =   1815
+      End
+      Begin VB.CommandButton cmdInput 
+         Caption         =   "&Input Options..."
+         Height          =   375
+         Left            =   5040
+         TabIndex        =   14
+         Top             =   1080
+         Width           =   1815
+      End
+      Begin VB.CommandButton cmdGraphicsOptions 
+         Caption         =   "&Graphics Options..."
+         Height          =   375
+         Left            =   5040
+         TabIndex        =   13
+         Top             =   600
+         Width           =   1815
+      End
+      Begin MSComctlLib.Slider sldSpeed 
+         Height          =   255
+         Left            =   150
+         TabIndex        =   7
+         Top             =   870
+         Width           =   2055
+         _ExtentX        =   3625
+         _ExtentY        =   450
+         _Version        =   393216
+         LargeChange     =   50
+         SmallChange     =   5
+         Min             =   10
+         Max             =   1000
+         SelStart        =   10
+         TickFrequency   =   100
+         Value           =   10
+      End
+      Begin MSComctlLib.Slider sldScore 
+         Height          =   255
+         Left            =   150
+         TabIndex        =   8
+         Top             =   1470
+         Width           =   2055
+         _ExtentX        =   3625
+         _ExtentY        =   450
+         _Version        =   393216
+         LargeChange     =   3
+         Min             =   2
+         Max             =   20
+         SelStart        =   10
+         TickFrequency   =   2
+         Value           =   10
+      End
+      Begin MSComctlLib.Slider sldPaddleMass 
+         Height          =   255
+         Left            =   2310
+         TabIndex        =   10
+         Top             =   870
+         Width           =   2055
+         _ExtentX        =   3625
+         _ExtentY        =   450
+         _Version        =   393216
+         LargeChange     =   50
+         SmallChange     =   5
+         Min             =   50
+         Max             =   300
+         SelStart        =   50
+         TickFrequency   =   20
+         Value           =   50
+      End
+      Begin VB.Label Label3 
+         BackStyle       =   0  'Transparent
+         Caption         =   $"frmSplash.frx":000C
+         Height          =   435
+         Left            =   60
+         TabIndex        =   12
+         Top             =   180
+         Width           =   6930
+      End
+      Begin VB.Label Label2 
+         BackStyle       =   0  'Transparent
+         Caption         =   "Paddle Mass"
+         Height          =   255
+         Index           =   2
+         Left            =   2430
+         TabIndex        =   11
+         Top             =   630
+         Width           =   3615
+      End
+      Begin VB.Label Label2 
+         BackStyle       =   0  'Transparent
+         Caption         =   "Winning Score"
+         Height          =   255
+         Index           =   1
+         Left            =   270
+         TabIndex        =   9
+         Top             =   1230
+         Width           =   1215
+      End
+      Begin VB.Label Label2 
+         BackStyle       =   0  'Transparent
+         Caption         =   "Game Speed"
+         Height          =   255
+         Index           =   0
+         Left            =   270
+         TabIndex        =   6
+         Top             =   630
+         Width           =   1215
+      End
+   End
+   Begin VB.CommandButton cmdExit 
+      Cancel          =   -1  'True
+      Caption         =   "Exit Game"
+      Height          =   375
+      Left            =   5220
+      TabIndex        =   2
+      Top             =   4860
+      Width           =   1815
+   End
+   Begin VB.CommandButton cmdSingle 
+      Caption         =   "&Single Player Game..."
+      Height          =   375
+      Left            =   5220
+      TabIndex        =   0
+      Top             =   4020
+      Width           =   1815
+   End
+   Begin VB.CommandButton cmdMulti 
+      Caption         =   "&Multiplayer Game..."
+      Height          =   375
+      Left            =   5220
+      TabIndex        =   1
+      Top             =   4440
+      Width           =   1815
+   End
+   Begin VB.Label lblText 
+      BackStyle       =   0  'Transparent
+      Caption         =   "Label2"
+      ForeColor       =   &H80000008&
+      Height          =   2340
+      Left            =   180
+      TabIndex        =   4
+      Top             =   2895
+      Width           =   4920
+   End
+   Begin VB.Label Label1 
+      Alignment       =   2  'Center
+      BackStyle       =   0  'Transparent
+      Caption         =   "Visual Basic Air Hockey"
+      BeginProperty Font 
+         Name            =   "Comic Sans MS"
+         Size            =   21.75
+         Charset         =   0
+         Weight          =   700
+         Underline       =   0   'False
+         Italic          =   0   'False
+         Strikethrough   =   0   'False
+      EndProperty
+      ForeColor       =   &H000000FF&
+      Height          =   675
+      Left            =   120
+      TabIndex        =   3
+      Top             =   0
+      Width           =   6915
+   End
+End
+Attribute VB_Name = "frmSplash"
+Attribute VB_GlobalNameSpace = False
+Attribute VB_Creatable = False
+Attribute VB_PredeclaredId = True
+Attribute VB_Exposed = False
+Option Explicit
+Dim fStartingGame As Boolean
+
+Private Sub cmdAudio_Click()
+    'Here we will allow the changing of the audio options.
+    'Load the options screen
+    frmAudio.Show vbModal, Me
+End Sub
+
+Private Sub cmdExit_Click()
+    'Quit the game
+    Unload Me
+End Sub
+
+Private Sub cmdGraphicsOptions_Click()
+    'Here we will allow the changing of the graphics options.
+    'Load the options screen
+    frmGraphics.Show vbModal, Me
+End Sub
+
+Private Sub cmdInput_Click()
+    'Here we will allow the changing of the input options.
+    'Load the options screen
+    frmInput.Show vbModal, Me
+End Sub
+
+Private Sub cmdMulti_Click()
+    fStartingGame = True
+    SaveAll
+    gfMultiplayer = True
+    gfGameCanBeStarted = False
+    'Go ahead and load the game
+    frmAir.Show vbModeless
+End Sub
+
+Private Sub cmdSingle_Click()
+    fStartingGame = True
+    SaveAll
+    gfMultiplayer = False
+    gfGameCanBeStarted = True
+    'Go ahead and load the game
+    frmAir.Show vbModeless
+End Sub
+
+Private Sub Form_Load()
+    gfScored = True
+    
+    sldSpeed.Value = CLng(GetSetting(gsKeyName, gsSubKey, "Speed", 780))
+    sldScore.Value = CLng(GetSetting(gsKeyName, gsSubKey, "WinningScore", glDefaultWinningScore))
+    sldPaddleMass.Value = CLng(GetSetting(gsKeyName, gsSubKey, "PaddleMass", 100))
+    
+    lblText.Caption = "Options during gameplay:" & vbCrLf & vbCrLf & _
+        "<Space> Start game (launch puck from center)" & vbCrLf & _
+        "<F1> Toggle showing the game room" & vbCrLf & _
+        "<F3> Restart the game after someone has won" & vbCrLf & _
+        "<F4> Toggle the game tables transparency" & vbCrLf & _
+        "<F5> Toggle showing the game table" & vbCrLf & _
+        "<F6> Toggle the paddles transparency" & vbCrLf & _
+        "<V> Scroll through default views" & vbCrLf & _
+        "<W> Toggle wireframe mode" & vbCrLf & vbCrLf & _
+        "Use the right mouse button to get a different view."
+    
+    'Init objects and load values
+    LoadObjects
+End Sub
+
+Private Sub Form_Unload(Cancel As Integer)
+    If Not fStartingGame Then 'We're not starting, cleanup
+        Set goPuck = Nothing
+        Set goPaddle(0) = Nothing
+        Set goPaddle(1) = Nothing
+        Set goCamera = Nothing
+        Set goTable = Nothing
+        Set goRoom = Nothing
+        Set goInput = Nothing
+        Set goAudio = New cAudio
+        Set goDev = Nothing
+        End
+    End If
+End Sub
+
+Private Sub SaveAll()
+    gnVelocityDamp = sldSpeed.Value / 1000
+    glUserWinningScore = sldScore.Value
+    gnPaddleMass = sldPaddleMass.Value / 100
+    goPuck.MaximumPuckVelocity = gnVelocityDamp * glMaxPuckSpeedConstant
+    
+    SaveSetting gsKeyName, gsSubKey, "Speed", CStr(sldSpeed.Value)
+    SaveSetting gsKeyName, gsSubKey, "WinningScore", CStr(sldScore.Value)
+    SaveSetting gsKeyName, gsSubKey, "PaddleMass", CStr(sldPaddleMass.Value)
+End Sub
+

Library/dxx8/samples/Multimedia/VBSamples/Demos/AirHockey/modAudio.bas

@@ -0,0 +1,118 @@
+Attribute VB_Name = "modAudio"
+Option Explicit
+
+'We will keep our Audio vars here
+Dim dmPerf As DirectMusicPerformance8
+Dim dmLoad As DirectMusicLoader8
+Dim dmSegBank() As DirectMusicSegment8
+Dim dmSegHit() As DirectMusicSegment8
+Dim dmScore As DirectMusicSegment8
+
+Public glNumBankSounds As Long
+Public glNumHitSounds As Long
+
+Public Sub SetNumberSounds()
+    Dim sFile As String
+    Dim lCount As Long
+    
+    lCount = 1
+    sFile = Dir$(App.path & "\sounds\bank" & format$(CStr(lCount), "00") & ".wav")
+    Do While sFile <> vbNullString
+        lCount = lCount + 1
+        sFile = Dir$(App.path & "\sounds\bank" & format$(CStr(lCount), "00") & ".wav")
+    Loop
+    glNumBankSounds = lCount - 1
+    lCount = 1
+    sFile = Dir$(App.path & "\sounds\hit" & format$(CStr(lCount), "00") & ".wav")
+    Do While sFile <> vbNullString
+        lCount = lCount + 1
+        sFile = Dir$(App.path & "\sounds\hit" & format$(CStr(lCount), "00") & ".wav")
+    Loop
+    glNumHitSounds = lCount - 1
+End Sub
+
+Public Function InitAudio() As Boolean
+    
+    Dim lCount As Long, dma As DMUS_AUDIOPARAMS
+    
+    On Error GoTo FailedInit
+    InitAudio = True
+    'Create our objects
+    Set dmPerf = dx.DirectMusicPerformanceCreate
+    Set dmLoad = dx.DirectMusicLoaderCreate
+    'Get the total number of sounds we have for each type of sound
+    SetNumberSounds
+    
+    'Using that information create an array of segments
+    ReDim dmSegBank(1 To glNumBankSounds)
+    ReDim dmSegHit(1 To glNumHitSounds)
+    
+    'Create a default audio path
+    dmPerf.InitAudio frmAir.hwnd, DMUS_AUDIOF_ALL, dma, , DMUS_APATH_SHARED_STEREOPLUSREVERB, 128
+    'Load each of the sounds
+    For lCount = 1 To glNumBankSounds
+        Set dmSegBank(lCount) = dmLoad.LoadSegment(App.path & "\sounds\bank" & format$(CStr(lCount), "00") & ".wav")
+        dmSegBank(lCount).Download dmPerf.GetDefaultAudioPath
+    Next
+    For lCount = 1 To glNumHitSounds
+        Set dmSegHit(lCount) = dmLoad.LoadSegment(App.path & "\sounds\hit" & format$(CStr(lCount), "00") & ".wav")
+        dmSegHit(lCount).Download dmPerf.GetDefaultAudioPath
+    Next
+    Set dmScore = dmLoad.LoadSegment(App.path & "\sounds\score.wav")
+    dmScore.Download dmPerf.GetDefaultAudioPath
+    Exit Function
+
+FailedInit:
+    InitAudio = False
+End Function
+
+Public Sub PlayRandomBankSound()
+    Dim lRnd As Long
+    
+    'Pick a valid 'Bank' sound randomly and play it
+    Randomize
+    lRnd = CLng(Rnd * glNumBankSounds) + 1
+    Do While lRnd < 1 Or lRnd > glNumBankSounds
+        lRnd = CLng(Rnd * glNumBankSounds) + 1
+    Loop
+    dmPerf.PlaySegmentEx dmSegBank(lRnd), DMUS_SEGF_SECONDARY, 0
+End Sub
+
+Public Sub PlayRandomHitSound()
+    Dim lRnd As Long
+    
+    'Pick a valid 'Hit' sound randomly and play it
+    Randomize
+    lRnd = CLng(Rnd * glNumHitSounds) + 1
+    Do While lRnd < 1 Or lRnd > glNumHitSounds
+        lRnd = CLng(Rnd * glNumHitSounds) + 1
+    Loop
+    dmPerf.PlaySegmentEx dmSegHit(lRnd), DMUS_SEGF_SECONDARY, 0
+End Sub
+
+Public Sub PlayScoreSound()
+    'Play the sound that happens when we score
+    dmPerf.PlaySegmentEx dmScore, DMUS_SEGF_SECONDARY, 0
+End Sub
+
+Public Sub CleanupAudio()
+
+    On Error Resume Next
+    Dim lCount As Long
+    
+    'Unload all of our sounds off of the audio path and destroy them
+    For lCount = 1 To glNumBankSounds
+        dmSegBank(lCount).Unload dmPerf.GetDefaultAudioPath
+        Set dmSegBank(lCount) = Nothing
+    Next
+    For lCount = 1 To glNumHitSounds
+        dmSegHit(lCount).Unload dmPerf.GetDefaultAudioPath
+        Set dmSegHit(lCount) = Nothing
+    Next
+    If Not (dmScore Is Nothing) Then dmScore.Unload dmPerf.GetDefaultAudioPath
+    Set dmScore = Nothing
+    
+    'Destroy the rest of the objects
+    Set dmPerf = Nothing
+    Set dmLoad = Nothing
+End Sub

Library/dxx8/samples/Multimedia/VBSamples/Demos/AirHockey/modD3D.bas

@@ -0,0 +1,264 @@
+Attribute VB_Name = "modD3D"
+Option Explicit
+
+Public dx As New DirectX8
+
+Public gfDrawRoomText As Boolean
+Public glScreenWidth As Long
+Public glScreenHeight As Long
+
+'Extra misc vars
+Public gfWireFrame As Boolean
+
+Public Sub Render()
+
+    Dim lCount As Long
+    
+    On Error Resume Next
+    If g_dev Is Nothing Then Exit Sub
+
+    ' Clear the backbuffer to a black color
+    g_dev.Clear 0, ByVal 0, D3DCLEAR_TARGET Or D3DCLEAR_ZBUFFER, &H0&, 1#, 0
+     
+    ' Setup the world, view, and projection matrices
+    SetupMatrices
+ 
+    ' Begin the scene
+    g_dev.BeginScene
+    
+    'Draw everything in either a solid fillmode, or wireframe
+    If gfWireFrame Then
+        g_dev.SetRenderState D3DRS_FILLMODE, D3DFILL_WIREFRAME
+    Else
+        g_dev.SetRenderState D3DRS_FILLMODE, D3DFILL_SOLID
+    End If
+    
+    'Render the room
+    goRoom.Render g_dev
+    
+    'Render the table
+    goTable.Render g_dev
+    
+    'Now Paddle (0)
+    goPaddle(0).Render g_dev
+    
+    'Now Paddle (1)
+    goPaddle(1).Render g_dev
+    
+    'And finally the puck
+    goPuck.Render g_dev
+    'Now lets draw whatever text we need
+    
+    'We can draw text (don't draw text if we're currently fading)
+    If Not goFade.AmFading Then
+        goTextLittle.BeginText
+        If gfGameCanBeStarted Then
+            'If the game can be started, then draw the scores at the top of the screen
+            If gfMultiplayer Then
+                If glMyPaddleID = 0 Then
+                    goTextLittle.DrawText gsUserName & ":" & glPlayerScore(0), 10, 5, &HFFFFFF00
+                Else
+                    goTextLittle.DrawText "Opponent:" & glPlayerScore(0), 10, 5, &HFFFFFFFF
+                End If
+                If glMyPaddleID = 1 Then
+                    goTextLittle.DrawText gsUserName & ":" & glPlayerScore(1), glScreenWidth - 75, 5, &HFFFFFF00
+                Else
+                    goTextLittle.DrawText "Opponent:" & glPlayerScore(1), glScreenWidth - 75, 5, &HFFFFFFFF
+                End If
+            Else
+                goTextLittle.DrawText "Player:" & glPlayerScore(0), 10, 5, &HFFFFFF00
+                goTextLittle.DrawText "Computer:" & glPlayerScore(1), glScreenWidth - 75, 5, &HFFFFFFFF
+            End If
+        Else
+            'The game can't be started yet (only in multiplayer)  Let the host know
+            goTextLittle.DrawText "Waiting for the game to be started...", (glScreenWidth / 2) - 50, 5, &HFFFFFFFF
+        End If
+        'Here is a little helper text letting the user know to press Space
+        'to launch the puck (will show up after 3 seconds, and stay on for 10 seconds)
+        If (timeGetTime - glTimePuckScored > glDefaultDelayTime) And gfScored And Not gfGameOver And ((timeGetTime - glTimePuckScored < glDefaultDelayTimeGone + glDefaultDelayTime)) Then
+            goPuck.DefaultStartPosition
+            goPuck.Spinning = True
+            goTextLittle.DrawText "Press <Space> to launch puck...", (glScreenWidth / 2) - 50, 25, &HFF0000FF
+        End If
+        
+        'Here is a little helper text letting the user know to press F1
+        'to turn of the room (will show up after 3 seconds, and stay on for 10 seconds)
+        If (gfDrawRoomText And goRoom.DrawRoom) And (timeGetTime - glTimeNoRoom < glDefaultDelayTimeGone) Then
+            goPuck.DefaultStartPosition
+            goPuck.Spinning = True
+            goTextLittle.DrawText "You can press F1 to turn off the drawing " & vbCrLf & " of the room, which will increase performance.", -15, glScreenHeight - 50, &HFFFF00FF
+        End If
+        If gfGameOver And ((timeGetTime - glTimeGameOver) > glDefaultDelayTime) And ((timeGetTime - glTimeGameOver < glDefaultDelayTimeGone + glDefaultDelayTime)) Then
+            goTextLittle.DrawText "Press F3 to restart...", (glScreenWidth / 2) - 50, 25, &HFF0000FF
+        End If
+        goTextLittle.EndText
+        goTextBig.BeginText
+        If gfGameOver Then
+            If gfMultiplayer Then
+                If glPlayerScore(glMyPaddleID) > glPlayerScore(Abs(glMyPaddleID - 1)) Then
+                    goTextBig.DrawText "Game over!!" & vbCrLf & "You win!!", (glScreenWidth / 2) - (glScreenWidth / 4), (glScreenHeight / 2) - (glScreenHeight / 4), &HFFDD11AA
+                Else
+                    goTextBig.DrawText "Game over!!" & vbCrLf & "You lose!!", (glScreenWidth / 2) - (glScreenWidth / 4), (glScreenHeight / 2) - (glScreenHeight / 4), &HFFDD11AA
+                End If
+            Else
+                If glPlayerScore(0) > glPlayerScore(1) Then
+                    goTextBig.DrawText "Game over!!" & vbCrLf & "You win!!", (glScreenWidth / 2) - (glScreenWidth / 4), (glScreenHeight / 2) - (glScreenHeight / 4), &HFFDD11AA
+                Else
+                    goTextBig.DrawText "Game over!!" & vbCrLf & "You lose!!", (glScreenWidth / 2) - (glScreenWidth / 4), (glScreenHeight / 2) - (glScreenHeight / 4), &HFFDD11AA
+                End If
+            End If
+        End If
+        If gfMultiplayer And gfNoSendData Then 'We've been disconnected sometime, notify the user
+            goTextBig.DrawText "The connection with the other" & vbCrLf & "system was lost.", 5, (glScreenHeight / 2) - (glScreenHeight / 4), &HFFFFFF00
+        End If
+        goTextBig.EndText
+    End If
+    ' End the scene
+    g_dev.EndScene
+    ' Present the backbuffer contents to the front buffer (screen)
+    D3DUtil_PresentAll 0
+    
+End Sub
+
+Public Sub SetupMatrices()
+    
+    Dim matView As D3DMATRIX
+        
+    D3DXMatrixLookAtLH matView, goCamera.Position, vec3(0#, 0#, 0#), vec3(0#, 1#, 0#)
+    g_dev.SetTransform D3DTS_VIEW, matView
+    
+    Dim matProj As D3DMATRIX
+    D3DXMatrixPerspectiveFovLH matProj, g_pi / 4, 1, 1, 110
+    g_dev.SetTransform D3DTS_PROJECTION, matProj
+
+End Sub
+
+Public Sub RestoreDeviceObjects()
+
+    ' Set miscellaneous render states
+    With g_dev
+        ' Set world transform
+        Dim matWorld As D3DMATRIX
+        D3DXMatrixIdentity matWorld
+        .SetTransform D3DTS_WORLD, matWorld
+        ' Set the projection matrix
+        Dim matProj As D3DMATRIX
+        Dim fAspect As Single
+        fAspect = 1
+        D3DXMatrixPerspectiveFovLH matProj, g_pi / 3, fAspect, 1, 1000
+        .SetTransform D3DTS_PROJECTION, matProj
+        
+        .SetTextureStageState 0, D3DTSS_COLORARG1, D3DTA_TEXTURE
+        .SetTextureStageState 0, D3DTSS_COLORARG2, D3DTA_DIFFUSE
+        .SetTextureStageState 0, D3DTSS_COLOROP, D3DTOP_MODULATE
+        .SetTextureStageState 0, D3DTSS_MINFILTER, D3DTEXF_LINEAR
+        .SetTextureStageState 0, D3DTSS_MAGFILTER, D3DTEXF_LINEAR
+        .SetTextureStageState 1, D3DTSS_MINFILTER, D3DTEXF_LINEAR
+        .SetTextureStageState 1, D3DTSS_MAGFILTER, D3DTEXF_LINEAR
+
+        ' Set default render states
+        .SetRenderState D3DRS_DITHERENABLE, 1 'True
+        .SetRenderState D3DRS_SPECULARENABLE, 0 'False
+        .SetRenderState D3DRS_ZENABLE, 1 'True
+        .SetRenderState D3DRS_NORMALIZENORMALS, 1 'True
+
+    End With
+    
+    Set goTextBig = Nothing
+    Set goTextLittle = Nothing
+    
+    'Now create a new text object
+    Set goTextLittle = New cText
+    goTextLittle.InitText g_d3dx, g_dev, "Times New Roman", 8, True
+    Set goTextBig = New cText
+    goTextBig.InitText g_d3dx, g_dev, "Times New Roman", 18, True
+    
+End Sub
+
+Public Sub InitDefaultLights(Optional ByVal lNumLights As Long = 2, Optional ByVal fFullAmbiantOnly As Boolean = False)
+    With g_dev
+        ' Set ambient light
+        .SetRenderState D3DRS_AMBIENT, &HFFFFFFFF
+        goFade.AmbientColor = &HFFFFFFFF
+        goFade.MaxAmbientColor = goFade.AmbientColor
+        If fFullAmbiantOnly Then Exit Sub
+        If lNumLights < 1 Then Exit Sub 'Nothing to do
+        
+        ' Set ambient light
+        'We will slowly lower the ambient light as each new light gets added
+        .SetRenderState D3DRS_AMBIENT, &HFFBBBBBB
+        goFade.AmbientColor = &HFFBBBBBB
+        ' Turn on lighting
+        .SetRenderState D3DRS_LIGHTING, 1
+        
+        'Turn on two lights one on each end of the table
+        Dim light As D3DLIGHT8
+        
+        If lNumLights > 0 Then
+            With light
+                .Type = D3DLIGHT_DIRECTIONAL
+                .diffuse.r = 0
+                .diffuse.g = 0
+                .diffuse.b = 0
+                .Direction.x = 0
+                .Direction.y = -10
+                .Direction.z = 0
+                .Range = 100000#
+                .Position.x = 0
+                .Position.y = 3
+                .Position.z = 0
+            End With
+            goFade.LightColor(0) = light
+    
+            .SetLight 0, light                   'let d3d know about the light
+            .LightEnable 0, 1                    'turn it on
+            goFade.NumLight = 0
+        End If
+        
+        
+        If lNumLights > 1 Then
+            .SetRenderState D3DRS_AMBIENT, &HFFAAAAAA
+            goFade.AmbientColor = &HFFAAAAAA
+            'Now turn on the second light if we can
+            With light
+                .Type = D3DLIGHT_DIRECTIONAL
+                .Direction.x = 15
+                .Direction.y = -10
+                .Direction.z = -15
+                .Range = 1000#
+                .Position.x = -15
+                .Position.y = 10
+                .Position.z = 15
+            End With
+            goFade.LightColor(1) = light
+    
+            .SetLight 1, light                   'let d3d know about the light
+            .LightEnable 1, 1                    'turn it on
+            goFade.NumLight = 1
+        End If
+
+        
+        If lNumLights > 3 Then
+            .SetRenderState D3DRS_AMBIENT, 0
+            goFade.AmbientColor = 0
+            'Now turn on the third light if we can
+            With light
+                .Type = D3DLIGHT_DIRECTIONAL
+                .Direction.x = -15
+                .Direction.y = 10
+                .Direction.z = 15
+                .Range = 1000#
+                .Position.x = 15
+                .Position.y = -10
+                .Position.z = -15
+            End With
+            goFade.LightColor(2) = light
+    
+            .SetLight 2, light                   'let d3d know about the light
+            .LightEnable 2, 1                    'turn it on
+            goFade.NumLight = 2
+        End If
+    End With
+    goFade.MaxAmbientColor = goFade.AmbientColor
+
+End Sub

Library/dxx8/samples/Multimedia/VBSamples/Demos/AirHockey/modDInput.bas

@@ -0,0 +1,158 @@
+Attribute VB_Name = "modDInput"
+Option Explicit
+
+Private Enum DefaultCameraViews
+    DefaultView
+    OverHeadView
+    SideOverheadView1
+    SideOverheadView2
+    OpponentView
+    CustomView
+End Enum
+
+Private Const mnMouseSensitivity As Single = 0.02
+Private Const mnMaxZThresh As Single = 35
+Private Const mnMaxYThresh As Single = 50
+Private Const mnMaxXThresh As Single = 35
+Private mnLastX As Single
+Private mnLastY As Single
+
+'DirectInput variables, etc
+Public Const glBufferSize As Long = 10
+Public Const gnVelocityBoost As Single = 1.1
+
+Public DI As DirectInput8
+Public DIMouse As DirectInputDevice8
+Public gfMovingCamera As Boolean
+
+Public Function InitDInput(oForm As Form) As Boolean
+  
+  Dim diProp As DIPROPLONG
+  
+  On Error GoTo FailedInput
+  
+  InitDInput = True
+  Set DI = dx.DirectInputCreate
+  Set DIMouse = DI.CreateDevice("guid_SysMouse")
+  Call DIMouse.SetCommonDataFormat(DIFORMAT_MOUSE)
+  Call DIMouse.SetCooperativeLevel(oForm.hwnd, DISCL_FOREGROUND Or DISCL_EXCLUSIVE)
+  
+  ' Set the buffer size
+  diProp.lHow = DIPH_DEVICE
+  diProp.lObj = 0
+  diProp.lData = glBufferSize
+  Call DIMouse.SetProperty("DIPROP_BUFFERSIZE", diProp)
+
+  'Acquire the mouse
+  DIMouse.Acquire
+  Exit Function
+  
+FailedInput:
+    InitDInput = False
+
+End Function
+
+Public Sub CleanupDInput()
+    On Error Resume Next
+    'Unacquire the mouse
+    If Not (DIMouse Is Nothing) Then DIMouse.Unacquire
+    'Destroy our objects
+    Set DIMouse = Nothing
+    Set DI = Nothing
+End Sub
+
+Public Sub ProcessMouseData()
+    'This is where we respond to any change in mouse state. Usually this will be an axis movement
+    'or button press or release, but it could also mean we've lost acquisition.
+
+    Dim diDeviceData(1 To glBufferSize) As DIDEVICEOBJECTDATA
+    Dim lNumItems As Long
+    Dim lCount As Integer
+    Dim vOldPaddle As D3DVECTOR
+    Static OldSequence As Long
+  
+    On Error GoTo INPUTLOST 'In case we lost the mouse
+    DIMouse.Acquire 'Just in case
+    lNumItems = DIMouse.GetDeviceData(diDeviceData, 0)
+     On Error GoTo 0 'Reset our error
+    
+    vOldPaddle = goPaddle(glMyPaddleID).Position
+    ' Process data
+    For lCount = 1 To lNumItems
+        Select Case diDeviceData(lCount).lOfs
+        Case DIMOFS_X 'We moved the X axis
+            If gfMovingCamera Then
+                With goCamera.Position
+                    .x = .x + (diDeviceData(lCount).lData * mnMouseSensitivity)
+                    goCamera.SetCameraPosition CustomView, glMyPaddleID
+                    If Abs(.x) > mnMaxXThresh Then
+                        'Whoops too much
+                        .x = mnMaxXThresh * (.x / Abs(.x))
+                    End If
+                End With
+            Else
+                goPaddle(glMyPaddleID).LastPosition = goPaddle(glMyPaddleID).Position
+                With goPaddle(glMyPaddleID).Position
+                    .x = .x + (diDeviceData(lCount).lData * mnMouseSensitivity)
+                    If .x > (gnSideLeftWallEdge - (gnPaddleRadius)) Then
+                        .x = (gnSideLeftWallEdge - (gnPaddleRadius))
+                    ElseIf .x < (gnSideRightWallEdge + (gnPaddleRadius)) Then
+                        .x = (gnSideRightWallEdge + (gnPaddleRadius))
+                    End If
+                End With
+                goPaddle(glMyPaddleID).Velocity.x = goPaddle(glMyPaddleID).Position.x - goPaddle(glMyPaddleID).LastPosition.x
+                goPaddle(glMyPaddleID).LastVelocityTick = timeGetTime
+            End If
+        Case DIMOFS_Y 'We moved the Y axis
+            If gfMovingCamera Then
+                With goCamera.Position
+                    .z = .z - (diDeviceData(lCount).lData * mnMouseSensitivity)
+                    goCamera.SetCameraPosition CustomView, glMyPaddleID
+                    If Abs(.z) > mnMaxZThresh Then
+                        'Whoops too much
+                        .z = mnMaxZThresh * (.z / Abs(.z))
+                    End If
+                End With
+            Else
+                goPaddle(glMyPaddleID).LastPosition = goPaddle(glMyPaddleID).Position
+                With goPaddle(glMyPaddleID).Position
+                    .z = .z - (diDeviceData(lCount).lData * mnMouseSensitivity)
+                    'The front and rear walls are count to the Z axis
+                    If glMyPaddleID = 0 Then
+                        If .z > -2 Then
+                            .z = -2
+                        ElseIf .z < (gnFarWallEdge + (gnPaddleRadius)) Then
+                            .z = (gnFarWallEdge + (gnPaddleRadius))
+                        End If
+                    Else
+                        If .z > (gnNearWallEdge - (gnPaddleRadius)) Then
+                            .z = (gnNearWallEdge - (gnPaddleRadius))
+                        ElseIf .z < 2 Then
+                            .z = 2
+                        End If
+                    End If
+                End With
+                goPaddle(glMyPaddleID).Velocity.z = goPaddle(glMyPaddleID).Position.z - goPaddle(glMyPaddleID).LastPosition.z
+                goPaddle(glMyPaddleID).LastVelocityTick = timeGetTime
+            End If
+    
+        Case DIMOFS_BUTTON1
+            gfMovingCamera = (diDeviceData(lCount).lData And &H80 = &H80)
+    
+        End Select
+        EnsurePaddleReality vOldPaddle, goPaddle(glMyPaddleID)
+    Next lCount
+    Exit Sub
+    
+INPUTLOST:
+    If (Err.Number = DIERR_INPUTLOST) Or (Err.Number = DIERR_NOTACQUIRED) Then
+        'We no longer have the mouse..
+    End If
+End Sub
+
+Public Sub GetAndHandleDinput()
+    'First let's handle the mouse
+    ProcessMouseData
+    'Now we can worry about keyboard
+    'If we have a joystick selected check that too
+End Sub

Library/dxx8/samples/Multimedia/VBSamples/Demos/AirHockey/modDplay.bas

@@ -0,0 +1,193 @@
+Attribute VB_Name = "modDplay"
+Option Explicit
+Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
+
+'We want to keep the amount of data we send down to a bare minimum.  Use the lowest
+'data type we can.  For example, even though Enums are by default Long's
+'We will never have more than 255 messages for this application so we will convert
+'them all to bytes when we send them
+Public Enum vbDplayHockeyMsgType
+    MsgSendGameSettings 'The settings for the application to run under
+    MsgPaddleLocation 'The location of a particular paddle
+    MsgPuckLocation 'The location of the puck
+    MsgPlayerScored 'Someone just scored
+    MsgClientConnectedAndReadyToPlay 'The client is connected, has received the game settings and is ready to play
+    MsgRestartGame 'Time to restart the game
+    MsgCollidePaddle 'Used only for sound effects...
+End Enum
+
+'Constants
+Public Const AppGuid = "{AC35AAB4-32D3-465d-96C3-4F4137FBF9A1}"
+'Minimum frequency to allow sending data (in ms)
+'Regardless of network latency, we never want to send more than 20 msgs/second
+'which equates to a minimum send frequency of 50
+Public Const glMinimumSendFrequency As Long = 1000 \ 20
+'Main Peer object
+Public dpp As DirectPlay8Peer
+'PlayerID of the user who is connected
+Public glOtherPlayerID As Long
+
+'App specific variables
+Public gsUserName As String
+'Our connection form and message pump
+Public DPlayEventsForm As DPlayConnect
+'How often we should send our paddles information
+Public glSendFrequency As Long
+'The amount of latency between two systems
+'(calculated as Avg(RoundTripLatency)/2)
+Public glOneWaySendLatency As Long
+'We have disconnected from the session.  Stop sending data
+Public gfNoSendData As Boolean
+
+Public Sub InitDPlay()
+    'Create our DX/DirectPlay objects
+    If dx Is Nothing Then Set dx = New DirectX8
+    Set dpp = dx.DirectPlayPeerCreate
+    glSendFrequency = glMinimumSendFrequency
+End Sub
+
+Public Sub CleanupDPlay()
+    On Error Resume Next
+    If Not (DPlayEventsForm Is Nothing) Then
+        If Not (dpp Is Nothing) Then dpp.UnRegisterMessageHandler
+        DPlayEventsForm.DoSleep 50
+        'Get rid of our message pump
+        DPlayEventsForm.GoUnload
+        'Close down our session
+        If Not (dpp Is Nothing) Then dpp.Close
+        'Lose references to peer and dx objects
+        Set dpp = Nothing
+        Set dx = Nothing
+    End If
+End Sub
+
+Public Sub UpdateNetworkSettings()
+
+    Dim lMsg As Long, lNumMsg As Long, lNumByte As Long
+    Dim lOffset As Long, oBuf() As Byte
+    Static lLastSendTime As Long
+    Static lLastSendCount As Long
+    
+    On Error Resume Next 'in case we are already in this sub when we receive our connection terminated message
+    If gfGameOver Then Exit Sub
+    If gfNoSendData Then Exit Sub
+    If Not gfGameCanBeStarted Then Exit Sub
+    'First lets check the current send queue information.  IF the queue is building up,
+    'then we need to bump up the frequency so we don't oversaturate our line.
+    dpp.GetSendQueueInfo glOtherPlayerID, lNumMsg, lNumByte
+    If lNumMsg > 3 Or lNumByte > 256 Then
+        'We are sending data to fast, slow down
+        glSendFrequency = glSendFrequency + glMinimumSendFrequency
+    End If
+    'Here we will send the current game state (puck, and paddle information), and we will send this information
+    'not faster than the glSendFrequency (which will be throttled according to latency)
+    If timeGetTime - lLastSendTime > glSendFrequency Then
+        If gfHost Then
+            lLastSendCount = lLastSendCount + 1
+            'We will not send the puck every time
+            If lLastSendCount > 3 Then
+                'Update puck
+                'SendPuck 0
+                lLastSendCount = 0
+            End If
+        End If
+        
+        'Now send our paddle
+        lMsg = MsgPaddleLocation
+        AddDataToBuffer oBuf, CByte(lMsg), SIZE_BYTE, lOffset 'Msg
+        AddDataToBuffer oBuf, CByte(glMyPaddleID), SIZE_BYTE, lOffset 'Paddle ID
+        AddDataToBuffer oBuf, goPaddle(glMyPaddleID).Position, LenB(goPaddle(glMyPaddleID).Position), lOffset 'Paddle information
+        'We will send this information to the other player only
+        dpp.SendTo glOtherPlayerID, oBuf, glSendFrequency, 0
+        lLastSendTime = timeGetTime
+    End If
+
+End Sub
+
+Public Sub NotifyClientReady()
+    Dim lMsg As Long
+    Dim lOffset As Long, oBuf() As Byte
+    
+    If gfNoSendData Then Exit Sub
+    If Not gfMultiplayer Then Exit Sub
+    If gfHost Then Exit Sub 'Only the client needs to tell the host
+    'Here we will tell the host we are ready to play
+    lMsg = MsgClientConnectedAndReadyToPlay
+    AddDataToBuffer oBuf, CByte(lMsg), SIZE_BYTE, lOffset
+    'We will send this information to the other player only
+    dpp.SendTo glOtherPlayerID, oBuf, glSendFrequency, DPNSEND_GUARANTEED Or DPNSEND_PRIORITY_HIGH
+    gfGameCanBeStarted = True
+End Sub
+
+Public Sub NotifyPlayersWeScored()
+    Dim lMsg As Long
+    Dim lOffset As Long, oBuf() As Byte
+    
+    If gfNoSendData Then Exit Sub
+    If Not gfMultiplayer Then Exit Sub
+    If Not gfHost Then Exit Sub
+    'Here we will tell the host we are ready to play
+    lMsg = MsgPlayerScored
+    AddDataToBuffer oBuf, CByte(lMsg), SIZE_BYTE, lOffset
+    'We will send this information to the other player only
+    dpp.SendTo glOtherPlayerID, oBuf, glSendFrequency, DPNSEND_GUARANTEED Or DPNSEND_PRIORITY_HIGH
+End Sub
+
+Public Sub NotifyGameRestart()
+    Dim lMsg As Long
+    Dim lOffset As Long, oBuf() As Byte
+    
+    If gfNoSendData Then Exit Sub
+    If Not gfMultiplayer Then Exit Sub
+    'Here we will tell the host we are ready to play
+    lMsg = MsgRestartGame
+    AddDataToBuffer oBuf, CByte(lMsg), SIZE_BYTE, lOffset
+    'We will send this information to the other player only
+    dpp.SendTo glOtherPlayerID, oBuf, glSendFrequency, DPNSEND_GUARANTEED Or DPNSEND_PRIORITY_HIGH
+End Sub
+
+Public Sub SendGameSettings()
+    Dim lMsg As Long
+    Dim lOffset As Long, oBuf() As Byte
+    
+    If gfNoSendData Then Exit Sub
+    If Not gfMultiplayer Then Exit Sub
+    If Not gfHost Then Exit Sub
+    'Here we will tell the host we are ready to play
+    lMsg = MsgSendGameSettings
+    AddDataToBuffer oBuf, CByte(lMsg), SIZE_BYTE, lOffset
+    AddDataToBuffer oBuf, gnVelocityDamp, LenB(gnVelocityDamp), lOffset
+    AddDataToBuffer oBuf, glUserWinningScore, LenB(glUserWinningScore), lOffset
+    AddDataToBuffer oBuf, gnPaddleMass, LenB(gnPaddleMass), lOffset
+    'We will send this information to the other player only
+    dpp.SendTo glOtherPlayerID, oBuf, glSendFrequency, DPNSEND_GUARANTEED Or DPNSEND_PRIORITY_HIGH
+End Sub
+
+Public Sub SendPuck(Optional ByVal lFlags As Long = (DPNSEND_GUARANTEED Or DPNSEND_PRIORITY_HIGH))
+    Dim lMsg As Long
+    Dim lOffset As Long, oBuf() As Byte
+    
+    If gfNoSendData Then Exit Sub
+    If Not gfMultiplayer Then Exit Sub
+    'Here we will tell the host we are ready to play
+    lMsg = MsgPuckLocation
+    AddDataToBuffer oBuf, CByte(lMsg), SIZE_BYTE, lOffset
+    AddDataToBuffer oBuf, goPuck.Position, LenB(goPuck.Position), lOffset
+    AddDataToBuffer oBuf, goPuck.Velocity, LenB(goPuck.Velocity), lOffset
+    'We will send this information to the other player only
+    dpp.SendTo glOtherPlayerID, oBuf, glSendFrequency, lFlags
+End Sub
+
+Public Sub SendCollidePaddle()
+    Dim lMsg As Long
+    Dim lOffset As Long, oBuf() As Byte
+    
+    If gfNoSendData Then Exit Sub
+    If Not gfMultiplayer Then Exit Sub
+    'Here we will tell the host we are ready to play
+    lMsg = MsgCollidePaddle
+    AddDataToBuffer oBuf, CByte(lMsg), SIZE_BYTE, lOffset
+    'We will send this information to the other player only
+    dpp.SendTo glOtherPlayerID, oBuf, glSendFrequency, DPNSEND_GUARANTEED Or DPNSEND_PRIORITY_HIGH
+End Sub
+

Library/dxx8/samples/Multimedia/VBSamples/Demos/AirHockey/modHelper.bas

@@ -0,0 +1,639 @@
+Attribute VB_Name = "modAirHockey"
+Option Explicit
+
+Public dx As New DirectX8
+
+Public Type HockeyPlayerInfo
+    Score As Long 'Current score of this player
+    PlayerName As String ' The name of the player
+    Latency As Long 'Average latency (ping time) of this player
+End Type
+
+'Declare for timeGetTime
+Public Declare Function timeGetTime Lib "winmm.dll" () As Long
+
+'Registry constants (for saving and retreiving information)
+Public Const gsKeyName As String = "vbAirHockey"
+Public Const gsSubKey As String = "Defaults"
+Public Const gsSubKeyAudio As String = "Audio"
+Public Const gsSubKeyInput As String = "Input"
+Public Const gsSubKeyGraphics As String = "Graphics"
+
+Public Const glMaxPuckSpeedConstant As Long = 10.23
+
+'The wall locations, use these for easier collision detection
+Public Const gnSideRightWallEdge As Single = -5
+Public Const gnSideLeftWallEdge As Single = 5
+Public Const gnNearWallEdge As Single = 9.92
+Public Const gnFarWallEdge As Single = -9.92
+'We also need the dimensions for the 'scoring area' so we can tell when we score
+Public Const gnScoringEdgeLeft As Single = 1.35
+Public Const gnScoringEdgeRight As Single = -1.35
+
+Public Const gnPuckScored As Single = 1.15
+'Radius constants for the puck and paddle
+Public Const gnPuckRadius As Single = 0.46046
+Public Const gnPaddleRadius As Single = 0.6
+'ComputerAI Maximum velocity
+Public Const gnComputerMaximumVelocity As Single = 0.43
+'Winning score
+Public Const glDefaultWinningScore As Long = 7
+
+'We will ensure that we have at least a particular number of physics calculations per second
+'We will lower frame rate to ensure we can calculate these physic calculations if necessary
+'Number of physics calculations per second
+Public Const glNumPhysicCalcPerSec As Long = 100
+'Ticks between physic calcs
+Public Const glNumTickForPhysicCalcs As Long = 1000 \ glNumPhysicCalcPerSec
+
+'Minimum delay before allowing another paddle hit
+Public Const glMinDelayPaddleHit = 100
+'Delay time (ms) before 'helper' text appears
+Public Const glDefaultDelayTime As Long = 3000
+'Delay time (ms) before 'helper' text disappears
+Public Const glDefaultDelayTimeGone As Long = 10000
+Public Const gnVelocityBoost As Single = 1.1
+
+'The objects that can appear in the scene
+Public goCamera As cCamera 'Doesn't really appear in the scene, but it does control what we see in the scene
+Public goPuck As cPuck 'The puck.  Pretty important
+Public goPaddle(1) As cPaddle 'There are two paddles
+Public goTable As cTable 'The table will never have a destination or a velocity, but we may need to move it's position
+Public goRoom As cRoom 'The room information
+Public goAudio As cAudio 'All of the audio information will be stored here
+Public goInput As cInput 'All of the input (mouse,keyboard, joystick,etc) will be stored here
+Public goFade As cFade 'The 'Fading' class
+'Text variables
+Public goTextLittle As cText
+Public goTextBig As cText
+'Main 'Select device' form
+Public goDev As frmSelectDevice
+
+'Which paddle am I controlling (Used mainly for multiplayer mode)
+Public glMyPaddleID As Long
+Public gfScored As Boolean 'Is the puck in the scored state
+Public gfMultiplayer As Boolean 'Is this a multiplayer game
+Public gfHost As Boolean 'Am I the host of this game?
+Public gfGameCanBeStarted As Boolean 'Can the game be started
+Public gPlayer(1) As HockeyPlayerInfo 'Current information of all the players
+Public gfRecentlyHitPaddle As Boolean 'Have we recently hit a paddle?
+'Current time for all objects
+Public glTimeCompPaddle As Long
+'Is the game over (ie, has someone won the game)
+Public gfGameOver As Boolean
+'The user defined winning score
+Public glUserWinningScore As Long
+Public glPaddleCollideTime As Long
+'We'll maintain a slight dampening factor for realism as the puck bounces off
+'the wall
+Public gnVelocityDamp As Single
+'Paddle mass
+Public gnPaddleMass As Single
+'Time the puck was last scored
+Public glTimePuckScored As Long
+'Time the game was over
+Public glTimeGameOver As Long
+'Time the F1 help was displayed
+Public glTimeNoRoom As Long
+'Is the system paused
+Public gfSystemPause As Boolean
+
+Public gfDrawRoomText As Boolean
+Public glScreenWidth As Long
+Public glScreenHeight As Long
+
+Public gfObjectsLoaded As Boolean
+
+'Extra misc vars
+Public gfWireFrame As Boolean
+
+Public Sub MainGameLoop()
+    Dim lTime As Long
+    Dim lLastPhysicsTime As Long
+    
+    'Start the render loop
+    lTime = timeGetTime
+    Do While True
+        Do While Not gfSystemPause
+            'In each frame we need to do a few things
+            If (timeGetTime - lTime > 100) And (Not gfDrawRoomText) And (goRoom.DrawRoom) Then
+                'We want to maintain a reasonable frame rate (10fps is on
+                'the low end), so if we start taking too long between updates,
+                'tell them they can get rid of the room
+                gfDrawRoomText = True
+                glTimeNoRoom = timeGetTime
+            End If
+            lTime = timeGetTime
+            'Check to see if the game is over
+            CheckGameOver
+            'We need to update any objects that are in the scene
+            UpdateObjects
+            'Get and handle any input
+            goInput.GetAndHandleInput goPaddle(glMyPaddleID), goPuck
+            If (Not gfScored) And (Not gfGameOver) Then
+                'Next we need to check for any collisions that may have happened
+                goPuck.CheckCollisions goPaddle, goAudio
+                If Not gfMultiplayer Then 'Only on single player mode
+                    'Let the Computer AI do it's thing
+                    goPaddle(Abs(glMyPaddleID - 1)).DoComputerAI goPuck
+                End If
+            End If
+            'We need to update the game state on the other machine
+            If gfMultiplayer Then
+                UpdateNetworkSettings
+            Else
+                If gfScored Then goPaddle(Abs(glMyPaddleID - 1)).UpdateTime
+            End If
+            'Only redraw the world if we're keeping up with our physic calculations
+            If timeGetTime - lLastPhysicsTime < glNumTickForPhysicCalcs Then
+                'We should fade if necessary
+                If goFade.AmFading Then goFade.UpdateFade goPuck, goPaddle, goTable, goRoom
+                'Now we need to render the frame
+                Render
+            End If
+            lLastPhysicsTime = timeGetTime
+            DoEvents
+        Loop
+        'Now give the CPU a chance
+        DoEvents
+    Loop
+End Sub
+
+Public Sub LoadDefaultStartPositions()
+    'Our camera will start away from the table, and zoom in on it
+    With goCamera
+        .Position = vec3(0, 35, -40)
+        .LastPosition = .Position
+    End With
+    goCamera.SetCameraPosition 0, glMyPaddleID
+    'The puck's initial position should be on top of the table
+    With goPaddle(0)
+        .Position = vec3(0, 2.5, -6.8)
+        .LastPosition = .Position
+    End With
+    With goPaddle(1)
+        .Position = vec3(0, 2.5, 6.8)
+        .LastPosition = .Position
+    End With
+    With goTable
+        .Position = vec3(0, -5, 0)
+    End With
+    goPuck.DefaultStartPosition
+    
+End Sub
+
+Public Sub UpdateObjects()
+    'We need a timer for each of the objects we're updating
+    Dim lCount As Long
+    
+    If gfMultiplayer And gfNoSendData Then 'Uh oh!  We've been disconnected sometime, no need to process anything
+        Exit Sub
+    End If
+    'Update the camera's position based on it's velocity
+    goCamera.UpdatePosition
+    'Update the puck's position
+    goPuck.UpdatePosition
+End Sub
+
+Public Sub CheckGameOver()
+    Dim lCount As Long
+    
+    If gfGameOver Then Exit Sub
+    For lCount = 0 To 1
+        If gPlayer(lCount).Score >= glUserWinningScore Then
+            'Make sure we're leading the other player by 2 or more
+            If gPlayer(lCount).Score > gPlayer(Abs(lCount - 1)).Score + 1 Then
+                gfGameOver = True
+                glTimeGameOver = timeGetTime
+            End If
+        End If
+    Next
+End Sub
+
+Public Sub ShowStartup()
+
+    'Now 'zoom' in with our camera
+    Do While ((goCamera.Dest.Y <> goCamera.Position.Y) Or (goCamera.Dest.z <> goCamera.Position.z))
+        goCamera.UpdatePosition
+        Render
+        DoEvents
+    Loop
+    
+End Sub
+
+Public Sub LoadObjects()
+        
+    If gfObjectsLoaded Then Exit Sub
+    'Initialize the objects
+    Set goPuck = New cPuck
+    Set goPaddle(0) = New cPaddle
+    goPaddle(0).PaddleID = 0
+    Set goPaddle(1) = New cPaddle
+    goPaddle(1).PaddleID = 1
+    If goCamera Is Nothing Then Set goCamera = New cCamera
+    Set goTable = New cTable
+    Set goRoom = New cRoom
+    
+    If goInput Is Nothing Then Set goInput = New cInput
+    If goAudio Is Nothing Then Set goAudio = New cAudio
+    If goFade Is Nothing Then Set goFade = New cFade
+    If goDev Is Nothing Then Set goDev = New frmSelectDevice
+    
+    D3DEnum_BuildAdapterList frmAir
+    
+    'Get any defaults from the registry we might need
+    goTable.DrawTable = GetSetting(gsKeyName, gsSubKey, "DrawTable", True)
+    goRoom.DrawRoom = GetSetting(gsKeyName, gsSubKey, "DrawRoom", True)
+    goRoom.barRoom = GetSetting(gsKeyName, gsSubKey, "RoomIsBarRoom", True)
+    
+    'Audio options
+    goAudio.PlayMusic = GetSetting(gsKeyName, gsSubKeyAudio, "UseBackgroundMusic", False)
+    goAudio.PlaySounds = GetSetting(gsKeyName, gsSubKeyAudio, "UseSound", True)
+    goAudio.MusicVolume = GetSetting(gsKeyName, gsSubKeyAudio, "MusicVolume", 0)
+    goAudio.SoundVolume = GetSetting(gsKeyName, gsSubKeyAudio, "SoundVolume", 0)
+    'Input options
+    goInput.UseMouse = GetSetting(gsKeyName, gsSubKeyInput, "UseMouse", True)
+    goInput.UseKeyboard = GetSetting(gsKeyName, gsSubKeyInput, "UseKeyboard", True)
+    goInput.UseJoystick = GetSetting(gsKeyName, gsSubKeyInput, "UseJoystick", False)
+    goInput.JoystickGuid = GetSetting(gsKeyName, gsSubKeyInput, "JoystickGuid", vbNullString)
+    goInput.JoystickSensitivity = GetSetting(gsKeyName, gsSubKeyInput, "JoystickSensitivity", 0.00025)
+    goInput.MouseSensitivity = GetSetting(gsKeyName, gsSubKeyInput, "MouseSensitivity", 0.02)
+    goInput.KeyboardSensitivity = GetSetting(gsKeyName, gsSubKeyInput, "KeyboardSensitivity", 0.002)
+    'D3D options
+    goDev.Windowed = GetSetting(gsKeyName, gsSubKeyGraphics, "Windowed", True)
+    goDev.Adapter = GetSetting(gsKeyName, gsSubKeyGraphics, "AdapterID", 0)
+    goDev.Mode = GetSetting(gsKeyName, gsSubKeyGraphics, "Mode", 0)
+    
+    gfObjectsLoaded = True
+    
+End Sub
+
+Public Sub PauseSystem(ByVal fPause As Boolean)
+    gfSystemPause = fPause
+    If Not fPause Then
+        glTimeCompPaddle = timeGetTime
+    End If
+    If Not (goPuck Is Nothing) Then
+        goPuck.PauseSystem fPause
+    End If
+End Sub
+
+Public Sub Cleanup(Optional fFinalCleanup As Boolean = False, Optional fOnlyD3D As Boolean = False)
+    
+    'Getting rid of the objects will clean up the internal objects
+    If fFinalCleanup Then
+        Set goPuck = Nothing
+        Set goPaddle(0) = Nothing
+        Set goPaddle(1) = Nothing
+        Set goTable = Nothing
+        Set goRoom = Nothing
+        Set goTextBig = Nothing
+        Set goTextLittle = Nothing
+        If Not fOnlyD3D Then
+            Set goInput = Nothing
+            Set goAudio = Nothing
+            Set goFade = Nothing
+            Set goDev = Nothing
+        End If
+        gfObjectsLoaded = False
+    Else
+        goPuck.CleanupFrame
+        goPaddle(0).CleanupFrame
+        goPaddle(1).CleanupFrame
+        goTable.CleanupFrame
+        goRoom.CleanupFrame
+    End If
+End Sub
+
+Public Sub InitGeometry()
+        
+    LoadObjects
+    'First set up the media
+    D3DUtil_SetMediaPath AddDirSep(App.path) & "models\"
+    goRoom.Init g_mediaPath, "room.x", "lobby_skybox.x"
+    frmAir.IncreaseProgressBar
+    goPaddle(1).Init g_mediaPath, "paddle.x"
+    frmAir.IncreaseProgressBar
+    goPaddle(0).Init g_mediaPath, "paddle.x"
+    frmAir.IncreaseProgressBar
+    goPuck.Init g_mediaPath, "puck.x"
+    frmAir.IncreaseProgressBar
+    goTable.Init g_mediaPath, "table.x"
+    frmAir.IncreaseProgressBar
+    
+End Sub
+
+Public Sub Render()
+
+    Dim lCount As Long
+    
+    On Error Resume Next
+    If gfSystemPause Then Exit Sub
+    If g_dev Is Nothing Then Exit Sub
+
+        ' Clear the backbuffer to a black color
+    If gfMultiplayer And gfNoSendData Then 'Uh oh!  We've been disconnected sometime, notify the user
+        D3DUtil_ClearAll &HFF0000FF 'Clear with a blue background
+    Else
+        D3DUtil_ClearAll 0
+        
+        ' Setup the view and projection matrices
+        SetupMatrices
+        
+        ' Begin the scene
+        g_dev.BeginScene
+        
+        'Draw everything in either a solid fillmode, or wireframe
+        If gfWireFrame Then
+           g_dev.SetRenderState D3DRS_FILLMODE, D3DFILL_WIREFRAME
+        Else
+           g_dev.SetRenderState D3DRS_FILLMODE, D3DFILL_SOLID
+        End If
+       
+        If goFade.AmFading Then
+            g_dev.SetRenderState D3DRS_ALPHABLENDENABLE, 1  'TRUE
+            g_dev.SetRenderState D3DRS_SRCBLEND, D3DBLEND_SRCALPHA
+            g_dev.SetRenderState D3DRS_DESTBLEND, D3DBLEND_INVSRCALPHA
+        End If
+       
+        'Render the room
+        goRoom.Render g_dev
+       
+        'Render the table
+        goTable.Render g_dev
+        
+        'Now Paddle (0)
+        goPaddle(0).Render g_dev
+        
+        'Now Paddle (1)
+        goPaddle(1).Render g_dev
+        
+        'And finally the puck
+        goPuck.Render g_dev
+        'Now lets draw whatever text we need
+    End If
+    
+    'We can draw text (don't draw text if we're currently fading)
+    If Not goFade.AmFading Then
+        goTextLittle.BeginText
+        If gfGameCanBeStarted Then
+            'If the game can be started, then draw the scores at the top of the screen
+            If gfMultiplayer Then
+                If glMyPaddleID = 0 Then
+                    goTextLittle.DrawText gsUserName & ":" & gPlayer(0).Score, 10, 5, &HFFFFFF00
+                Else
+                    goTextLittle.DrawText "Opponent:" & gPlayer(0).Score, 10, 5, &HFFFFFFFF
+                End If
+                If glMyPaddleID = 1 Then
+                    goTextLittle.DrawText gsUserName & ":" & gPlayer(1).Score, glScreenWidth - 75, 5, &HFFFFFF00
+                Else
+                    goTextLittle.DrawText "Opponent:" & gPlayer(1).Score, glScreenWidth - 75, 5, &HFFFFFFFF
+                End If
+            Else
+                goTextLittle.DrawText "Player:" & gPlayer(0).Score, 10, 5, &HFFFFFF00
+                goTextLittle.DrawText "Computer:" & gPlayer(1).Score, glScreenWidth - 75, 5, &HFFFFFFFF
+            End If
+        Else
+            'The game can't be started yet (only in multiplayer)  Let the host know
+            goTextLittle.DrawText "Waiting for the game to be started...", (glScreenWidth / 2) - 50, 5, &HFFFFFFFF
+        End If
+        'Here is a little helper text letting the user know to press Space
+        'to launch the puck (will show up after 3 seconds, and stay on for 10 seconds)
+        If (timeGetTime - glTimePuckScored > glDefaultDelayTime) And gfScored And Not gfGameOver And ((timeGetTime - glTimePuckScored < glDefaultDelayTimeGone + glDefaultDelayTime)) Then
+            goPuck.DefaultStartPosition
+            goPuck.Spinning = True
+            goTextLittle.DrawText "Press <Space> to launch puck...", (glScreenWidth / 2) - 50, 25, &HFF0000FF
+        End If
+        
+        'Here is a little helper text letting the user know to press F1
+        'to turn of the room (will show up after 3 seconds, and stay on for 10 seconds)
+        If (gfDrawRoomText And goRoom.DrawRoom) And (timeGetTime - glTimeNoRoom < glDefaultDelayTimeGone) Then
+            goTextLittle.DrawText "You can press F1 to turn off the drawing " & vbCrLf & " of the room, which will increase performance.", -15, glScreenHeight - 50, &HFFFF00FF
+        End If
+        If gfGameOver And ((timeGetTime - glTimeGameOver) > glDefaultDelayTime) And ((timeGetTime - glTimeGameOver < glDefaultDelayTimeGone + glDefaultDelayTime)) Then
+            goTextLittle.DrawText "Press F3 to restart...", (glScreenWidth / 2) - 50, 25, &HFF0000FF
+        End If
+        goTextLittle.EndText
+        goTextBig.BeginText
+        If gfGameOver Then
+            If gfMultiplayer Then
+                If gPlayer(glMyPaddleID).Score > gPlayer(Abs(glMyPaddleID - 1)).Score Then
+                    goTextBig.DrawText "Game over!!" & vbCrLf & "You win!!", (glScreenWidth / 2) - (glScreenWidth / 4), (glScreenHeight / 2) - (glScreenHeight / 4), &HFFDD11AA
+                Else
+                    goTextBig.DrawText "Game over!!" & vbCrLf & "You lose!!", (glScreenWidth / 2) - (glScreenWidth / 4), (glScreenHeight / 2) - (glScreenHeight / 4), &HFFDD11AA
+                End If
+            Else
+                If gPlayer(0).Score > gPlayer(1).Score Then
+                    goTextBig.DrawText "Game over!!" & vbCrLf & "You win!!", (glScreenWidth / 2) - (glScreenWidth / 4), (glScreenHeight / 2) - (glScreenHeight / 4), &HFFDD11AA
+                Else
+                    goTextBig.DrawText "Game over!!" & vbCrLf & "You lose!!", (glScreenWidth / 2) - (glScreenWidth / 4), (glScreenHeight / 2) - (glScreenHeight / 4), &HFFDD11AA
+                End If
+            End If
+        End If
+        If gfMultiplayer And gfNoSendData Then 'Uh oh!  We've been disconnected sometime, notify the user
+            goTextBig.DrawText "The connection with the other" & vbCrLf & "system was lost.", 5, (glScreenHeight / 2) - (glScreenHeight / 4), &HFFFFFF00
+            'This message isn't on a timer to go away
+        End If
+        goTextBig.EndText
+    End If
+    ' End the scene
+    g_dev.EndScene
+    ' Present the backbuffer contents to the front buffer (screen)
+    D3DUtil_PresentAll 0
+    
+End Sub
+
+Public Sub SetupMatrices()
+    
+    Dim matView As D3DMATRIX
+    Dim matProj As D3DMATRIX
+        
+    D3DXMatrixLookAtLH matView, goCamera.Position, vec3(0#, 0#, 0#), vec3(0#, 1#, 0#)
+    g_dev.SetTransform D3DTS_VIEW, matView
+    
+    D3DXMatrixPerspectiveFovLH matProj, g_pi / 4, 1, 1, 110
+    g_dev.SetTransform D3DTS_PROJECTION, matProj
+
+End Sub
+
+Public Sub RestoreDeviceObjects()
+
+    ' Set miscellaneous render states
+    With g_dev
+        ' Set world transform
+        Dim matWorld As D3DMATRIX
+        D3DXMatrixIdentity matWorld
+        .SetTransform D3DTS_WORLD, matWorld
+        
+        .SetTextureStageState 0, D3DTSS_COLORARG2, D3DTA_DIFFUSE
+        .SetTextureStageState 0, D3DTSS_ALPHAOP, D3DTOP_SELECTARG1
+        .SetTextureStageState 0, D3DTSS_ALPHAARG1, D3DTA_DIFFUSE
+        .SetTextureStageState 0, D3DTSS_MINFILTER, D3DTEXF_LINEAR
+        .SetTextureStageState 0, D3DTSS_MAGFILTER, D3DTEXF_LINEAR
+
+        ' Set default render states
+        .SetRenderState D3DRS_ZENABLE, 1 'True
+
+    End With
+    
+    Set goTextBig = Nothing
+    Set goTextLittle = Nothing
+    
+    'Now create a new text object
+    Set goTextLittle = New cText
+    goTextLittle.InitText g_d3dx, g_dev, "Times New Roman", 8, True
+    Set goTextBig = New cText
+    goTextBig.InitText g_d3dx, g_dev, "Times New Roman", 18, True
+    
+End Sub
+
+Public Sub InitDefaultLights(ByVal lNumLights As Long)
+    With g_dev
+        ' Set ambient light
+        .SetRenderState D3DRS_AMBIENT, &HFFFFFFFF
+        If lNumLights < 3 Then Exit Sub 'Nothing to do
+        
+        ' Set ambient light
+        'We will slowly lower the ambient light as each new light gets added
+        .SetRenderState D3DRS_AMBIENT, &HFFBBBBBB
+        ' Turn on lighting
+        .SetRenderState D3DRS_LIGHTING, 1
+        
+        'Turn on two lights one on each end of the table
+        Dim light As D3DLIGHT8
+        
+        If lNumLights > 0 Then
+            With light
+                .Type = D3DLIGHT_DIRECTIONAL
+                .diffuse.r = 1
+                .diffuse.g = 1
+                .diffuse.b = 1
+                .Direction.X = 0
+                .Direction.Y = -10
+                .Direction.z = 0
+                .Range = 1.84467435229094E+19 'User defined.
+                .Position.X = 0
+                .Position.Y = 3
+                .Position.z = 0
+            End With
+    
+            .SetLight 0, light                   'let d3d know about the light
+            .LightEnable 0, 1                    'turn it on
+        End If
+        
+        
+        If lNumLights > 1 Then
+            .SetRenderState D3DRS_AMBIENT, &HFFAAAAAA
+            'Now turn on the second light if we can
+            With light
+                .Type = D3DLIGHT_DIRECTIONAL
+                .Direction.X = 5
+                .Direction.Y = -3
+                .Direction.z = -5
+                .Position.X = -5
+                .Position.Y = 3
+                .Position.z = 5
+            End With
+    
+            .SetLight 1, light                   'let d3d know about the light
+            .LightEnable 1, 1                    'turn it on
+        End If
+
+        
+        If lNumLights > 3 Then
+            .SetRenderState D3DRS_AMBIENT, 0
+            'Now turn on the third light if we can
+            With light
+                .Type = D3DLIGHT_DIRECTIONAL
+                .Direction.X = -5
+                .Direction.Y = 3
+                .Direction.z = 5
+                .Position.X = 5
+                .Position.Y = -3
+                .Position.z = -5
+            End With
+    
+            .SetLight 2, light                   'let d3d know about the light
+            .LightEnable 2, 1                    'turn it on
+        End If
+    End With
+End Sub
+
+Public Sub SaveOrRestoreObjectSettings(ByVal fSave As Boolean)
+    'Puck
+    Static LastPuckPosition As D3DVECTOR
+    Static PuckPosition As D3DVECTOR
+    Static MaxPuckVel As Single
+    Static PuckSpinning As Boolean
+    Static PuckVelocity As D3DVECTOR
+    
+    If fSave Then
+        LastPuckPosition = goPuck.LastPosition
+        MaxPuckVel = goPuck.MaximumPuckVelocity
+        PuckPosition = goPuck.Position
+        PuckSpinning = goPuck.Spinning
+        PuckVelocity = goPuck.Velocity
+    Else
+        goPuck.LastPosition = LastPuckPosition
+        goPuck.MaximumPuckVelocity = MaxPuckVel
+        goPuck.Position = PuckPosition
+        goPuck.Spinning = PuckSpinning
+        goPuck.Velocity = PuckVelocity
+    End If
+    
+    'paddles
+    Static LastPaddlePosition(1) As D3DVECTOR
+    Static LastPaddleVelTick(1) As Long
+    Static PaddleID(1) As Long
+    Static PaddlePosition(1) As D3DVECTOR
+    Static PaddleTrans(1) As Boolean
+    Static PaddleVelocity(1) As D3DVECTOR
+    
+    Dim i As Integer
+    If fSave Then
+        For i = 0 To 1
+            LastPaddlePosition(i) = goPaddle(i).LastPosition
+            LastPaddleVelTick(i) = goPaddle(i).LastVelocityTick
+            PaddleID(i) = goPaddle(i).PaddleID
+            PaddlePosition(i) = goPaddle(i).Position
+            PaddleTrans(i) = goPaddle(i).Transparent
+            PaddleVelocity(i) = goPaddle(i).Velocity
+        Next
+    Else
+        For i = 0 To 1
+            goPaddle(i).LastPosition = LastPaddlePosition(i)
+            goPaddle(i).LastVelocityTick = LastPaddleVelTick(i)
+            goPaddle(i).PaddleID = PaddleID(i)
+            goPaddle(i).Position = PaddlePosition(i)
+            goPaddle(i).Transparent = PaddleTrans(i)
+            goPaddle(i).Velocity = PaddleVelocity(i)
+        Next
+    End If
+    
+    'Room
+    Static barRoom As Boolean
+    Static DrawRoom As Boolean
+    If fSave Then
+        barRoom = goRoom.barRoom
+        DrawRoom = goRoom.DrawRoom
+    Else
+        goRoom.barRoom = barRoom
+        goRoom.DrawRoom = DrawRoom
+    End If
+    
+    'Table
+    Static DrawTable As Boolean
+    Static TablePosition As D3DVECTOR
+    Static TableTrans As Boolean
+    
+    If fSave Then
+        DrawTable = goTable.DrawTable
+        TablePosition = goTable.Position
+        TableTrans = goTable.Transparent
+    Else
+        goTable.DrawTable = DrawTable
+        goTable.Position = TablePosition
+        goTable.Transparent = TableTrans
+    End If
+    
+End Sub

Library/dxx8/samples/Multimedia/VBSamples/Demos/AirHockey/modMisc.bas

@@ -0,0 +1,15 @@
+Attribute VB_Name = "modMisc"
+Option Explicit
+
+Public Function aCos(dCos As Double) As Double
+    On Error Resume Next 'Assume any errors mean the aCos = 0
+    'Here we will figure out the arccosine..
+    aCos = Atn(Sqr(1 - (dCos * dCos)) / dCos)
+End Function
+
+Public Sub PrintVector(vec As D3DVECTOR, Optional ByVal s As String = vbNullString)
+    With vec
+        Debug.Print s; " X="; .x; " Y="; .y; " Z="; .z
+    End With
+End Sub
+

Library/dxx8/samples/Multimedia/VBSamples/Demos/AirHockey/readme.txt

@@ -0,0 +1,41 @@
+//-----------------------------------------------------------------------------
+// 
+// Sample Name: Air Hockey Demo
+// 
+// Copyright (C) 1999-2001 Microsoft Corporation. All rights reserved.
+// 
+//-----------------------------------------------------------------------------
+
+
+Description
+===========
+This application demonstrates a simple peer-peer (or single player) Air Hockey 
+Game.
+
+In Single player mode, a crude computer AI will be your opponent.  You can 
+dictate numerous settings in the game, including overall 'speed' of the game as
+well as score to win (although the computer always enforces the rule that you 
+must win by 2).
+
+The multiplayer mode is similar to the single player mode, with the exception of
+no computer AI.  
+
+Please note, if you try to run this sample from the source tree it will most likely 
+fail due to lack of media.  The 'models' and 'sounds' folders must be in the same folder 
+as where you run the sample from (by default these folders are in the 'bin' folder).
+
+Path
+====
+  Source: DXSDK\Samples\Multimedia\VBSamples\Demos\AirHockey
+
+  Executable: DXSDK\Samples\Multimedia\VBSamples\Demos\bin
+
+
+User's Guide
+============
+Press Space to launch the puck.  Use the mouse (or arrow keys on your keyboard, or joystick)
+to control your paddle.
+
+Programming Notes
+=================
+This sample shows many of the directX components working together.

Library/dxx8/samples/Multimedia/VBSamples/Demos/AirHockey/selectDevice.frm

@@ -0,0 +1,394 @@
+VERSION 5.00
+Begin VB.Form frmSelectDevice 
+   BorderStyle     =   3  'Fixed Dialog
+   Caption         =   "Select Device"
+   ClientHeight    =   2805
+   ClientLeft      =   45
+   ClientTop       =   330
+   ClientWidth     =   6045
+   LinkTopic       =   "Form1"
+   MaxButton       =   0   'False
+   MinButton       =   0   'False
+   ScaleHeight     =   2805
+   ScaleWidth      =   6045
+   ShowInTaskbar   =   0   'False
+   StartUpPosition =   3  'Windows Default
+   Begin VB.Frame optRenderingModeoptRenderingMode 
+      Caption         =   "Rendering Mode"
+      Height          =   1335
+      Left            =   120
+      TabIndex        =   7
+      Top             =   1320
+      Width           =   4575
+      Begin VB.ComboBox cboFullScreenMode 
+         Enabled         =   0   'False
+         Height          =   315
+         Left            =   2040
+         Style           =   2  'Dropdown List
+         TabIndex        =   10
+         Top             =   720
+         Width           =   2295
+      End
+      Begin VB.OptionButton optRenderingMode 
+         Caption         =   "&Fullscreen mode"
+         Height          =   375
+         Index           =   1
+         Left            =   240
+         TabIndex        =   9
+         Top             =   690
+         Width           =   1455
+      End
+      Begin VB.OptionButton optRenderingMode 
+         Caption         =   "Use desktop &window"
+         Height          =   375
+         Index           =   0
+         Left            =   240
+         TabIndex        =   8
+         Top             =   240
+         Value           =   -1  'True
+         Width           =   1815
+      End
+   End
+   Begin VB.CommandButton cmdCancel 
+      Cancel          =   -1  'True
+      Caption         =   "Cancel"
+      Height          =   375
+      Left            =   4800
+      TabIndex        =   4
+      Top             =   720
+      Width           =   1095
+   End
+   Begin VB.CommandButton cmdOk 
+      Caption         =   "OK"
+      Default         =   -1  'True
+      Height          =   375
+      Left            =   4800
+      TabIndex        =   3
+      Top             =   240
+      Width           =   1095
+   End
+   Begin VB.Frame Frame1 
+      Caption         =   "Rendering device"
+      Height          =   1095
+      Left            =   120
+      TabIndex        =   0
+      Top             =   120
+      Width           =   4575
+      Begin VB.ComboBox cboDevice 
+         Height          =   315
+         Left            =   1440
+         Style           =   2  'Dropdown List
+         TabIndex        =   6
+         Top             =   600
+         Width           =   2775
+      End
+      Begin VB.ComboBox cboAdapter 
+         Height          =   315
+         Left            =   1440
+         Style           =   2  'Dropdown List
+         TabIndex        =   2
+         Top             =   240
+         Width           =   2775
+      End
+      Begin VB.Label Label2 
+         AutoSize        =   -1  'True
+         Caption         =   "D3D &device:"
+         Height          =   195
+         Left            =   360
+         TabIndex        =   5
+         Top             =   660
+         Width           =   900
+      End
+      Begin VB.Label Label1 
+         AutoSize        =   -1  'True
+         Caption         =   "&Adapter:"
+         Height          =   195
+         Left            =   360
+         TabIndex        =   1
+         Top             =   300
+         Width           =   600
+      End
+   End
+End
+Attribute VB_Name = "frmSelectDevice"
+Attribute VB_GlobalNameSpace = False
+Attribute VB_Creatable = False
+Attribute VB_PredeclaredId = True
+Attribute VB_Exposed = False
+Option Explicit
+
+
+Dim m_callback As Object
+
+Public Sub SelectDevice(callback As Object)
+    
+    If callback Is Nothing Then Exit Sub
+    Set m_callback = callback
+    
+    Dim dm As D3DDISPLAYMODE
+    
+    If g_d3dpp.Windowed = 0 Then
+
+        m_callback.InvalidateDeviceObjects
+    
+        D3DUtil_ResetWindowed
+
+        m_callback.RestoreDeviceObjects
+        
+    End If
+    
+    Me.Show 1
+    
+    Set m_callback = Nothing
+    
+End Sub
+
+
+Private Sub cboAdapter_Click()
+    
+    Dim devtype As CONST_D3DDEVTYPE
+      
+    If (cboDevice.ListIndex = 1) Then
+        devtype = D3DDEVTYPE_REF
+    Else
+        devtype = D3DDEVTYPE_HAL
+    End If
+       
+    Call UpdateModes(cboAdapter.ListIndex, devtype)
+    
+End Sub
+
+Private Sub cboDevice_Change()
+    
+    Dim devtype As CONST_D3DDEVTYPE
+    
+    If (cboDevice.ListIndex = 1) Then
+        devtype = D3DDEVTYPE_REF
+    Else
+        devtype = D3DDEVTYPE_HAL
+    End If
+       
+    Call UpdateModes(cboAdapter.ListIndex, devtype)
+    
+End Sub
+
+Private Sub cmdCancel_Click()
+
+    Set m_callback = Nothing
+    Me.Hide
+    
+End Sub
+
+Public Sub UpdateNow(callback As Object)
+
+    On Local Error Resume Next
+    
+    Dim bAdapterChanged As Boolean
+    Dim bRasterizerChanged As Boolean
+    Dim bRef As Boolean
+    Dim lWindowed As Long
+    Dim AdapterID As Long
+    Dim ModeID As Long
+    Dim devtype As CONST_D3DDEVTYPE
+    
+    If callback Is Nothing Then Exit Sub
+    Set m_callback = callback
+    
+    AdapterID = cboAdapter.ListIndex
+    ModeID = cboFullScreenMode.ListIndex
+        
+    ' see if user changed adapters
+    If g_lCurrentAdapter <> AdapterID Then bAdapterChanged = True
+                
+    bRef = g_Adapters(g_lCurrentAdapter).bReference
+        
+    If (cboDevice.ListIndex = 1) Then
+        devtype = D3DDEVTYPE_REF
+    Else
+        devtype = D3DDEVTYPE_HAL
+    End If
+    
+    ' see if user changed rasterizers
+    If (devtype = D3DDEVTYPE_REF And bRef = False) Then bRasterizerChanged = True
+    If (devtype = D3DDEVTYPE_HAL And bRef = True) Then bRasterizerChanged = True
+    
+    
+    If optRenderingMode(1).Value = True Then
+        lWindowed = 0
+    Else
+        lWindowed = 1
+    End If
+        
+    ' if they didnt change adapters or switch to refrast, then we can just use reset
+    If bAdapterChanged = False And bRasterizerChanged = False Then
+                
+        'If trying to go Fullscreen
+        If lWindowed = 0 Then
+        
+            'call g_dev.reset
+            Call D3DUtil_ResizeFullscreen(g_focushwnd, cboFullScreenMode.ListIndex)
+        
+        Else
+            
+            Call D3DUtil_ResizeWindowed(g_focushwnd)
+        
+        End If
+        
+        'tell user needs to restore device objects
+        m_callback.RestoreDeviceObjects
+        
+        'exit modal dialog
+        Unload Me
+        Exit Sub
+
+    End If
+    
+    Set g_dev = Nothing
+    
+    D3DUtil_ReleaseAllTexturesFromPool
+    
+    'tell user to lose reference counts in its objects device objects
+    m_callback.InvalidateDeviceObjects
+    m_callback.DeleteDeviceObjects
+    
+    'Reinitialize D3D
+    If lWindowed = 0 Then
+        D3DUtil_InitFullscreen g_focushwnd, AdapterID, ModeID, devtype, True
+    Else
+        D3DUtil_InitWindowed g_focushwnd, AdapterID, devtype, True
+    End If
+    
+        
+    'tell user to re-create device objects
+    m_callback.InitDeviceObjects
+    
+    'tell user to restore device objects
+    m_callback.RestoreDeviceObjects
+    
+    'exit modal dialog
+    Unload Me
+
+End Sub
+
+Private Sub cmdOk_Click()
+    Set m_callback = Nothing
+    Me.Hide
+End Sub
+
+Private Sub Form_Load()
+        
+    Call UpdateAdapters
+    Call UpdateDevices(g_lCurrentAdapter)
+    Call UpdateModes(g_lCurrentAdapter, g_Adapters(g_lCurrentAdapter).DeviceType)
+    
+End Sub
+
+Private Sub UpdateAdapters()
+
+    Dim i As Long
+    Dim sDescription As String
+    
+    cboAdapter.Clear
+        
+    For i = 0 To g_lNumAdapters - 1
+        sDescription = vbNullString
+        sDescription = StrConv(g_Adapters(i).d3dai.Description, vbUnicode)
+        cboAdapter.AddItem sDescription
+    Next
+    
+    cboAdapter.ListIndex = g_lCurrentAdapter
+    
+End Sub
+
+Private Sub UpdateDevices(Adapter As Long)
+
+    Dim i As Long
+    
+    cboDevice.Clear
+    
+    cboDevice.AddItem "HAL"
+    cboDevice.AddItem "REF"
+    
+    'If g_Adapters(g_lCurrentAdapter).bReference Then
+    If g_Adapters(Adapter).bReference Then
+        cboDevice.ListIndex = 1
+    Else
+        cboDevice.ListIndex = 0
+    End If
+    
+End Sub
+
+Private Sub UpdateModes(Adapter As Long, devtype As CONST_D3DDEVTYPE)
+
+    Dim i As Long
+    Dim pAdapter As D3DUTIL_ADAPTERINFO
+    Dim sModeString As String
+    
+    cboFullScreenMode.Clear
+            
+    With g_Adapters(Adapter).DevTypeInfo(devtype)
+        For i = 0 To .lNumModes - 1
+            sModeString = .Modes(i).lWidth & " x "
+            sModeString = sModeString & .Modes(i).lHeight & " x "
+            If .Modes(i).format = D3DFMT_X8R8G8B8 Or _
+                .Modes(i).format = D3DFMT_A8R8G8B8 Or _
+                .Modes(i).format = D3DFMT_R8G8B8 Then
+                sModeString = sModeString & "32"
+            Else
+                sModeString = sModeString & "16"
+            End If
+            
+            cboFullScreenMode.AddItem sModeString
+        Next
+        If cboFullScreenMode.ListCount > 0 Then cboFullScreenMode.ListIndex = .lCurrentMode
+    End With
+                
+End Sub
+
+Private Sub optRenderingMode_Click(Index As Integer)
+    
+    If Index = 1 Then
+        cboFullScreenMode.Enabled = True
+    Else
+        cboFullScreenMode.Enabled = False
+    End If
+    
+End Sub
+
+Public Property Get Windowed() As Boolean
+    Windowed = optRenderingMode(0).Value
+End Property
+
+Public Property Get AdapterString() As String
+    AdapterString = cboAdapter.List(cboAdapter.ListIndex)
+End Property
+
+Public Property Get Adapter() As Long
+    Adapter = cboAdapter.ListIndex
+End Property
+
+Public Property Get ModeString() As String
+    ModeString = cboFullScreenMode.List(cboFullScreenMode.ListIndex)
+End Property
+
+Public Property Get Mode() As Long
+    Mode = cboFullScreenMode.ListIndex
+End Property
+
+Public Property Let Mode(ByVal lMode As Long)
+    On Error Resume Next 'Just in case
+    cboFullScreenMode.ListIndex = lMode
+End Property
+
+Public Property Let Adapter(ByVal lAdapter As Long)
+    cboAdapter.ListIndex = lAdapter
+End Property
+
+Public Property Let Windowed(ByVal fWindow As Boolean)
+    If fWindow Then
+        optRenderingMode(0).Value = True
+    Else
+        optRenderingMode(1).Value = True
+    End If
+End Property
+

Library/dxx8/samples/Multimedia/VBSamples/Demos/AirHockey/vbair.vbp

@@ -0,0 +1,60 @@
+Type=Exe
+Reference=*\G{00020430-0000-0000-C000-000000000046}#2.0#0#stdole2.tlb#OLE Automation
+Reference=*\G{E1211242-8E94-11D1-8808-00C04FC2C603}#1.0#0#dx8vb.dll#DirectX 8 for Visual Basic Type Library
+Form=frmAir.frm
+Module=modAirHockey; modHelper.bas
+Class=CD3DFrame; d3dFrame.cls
+Class=CD3DMesh; d3dMesh.cls
+Class=CD3DPick; d3dPick.cls
+Module=D3DUtil; d3dutil.bas
+Module=MediaDir; ..\..\common\media.bas
+Module=D3DInit; d3dinit.bas
+Form=selectDevice.frm
+Module=modDplay; modDplay.bas
+Form=frmSplash.frm
+Form=..\..\common\DplayCon.frm
+Class=CD3DAnimation; d3dAnimation.cls
+Object={831FDD16-0C5C-11D2-A9FC-0000F8754DA1}#2.0#0; MSCOMCTL.OCX
+Class=cPuck; cPuck.cls
+Class=cPaddle; cPaddle.cls
+Class=cCamera; cCamera.cls
+Class=cAudio; cAudio.cls
+Class=cAudioFile; cAudioFile.cls
+Class=cTable; cTable.cls
+Class=cText; cText.cls
+Class=cRoom; cRoom.cls
+Class=cInput; cInput.cls
+Form=frmGraphics.frm
+Form=frmInput.frm
+Form=frmAudio.frm
+Class=cFade; cFade.cls
+IconForm="frmAir"
+Startup="frmSplash"
+HelpFile=""
+Title="vbair"
+ExeName32="vb_airhockey.exe"
+Command32=""
+Name="vbAir"
+HelpContextID="0"
+CompatibleMode="0"
+MajorVer=1
+MinorVer=0
+RevisionVer=0
+AutoIncrementVer=0
+ServerSupportFiles=0
+VersionCompanyName="Microsoft"
+CompilationType=0
+OptimizationType=0
+FavorPentiumPro(tm)=0
+CodeViewDebugInfo=0
+NoAliasing=0
+BoundsCheck=0
+OverflowCheck=0
+FlPointCheck=0
+FDIVCheck=0
+UnroundedFP=0
+StartMode=0
+Unattended=0
+Retained=0
+ThreadPerObject=0
+MaxNumberOfThreads=1