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 ± 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

Library/dxx8/samples/Multimedia/VBSamples/Demos/ClubMet/ClubMet.frm

@@ -0,0 +1,526 @@
+VERSION 5.00
+Begin VB.Form frmMain 
+   BackColor       =   &H00000000&
+   BorderStyle     =   4  'Fixed ToolWindow
+   Caption         =   "Club Metamorphous"
+   ClientHeight    =   7140
+   ClientLeft      =   3510
+   ClientTop       =   1890
+   ClientWidth     =   8310
+   ForeColor       =   &H0000C000&
+   Icon            =   "ClubMet.frx":0000
+   LinkTopic       =   "Form1"
+   MaxButton       =   0   'False
+   MinButton       =   0   'False
+   ScaleHeight     =   476
+   ScaleMode       =   3  'Pixel
+   ScaleWidth      =   554
+   StartUpPosition =   3  'Windows Default
+   Begin VB.CommandButton cmdExit 
+      BackColor       =   &H0080FF80&
+      Cancel          =   -1  'True
+      Caption         =   "Exit"
+      Height          =   495
+      Left            =   240
+      TabIndex        =   12
+      Top             =   6600
+      Width           =   1215
+   End
+   Begin VB.CommandButton cmdAdmission 
+      BackColor       =   &H00FFC0FF&
+      Caption         =   "Admission"
+      BeginProperty Font 
+         Name            =   "Times New Roman"
+         Size            =   9.75
+         Charset         =   0
+         Weight          =   700
+         Underline       =   0   'False
+         Italic          =   0   'False
+         Strikethrough   =   0   'False
+      EndProperty
+      Height          =   495
+      Left            =   240
+      Style           =   1  'Graphical
+      TabIndex        =   10
+      Top             =   6000
+      Width           =   1215
+   End
+   Begin VB.CommandButton cmdSpecials 
+      BackColor       =   &H008080FF&
+      Caption         =   "Dinner Specials"
+      BeginProperty Font 
+         Name            =   "Times New Roman"
+         Size            =   9.75
+         Charset         =   0
+         Weight          =   700
+         Underline       =   0   'False
+         Italic          =   0   'False
+         Strikethrough   =   0   'False
+      EndProperty
+      Height          =   495
+      Left            =   240
+      Style           =   1  'Graphical
+      TabIndex        =   9
+      Top             =   5400
+      Width           =   1215
+   End
+   Begin VB.CommandButton cmdDirections 
+      BackColor       =   &H0080C0FF&
+      Caption         =   "Directions"
+      BeginProperty Font 
+         Name            =   "Times New Roman"
+         Size            =   9.75
+         Charset         =   0
+         Weight          =   700
+         Underline       =   0   'False
+         Italic          =   0   'False
+         Strikethrough   =   0   'False
+      EndProperty
+      Height          =   495
+      Left            =   240
+      Style           =   1  'Graphical
+      TabIndex        =   8
+      Top             =   4800
+      Width           =   1215
+   End
+   Begin VB.PictureBox mnCan 
+      BackColor       =   &H80000007&
+      BorderStyle     =   0  'None
+      Height          =   3795
+      Left            =   2400
+      ScaleHeight     =   253
+      ScaleMode       =   3  'Pixel
+      ScaleWidth      =   385
+      TabIndex        =   7
+      Top             =   1680
+      Width           =   5775
+   End
+   Begin VB.Label lblStuff 
+      BackColor       =   &H80000007&
+      Caption         =   "Label2"
+      ForeColor       =   &H8000000E&
+      Height          =   1455
+      Left            =   2340
+      TabIndex        =   11
+      Top             =   5580
+      Width           =   5835
+   End
+   Begin VB.Label lblSunday 
+      AutoSize        =   -1  'True
+      BackColor       =   &H00000000&
+      Caption         =   "Sunday"
+      BeginProperty Font 
+         Name            =   "Times New Roman"
+         Size            =   20.25
+         Charset         =   0
+         Weight          =   700
+         Underline       =   0   'False
+         Italic          =   0   'False
+         Strikethrough   =   0   'False
+      EndProperty
+      ForeColor       =   &H0000C000&
+      Height          =   465
+      Left            =   240
+      TabIndex        =   6
+      Top             =   4200
+      Width           =   1305
+   End
+   Begin VB.Label lblSaturday 
+      AutoSize        =   -1  'True
+      BackColor       =   &H00000000&
+      Caption         =   "Saturday"
+      BeginProperty Font 
+         Name            =   "Times New Roman"
+         Size            =   20.25
+         Charset         =   0
+         Weight          =   700
+         Underline       =   0   'False
+         Italic          =   0   'False
+         Strikethrough   =   0   'False
+      EndProperty
+      ForeColor       =   &H0000C000&
+      Height          =   465
+      Left            =   240
+      TabIndex        =   5
+      Top             =   3600
+      Width           =   1605
+   End
+   Begin VB.Label lblFriday 
+      AutoSize        =   -1  'True
+      BackColor       =   &H00000000&
+      Caption         =   "Friday"
+      BeginProperty Font 
+         Name            =   "Times New Roman"
+         Size            =   20.25
+         Charset         =   0
+         Weight          =   700
+         Underline       =   0   'False
+         Italic          =   0   'False
+         Strikethrough   =   0   'False
+      EndProperty
+      ForeColor       =   &H0000C000&
+      Height          =   465
+      Left            =   240
+      TabIndex        =   4
+      Top             =   3000
+      Width           =   1185
+   End
+   Begin VB.Label lblThursday 
+      AutoSize        =   -1  'True
+      BackColor       =   &H00000000&
+      Caption         =   "Thursday"
+      BeginProperty Font 
+         Name            =   "Times New Roman"
+         Size            =   20.25
+         Charset         =   0
+         Weight          =   700
+         Underline       =   0   'False
+         Italic          =   0   'False
+         Strikethrough   =   0   'False
+      EndProperty
+      ForeColor       =   &H0000C000&
+      Height          =   465
+      Left            =   240
+      TabIndex        =   3
+      Top             =   2400
+      Width           =   1695
+   End
+   Begin VB.Label lblWednesday 
+      AutoSize        =   -1  'True
+      BackColor       =   &H00000000&
+      Caption         =   "Wednesday"
+      BeginProperty Font 
+         Name            =   "Times New Roman"
+         Size            =   20.25
+         Charset         =   0
+         Weight          =   700
+         Underline       =   0   'False
+         Italic          =   0   'False
+         Strikethrough   =   0   'False
+      EndProperty
+      ForeColor       =   &H0000FF00&
+      Height          =   465
+      Left            =   240
+      TabIndex        =   2
+      Top             =   1800
+      Width           =   2025
+   End
+   Begin VB.Label lblName 
+      Alignment       =   2  'Center
+      BackColor       =   &H00000000&
+      Caption         =   "Club Metamorphous"
+      BeginProperty Font 
+         Name            =   "Times New Roman"
+         Size            =   36
+         Charset         =   0
+         Weight          =   700
+         Underline       =   0   'False
+         Italic          =   0   'False
+         Strikethrough   =   0   'False
+      EndProperty
+      ForeColor       =   &H000080FF&
+      Height          =   915
+      Left            =   480
+      TabIndex        =   1
+      Top             =   0
+      Width           =   7455
+   End
+   Begin VB.Label Label1 
+      BackColor       =   &H00000000&
+      Caption         =   """The only thing that stays the same is a good time!"""
+      BeginProperty Font 
+         Name            =   "Times New Roman"
+         Size            =   15.75
+         Charset         =   0
+         Weight          =   700
+         Underline       =   0   'False
+         Italic          =   -1  'True
+         Strikethrough   =   0   'False
+      EndProperty
+      ForeColor       =   &H000080FF&
+      Height          =   495
+      Left            =   840
+      TabIndex        =   0
+      Top             =   1020
+      Width           =   6855
+   End
+End
+Attribute VB_Name = "frmMain"
+Attribute VB_GlobalNameSpace = False
+Attribute VB_Creatable = False
+Attribute VB_PredeclaredId = True
+Attribute VB_Exposed = False
+Option Explicit
+
+'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
+'
+'  Copyright (C) 1999-2001 Microsoft Corporation.  All Rights Reserved.
+'
+'  File:       ClubMet.frm
+'
+'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
+
+'This application uses conditional compilation.  To run this sample in the IDE, you
+'must first go to Project Properties (Project Menu-> Properties).  Then on the Make tab
+'change the RunInIDE=0 to RunInIDE=1.
+
+'This sample also shows developers how to combine the DX7 and DX8 DLL's to create
+'an app with the latest DMusic and still use older functionality like DDraw
+
+Private dx As New DXVBLibA.DirectX8
+Dim day As Integer
+Dim sJazz As DXVBLibA.DirectMusicStyle8
+Dim sDance As DXVBLibA.DirectMusicStyle8
+Dim sBigBand As DXVBLibA.DirectMusicStyle8
+Dim sDisco As DXVBLibA.DirectMusicStyle8
+Dim sClassical As DXVBLibA.DirectMusicStyle8
+Dim sHeartland As DXVBLibA.DirectMusicStyle8
+Dim cmp As DXVBLibA.DirectMusicChordMap8
+Dim com As DXVBLibA.DirectMusicComposer8
+Dim perf As DXVBLibA.DirectMusicPerformance8
+Dim seg As DXVBLibA.DirectMusicSegment8
+Dim loader As DXVBLibA.DirectMusicLoader8
+Dim currentstyle As DXVBLibA.DirectMusicStyle8
+Dim LabelNumber As Integer
+Dim runit As Boolean
+
+Private Sub cmdAdmission_Click()
+     Call perf.PlaySegmentEx(currentstyle.GetMotif(currentstyle.GetMotifName(2)), DMUS_SEGF_SECONDARY Or DMUS_SEGF_BEAT, 0)
+     lblStuff.Caption = ChangeStuffLabel(6)
+End Sub
+
+Private Sub cmdDirections_Click()
+    
+    Call perf.PlaySegmentEx(currentstyle.GetMotif(currentstyle.GetMotifName(0)), DMUS_SEGF_SECONDARY Or DMUS_SEGF_BEAT, 0)
+    lblStuff.Caption = ChangeStuffLabel(0)
+End Sub
+
+Private Sub cmdExit_Click()
+    runit = False
+    Unload Me
+End Sub
+
+Private Sub cmdSpecials_Click()
+     Call perf.PlaySegmentEx(currentstyle.GetMotif(currentstyle.GetMotifName(1)), DMUS_SEGF_SECONDARY Or DMUS_SEGF_BEAT, 0)
+    lblStuff.Caption = ChangeStuffLabel(LabelNumber)
+End Sub
+
+
+Private Function ChangeStuffLabel(Index As Integer) As String
+    Dim tString(9) As String
+    
+    Call ClearlblStuff
+    
+    'directions
+    tString(0) = "Corner of 4th and Stewart, next to the new stadium!"
+    
+    'dinners
+    tString(1) = "London Broil with Hollandaise sauce, baby red potatoes, green vegetables, and Lobster Bisque soup."
+    tString(2) = "Grilled Mahi-Mahi on a bed of rice pilaf, green vegetables, and Ceasar salad"
+    tString(3) = "Chicken Cordon Bleu, steamed vegetables, wild lemon rice, and clam chowder"
+    tString(4) = "Bacon CheeseBurger, onion rings, and a vanilla shake"
+    tString(5) = "Salmon in parchment, rice pilaf, green vegetables, and lentil soup."
+    
+    'Admission
+    tString(6) = "Age 14 - 18, $4.50, age 19 and up, $7.00"
+    
+    ChangeStuffLabel = tString(Index)
+
+End Function
+
+Private Sub ClearlblStuff()
+    lblStuff.Caption = ""
+End Sub
+
+Private Sub Form_Load()
+    On Error GoTo err_out
+    Show
+    
+    ClearlblStuff
+    
+    InitDD hwnd, mnCan
+    DoEvents
+    initDMusic
+    DoEvents
+    
+
+    runit = True
+    
+    Do
+        MoveFrame day
+        DoEvents
+    Loop
+    
+    End
+err_out:
+    MsgBox "Could not start application!", vbApplicationModal
+    End
+        
+End Sub
+Private Sub initDMusic()
+    Dim dma As DMUS_AUDIOPARAMS
+    
+    On Error GoTo FailedInit
+    Set perf = dx.DirectMusicPerformanceCreate
+    Set com = dx.DirectMusicComposerCreate
+    Set loader = dx.DirectMusicLoaderCreate
+
+    perf.InitAudio Me.hwnd, DMUS_AUDIOF_ALL, dma, , DMUS_APATH_SHARED_STEREOPLUSREVERB, 128
+    perf.SetMasterAutoDownload True
+
+'Load the objects
+#If RunInIDE = 1 Then
+    Dim sMedia As String
+    
+    sMedia = FindMediaDir("bigband.sty")
+    If sMedia <> vbNullString Then 'Media is not in current folder
+        If (Left$(sMedia, 2) <> Left$(CurDir, 2)) And (InStr(Left$(sMedia, 2), ":") > 0) Then ChDrive Left$(sMedia, 2)
+        ChDir sMedia
+    End If
+    
+    Set sBigBand = loader.LoadStyle("BIGBAND.STY")
+    Set sJazz = loader.LoadStyle("JAZZ.STY")
+    Set sDisco = loader.LoadStyle("DISCO.STY")
+    Set sClassical = loader.LoadStyle("CLASSICAL.STY")
+    Set sDance = loader.LoadStyle("DANCEMIX.STY")
+    Set sHeartland = loader.LoadStyle("HEARTLAND.STY")
+
+    Set currentstyle = sHeartland
+    Set cmp = loader.LoadChordMap("CHORDMAP.CDM")
+#Else
+    Set sBigBand = loader.LoadStyleFromResource(AddDirSep(App.Path) & App.EXEName & ".exe", "BIGBAND")
+    Set sJazz = loader.LoadStyleFromResource(AddDirSep(App.Path) & App.EXEName & ".exe", "JAZZ")
+    Set sDisco = loader.LoadStyleFromResource(AddDirSep(App.Path) & App.EXEName & ".exe", "DISCO")
+    Set sClassical = loader.LoadStyleFromResource(AddDirSep(App.Path) & App.EXEName & ".exe", "CLASSICAL")
+    Set sDance = loader.LoadStyleFromResource(AddDirSep(App.Path) & App.EXEName & ".exe", "DANCEMIX")
+    Set sHeartland = loader.LoadStyleFromResource(AddDirSep(App.Path) & App.EXEName & ".exe", "HEARTLAND")
+
+    Set currentstyle = sHeartland
+    Set cmp = loader.LoadChordMapFromResource(AddDirSep(App.Path) & App.EXEName & ".exe", "CHORDMAP")
+#End If
+    Set seg = com.ComposeSegmentFromShape(sHeartland, 64, 0, 1, True, False, cmp)
+    Call perf.PlaySegmentEx(seg, 0, 0)
+    Exit Sub
+    
+FailedInit:
+    MsgBox "Could not initialize DirectMusic." & vbCrLf & "This sample will exit.", vbOKOnly Or vbInformation, "Exiting..."
+    Unload Me
+   
+End Sub
+Private Sub ChangeMusic()
+    Set seg = com.ComposeSegmentFromShape(currentstyle, 64, 0, 2, False, False, cmp)
+    Call com.AutoTransition(perf, seg, DMUS_COMMANDT_FILL, DMUS_COMPOSEF_MEASURE, cmp)
+End Sub
+
+Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer)
+    runit = False
+End Sub
+
+Private Sub Form_Unload(Cancel As Integer)
+    If Not (perf Is Nothing) Then perf.CloseDown
+    End
+End Sub
+
+Private Sub lblFriday_Click()
+    ClearlblStuff
+    Set currentstyle = sDisco
+    ChangeMusic
+    day = 2: LabelNumber = 3
+    lblStuff.Caption = LoadMSg(2)
+End Sub
+
+Private Sub lblFriday_MouseMove(Button As Integer, Shift As Integer, x As Single, y As Single)
+    
+    lblName.Font = "Courier New"
+    lblName.ForeColor = &H8080FF
+    
+    lblFriday.ForeColor = &HFF&
+    
+    lblWednesday.ForeColor = &HC000&
+    lblThursday.ForeColor = &HC000&
+    lblSaturday.ForeColor = &HC000&
+    lblSunday.ForeColor = &HC000&
+End Sub
+
+Private Sub lblSaturday_Click()
+    ClearlblStuff
+    Set currentstyle = sDance
+    ChangeMusic
+    day = 6: LabelNumber = 4
+    lblStuff.Caption = LoadMSg(3)
+End Sub
+
+Private Sub lblSaturday_MouseMove(Button As Integer, Shift As Integer, x As Single, y As Single)
+    
+    lblName.Font = "Tahoma"
+    lblName.ForeColor = &HC00000
+    
+    lblSaturday.ForeColor = &HFF&
+    
+    lblWednesday.ForeColor = &HC000&
+    lblThursday.ForeColor = &HC000&
+    lblFriday.ForeColor = &HC000&
+    lblSunday.ForeColor = &HC000&
+End Sub
+
+Private Sub lblSunday_Click()
+    ClearlblStuff
+    Set currentstyle = sClassical
+    ChangeMusic
+    day = 5: LabelNumber = 5
+    lblStuff.Caption = LoadMSg(4)
+End Sub
+
+Private Sub lblSunday_MouseMove(Button As Integer, Shift As Integer, x As Single, y As Single)
+    lblName.Font = "Garamond"
+    lblName.ForeColor = &HFFC0C0
+    
+    lblSunday.ForeColor = &HFF&
+    
+    lblWednesday.ForeColor = &HC000&
+    lblThursday.ForeColor = &HC000&
+    lblFriday.ForeColor = &HC000&
+    lblSaturday.ForeColor = &HC000&
+End Sub
+
+Private Sub lblThursday_Click()
+    ClearlblStuff
+    Set currentstyle = sJazz
+    ChangeMusic
+    day = 3: LabelNumber = 2
+    lblStuff.Caption = LoadMSg(1)
+End Sub
+
+Private Sub lblThursday_MouseMove(Button As Integer, Shift As Integer, x As Single, y As Single)
+    lblName.Font = "Comic Sans MS"
+    lblName.ForeColor = &H80FF80
+    
+    lblThursday.ForeColor = &HFF&
+    
+    lblWednesday.ForeColor = &HC000&
+    lblFriday.ForeColor = &HC000&
+    lblSaturday.ForeColor = &HC000&
+    lblSunday.ForeColor = &HC000&
+End Sub
+
+Private Sub lblWednesday_Click()
+    ClearlblStuff
+    Set currentstyle = sBigBand
+    ChangeMusic
+    day = 1: LabelNumber = 1
+    lblStuff.Caption = LoadMSg(0)
+End Sub
+
+Private Sub lblWednesday_MouseMove(Button As Integer, Shift As Integer, x As Single, y As Single)
+    lblName.Font = "Times New Roman"
+    lblName.ForeColor = &HFFFF&
+    
+    
+    lblWednesday.ForeColor = &HFF&
+    
+    lblThursday.ForeColor = &HC000&
+    lblFriday.ForeColor = &HC000&
+    lblSaturday.ForeColor = &HC000&
+    lblSunday.ForeColor = &HC000&
+End Sub
+

Library/dxx8/samples/Multimedia/VBSamples/Demos/ClubMet/basDD.bas

@@ -0,0 +1,587 @@
+Attribute VB_Name = "basDD"
+Option Explicit
+
+'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
+'
+'  Copyright (C) 1999-2001 Microsoft Corporation.  All Rights Reserved.
+'
+'  File:       basDD.bas
+'
+'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
+
+Public Declare Function GetWindowRect Lib "user32" (ByVal hwnd As Long, lpRect As DxVBLib.RECT) As Long
+
+'******
+'This application uses conditional compilation.  To run this sample in the IDE, you
+'must first go to Project Properties (Project Menu-> Properties).  Then on the Make tab
+'change the RunInIDE=0 to RunInIDE=1.
+
+'This sample also shows developers how to combine the DX7 and DX8 DLL's to create
+'an app with the latest DMusic and still use older functionality like DDraw
+
+Private dx As New DxVBLib.DirectX7
+Private DD As DxVBLib.DirectDraw7
+Private DDS As DxVBLib.DirectDrawSurface7
+Private dC As DxVBLib.DirectDrawClipper
+Private DDSD As DxVBLib.DDSURFACEDESC2
+Private DR As DxVBLib.RECT
+
+Private bB As DxVBLib.DirectDrawSurface7
+Private BD As DxVBLib.DDSURFACEDESC2
+Private BBR As DxVBLib.RECT
+
+Private ar() As Byte
+Private AlphaRect As DxVBLib.RECT
+
+Private lPixelDepth As Byte
+Private clr As Long
+Private cols As Long
+Private rows As Long
+Private col As Long
+Private row As Long
+
+Private Sprites(9) As DxVBLib.DirectDrawSurface7
+Private SpriteD(9) As DxVBLib.DDSURFACEDESC2
+Private SpriteR(9) As DxVBLib.RECT
+Private key(9) As DDCOLORKEY
+
+Private spriteWidth As Integer
+Private spriteHeight As Integer
+Private currentframe As Integer
+Private slide(39) As DxVBLib.RECT
+Private Pal(255) As DxVBLib.PALETTEENTRY
+Private Palette As DxVBLib.DirectDrawPalette
+
+Private Fish(2) As DxVBLib.DirectDrawSurface7
+Private fishD(2) As DxVBLib.DDSURFACEDESC2
+Private fishR(2) As DxVBLib.RECT
+Private fishkey(2) As DxVBLib.DDCOLORKEY
+
+Private sMSG As String
+
+Private x%, y%
+Private tmpR As DxVBLib.RECT
+
+Private Type fis
+    sR As DxVBLib.RECT
+    x As Long
+    y As Single
+End Type
+
+Private fi(2) As fis
+
+'Registry constants
+Private Const KEY_READ = 131097
+Private Const REG_SZ = 1
+Private Const HKEY_LOCAL_MACHINE = &H80000002
+'Registry API's
+Private Declare Function RegConnectRegistry Lib "advapi32.dll" Alias "RegConnectRegistryA" (ByVal lpMachineName As String, ByVal hKey As Long, phkResult As Long) As Long
+Private Declare Function RegCloseKey Lib "advapi32.dll" (ByVal hKey As Long) As Long
+Private Declare Function RegQueryValueEx Lib "advapi32.dll" Alias "RegQueryValueExA" (ByVal hKey As Long, ByVal lpValueName As String, ByVal lpReserved As Long, lpType As Long, ByVal lpData As String, lpcbData As Long) As Long
+Private Declare Function RegOpenKeyEx Lib "advapi32.dll" Alias "RegOpenKeyExA" (ByVal hKey As Long, ByVal lpSubKey As String, ByVal ulOptions As Long, ByVal samDesired As Long, phkResult As Long) As Long
+'Sleep
+Public Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
+
+Public Sub InitDD(hwnd As Long, ClipperHwnd As PictureBox)
+    Dim oPixelFormat As DDPIXELFORMAT
+    On Local Error GoTo err_
+    
+    Set DD = dx.DirectDrawCreate(vbNullString)
+    DD.SetCooperativeLevel hwnd, DDSCL_NORMAL
+    
+    DDSD.lFlags = DDSD_CAPS
+    DDSD.ddsCaps.lCaps = DDSCAPS_PRIMARYSURFACE
+    Set DDS = DD.CreateSurface(DDSD)
+    
+    Set dC = DD.CreateClipper(0)
+    dC.SetHWnd ClipperHwnd.hwnd
+    
+    DDS.SetClipper dC
+    
+    DDS.GetPixelFormat oPixelFormat
+    
+    If oPixelFormat.lRGBBitCount < 8 Then
+        If Not (DD Is Nothing) Then
+            DD.SetCooperativeLevel frmMain.hwnd, DDSCL_NORMAL
+            DoEvents
+        End If
+    
+        MsgBox "Must run at 16bit color or higher.", vbApplicationModal
+        End
+    Else
+        lPixelDepth = oPixelFormat.lRGBBitCount
+    End If
+    
+    BD.lFlags = DDSD_HEIGHT Or DDSD_WIDTH Or DDSD_CAPS
+    BD.ddsCaps.lCaps = DDSCAPS_OFFSCREENPLAIN Or DDSCAPS_SYSTEMMEMORY
+    BD.lWidth = ClipperHwnd.ScaleWidth
+    BD.lHeight = ClipperHwnd.ScaleHeight
+    
+    Set bB = DD.CreateSurface(BD)
+
+    BBR.bottom = ClipperHwnd.Height
+    BBR.Right = ClipperHwnd.Width
+    
+    loadSprites
+
+    AlphaRect.Right = BD.lWidth - 1
+    AlphaRect.bottom = BD.lHeight - 1
+    Exit Sub
+
+err_:
+    
+    If Not (DD Is Nothing) Then
+        DD.SetCooperativeLevel frmMain.hwnd, DDSCL_NORMAL
+        DoEvents
+    End If
+
+    MsgBox "Unable to initalize DirectDraw.", vbApplicationModal
+    End
+
+End Sub
+
+Private Sub loadSprites()
+    '0
+    SpriteD(0).lFlags = DDSD_CAPS
+    SpriteD(0).ddsCaps.lCaps = DDSCAPS_OFFSCREENPLAIN Or DDSCAPS_SYSTEMMEMORY
+
+#If RunInIDE = 1 Then
+    'ide
+    Dim sMedia As String
+    
+    sMedia = FindMediaDir("base.bmp")
+    If sMedia <> vbNullString Then 'Media is not in current folder
+        If (Left$(sMedia, 2) <> Left$(CurDir, 2)) And (InStr(Left$(sMedia, 2), ":") > 0) Then ChDrive Left$(sMedia, 2)
+        ChDir sMedia
+    End If
+    
+    Set Sprites(0) = DD.CreateSurfaceFromFile("base.bmp", SpriteD(0))
+#Else
+    'exe
+    Set Sprites(0) = DD.CreateSurfaceFromResource(AddDirSep(App.Path) & App.EXEName & ".exe", "BASE", SpriteD(0))
+#End If
+
+    SpriteR(0).Right = SpriteD(0).lWidth
+    SpriteR(0).bottom = SpriteD(0).lHeight
+
+    
+    '1
+    SpriteD(1).lFlags = DDSD_CAPS
+    SpriteD(1).ddsCaps.lCaps = DDSCAPS_OFFSCREENPLAIN Or DDSCAPS_SYSTEMMEMORY
+    
+#If RunInIDE = 1 Then
+    'ide
+    Set Sprites(1) = DD.CreateSurfaceFromFile("sax.bmp", SpriteD(1))
+#Else
+    'exe
+    Set Sprites(1) = DD.CreateSurfaceFromResource(AddDirSep(App.Path) & App.EXEName & ".exe", "sax", SpriteD(1))
+#End If
+
+    SpriteR(1).Right = SpriteD(1).lWidth
+    SpriteR(1).bottom = SpriteD(1).lHeight
+    
+    'notes
+    SpriteD(6).lFlags = DDSD_CAPS Or DDSD_HEIGHT Or DDSD_WIDTH
+    SpriteD(6).ddsCaps.lCaps = DDSCAPS_OFFSCREENPLAIN Or DDSCAPS_SYSTEMMEMORY
+    SpriteD(6).lWidth = 64: SpriteD(6).lHeight = 64
+    
+#If RunInIDE = 1 Then
+    'ide
+    Set Sprites(6) = DD.CreateSurfaceFromFile("notes.bmp", SpriteD(6))
+#Else
+    'exe
+    Set Sprites(6) = DD.CreateSurfaceFromResource(AddDirSep(App.Path) & App.EXEName & ".exe", "NOTES", SpriteD(6))
+#End If
+
+    SpriteR(6).Right = SpriteD(6).lWidth
+    SpriteR(6).bottom = SpriteD(6).lHeight
+    
+    
+    key(6).low = 0
+    key(6).high = 0
+    Sprites(6).SetColorKey DDCKEY_SRCBLT, key(6)
+    
+    
+    
+    '2
+    SpriteD(2).lFlags = DDSD_CAPS
+    SpriteD(2).ddsCaps.lCaps = DDSCAPS_OFFSCREENPLAIN Or DDSCAPS_SYSTEMMEMORY
+    
+#If RunInIDE = 1 Then
+    'ide
+    Set Sprites(2) = DD.CreateSurfaceFromFile("keys.bmp", SpriteD(2))
+#Else
+    Set Sprites(2) = DD.CreateSurfaceFromResource(AddDirSep(App.Path) & App.EXEName & ".exe", "KEYS", SpriteD(2))
+#End If
+
+    SpriteR(2).Right = SpriteD(2).lWidth
+    SpriteR(2).bottom = SpriteD(2).lHeight
+    
+    
+    ''''''''''''''''''''''''''''''''''''''''''
+    'loadFish
+    ''''''''''''''''''''''''''''''''''''''''''
+    fishD(0).lFlags = DDSD_CAPS Or DDSD_HEIGHT Or DDSD_WIDTH
+    fishD(0).ddsCaps.lCaps = DDSCAPS_OFFSCREENPLAIN Or DDSCAPS_SYSTEMMEMORY
+    fishD(0).lWidth = 64: fishD(0).lHeight = 64
+    
+    fishD(1).lFlags = DDSD_CAPS Or DDSD_HEIGHT Or DDSD_WIDTH
+    fishD(1).ddsCaps.lCaps = DDSCAPS_OFFSCREENPLAIN Or DDSCAPS_SYSTEMMEMORY
+    fishD(1).lWidth = 64: fishD(1).lHeight = 64
+    
+    fishD(2).lFlags = DDSD_CAPS Or DDSD_HEIGHT Or DDSD_WIDTH
+    fishD(2).ddsCaps.lCaps = DDSCAPS_OFFSCREENPLAIN Or DDSCAPS_SYSTEMMEMORY
+    fishD(2).lWidth = 64: fishD(2).lHeight = 64
+    
+#If RunInIDE = 1 Then
+ 'ide
+    Set Fish(0) = DD.CreateSurfaceFromFile("f1.bmp", fishD(0))
+    Set Fish(1) = DD.CreateSurfaceFromFile("f2.bmp", fishD(1))
+    Set Fish(2) = DD.CreateSurfaceFromFile("f3.bmp", fishD(2))
+#Else
+'exe
+    Set Fish(0) = DD.CreateSurfaceFromResource(AddDirSep(App.Path) & App.EXEName & ".exe", "F1", fishD(0))
+    Set Fish(1) = DD.CreateSurfaceFromResource(AddDirSep(App.Path) & App.EXEName & ".exe", "F2", fishD(1))
+    Set Fish(2) = DD.CreateSurfaceFromResource(AddDirSep(App.Path) & App.EXEName & ".exe", "F3", fishD(2))
+#End If
+
+
+    
+    Dim i As Integer
+    
+    For i = 0 To UBound(Fish)
+        fishR(i).Right = fishD(i).lWidth
+        fishR(i).bottom = fishD(i).lHeight
+        fishkey(i).low = 0
+        fishkey(i).high = 0
+        Fish(i).SetColorKey DDCKEY_SRCBLT, fishkey(i)
+    Next i
+    
+    
+    'sprite(5) animated hand
+    
+    SpriteD(5).lFlags = DDSD_CAPS
+    SpriteD(5).ddsCaps.lCaps = DDSCAPS_OFFSCREENPLAIN Or DDSCAPS_SYSTEMMEMORY
+    
+#If RunInIDE = 1 Then
+    'ide
+    Set Sprites(5) = DD.CreateSurfaceFromFile("handani.bmp", SpriteD(5))
+#Else
+    'exe
+    Set Sprites(5) = DD.CreateSurfaceFromResource(AddDirSep(App.Path) & App.EXEName & ".exe", "handani", SpriteD(5))
+#End If
+    
+
+    SpriteR(5).Right = SpriteD(5).lWidth
+    SpriteR(5).bottom = SpriteD(5).lHeight
+    spriteWidth = 272
+    spriteHeight = 177
+    cols = SpriteD(5).lWidth / spriteWidth
+    rows = SpriteD(5).lHeight / spriteHeight
+    
+    key(5).low = 0
+    key(5).high = 0
+    Sprites(5).SetColorKey DDCKEY_SRCBLT, key(5)
+    
+    
+    '9
+    SpriteD(9).lFlags = DDSD_CAPS
+    SpriteD(9).ddsCaps.lCaps = DDSCAPS_OFFSCREENPLAIN Or DDSCAPS_SYSTEMMEMORY
+    
+#If RunInIDE = 1 Then
+    'ide
+    Set Sprites(9) = DD.CreateSurfaceFromFile("bknote.bmp", SpriteD(9))
+#Else
+    'exe
+    Set Sprites(9) = DD.CreateSurfaceFromResource(AddDirSep(App.Path) & App.EXEName & ".exe", "bknote", SpriteD(9))
+#End If
+    
+
+    SpriteR(9).Right = SpriteD(9).lWidth
+    SpriteR(9).bottom = SpriteD(9).lHeight
+        
+        
+    StripVert slide(), SpriteR(9).Right, SpriteR(9).bottom
+    
+    '8
+    SpriteD(8).lFlags = DDSD_CAPS
+    SpriteD(8).ddsCaps.lCaps = DDSCAPS_OFFSCREENPLAIN Or DDSCAPS_SYSTEMMEMORY
+    
+#If RunInIDE = 1 Then
+    'ide
+    Set Sprites(8) = DD.CreateSurfaceFromFile("dance.bmp", SpriteD(8))
+#Else
+    'exe
+    Set Sprites(8) = DD.CreateSurfaceFromResource(AddDirSep(App.Path) & App.EXEName & ".exe", "dance", SpriteD(8))
+#End If
+
+    SpriteR(8).Right = SpriteD(8).lWidth
+    SpriteR(8).bottom = SpriteD(8).lHeight
+        
+    
+    
+    
+    
+End Sub
+
+Public Sub MoveFrame(Index As Integer)
+
+    On Local Error GoTo err_
+    
+    Select Case Index
+        Case 0
+            bB.Blt BBR, Sprites(Index), SpriteR(Index), DDBLT_WAIT
+            
+            
+            bB.Lock AlphaRect, BD, DDLOCK_WAIT, 0
+            bB.GetLockedArray ar()
+                DoEvents
+    
+                clr = Rnd * 255
+                
+                For y = 0 To (AlphaRect.bottom - 1)
+                For x = 0 To (AlphaRect.Right - 1) * 2
+        
+                    If ar(x, y) <> 0 And ar(x, y) <> 64 And ar(x, y) <> 255 And ar(x, y) <> 127 Then
+                            If ar(x, y) = 224 Then
+                                ar(x, y) = clr
+                            End If
+                    End If
+                Next
+                DoEvents
+                Next
+                DoEvents
+                bB.Unlock AlphaRect
+             
+            
+                GetWindowRect frmMain.mnCan.hwnd, DR
+                DDS.Blt DR, bB, BBR, DDBLT_WAIT
+            
+        Case 1
+            tmpR.Top = Rnd * 200
+            tmpR.Left = Rnd * 50
+            
+            bB.Blt BBR, Sprites(Index), SpriteR(Index), DDBLT_WAIT
+            bB.BltFast tmpR.Left, tmpR.Top, Sprites(6), SpriteR(6), DDBLTFAST_WAIT Or DDBLTFAST_SRCCOLORKEY
+                        
+            
+            
+            GetWindowRect frmMain.mnCan.hwnd, DR
+            DDS.Blt DR, bB, BBR, DDBLT_WAIT
+            Sleep 50
+            
+            
+        Case 2
+            On Error Resume Next
+            Dim nColor As Integer, tmp As Integer
+            bB.Blt BBR, Sprites(Index), SpriteR(Index), DDBLT_WAIT
+            GetWindowRect frmMain.mnCan.hwnd, DR
+            bB.Lock AlphaRect, BD, DDLOCK_WAIT, 0
+            bB.GetLockedArray ar()
+            DoEvents
+            nColor = Rnd * 256
+            If nColor = 0 Then nColor = 1
+            
+            For y = 0 To (AlphaRect.bottom - 1)
+            For x = 0 To (AlphaRect.Right - 1) * (lPixelDepth \ 8)
+            If ar(x, y) <> 0 And ar(x, y) <> 124 Then
+                    ar(x, y) = nColor
+            End If
+            Next
+            DoEvents
+            
+            Next
+            DoEvents
+            bB.Unlock AlphaRect
+            DDS.Blt DR, bB, BBR, DDBLT_WAIT
+            On Error GoTo 0
+        Case 3
+              
+              
+            With fi(0)
+                .x = .x + 1: If .x > frmMain.mnCan.ScaleWidth Then .x = 0
+                .y = Sin(.x / 5) * 5 + (frmMain.mnCan.ScaleHeight \ 2)
+            End With
+
+
+            With fi(1)
+                .x = .x + 2: If .x > frmMain.mnCan.ScaleWidth Then .x = 0
+                .y = Sin(.x / 20) * 20 + (frmMain.mnCan.ScaleHeight \ 4)
+            End With
+
+            With fi(2)
+                .x = .x - 2: If .x < frmMain.mnCan.ScaleLeft Then .x = frmMain.mnCan.ScaleWidth
+                .y = Sin(.x / 40) * 40 + (frmMain.mnCan.ScaleHeight \ 3)
+            End With
+              
+            Dim i As Integer
+            
+                bB.BltColorFill BBR, &H0
+                
+            For i = 0 To UBound(fi)
+                bB.BltFast fi(i).x, fi(i).y, Fish(i), fishR(i), DDBLTFAST_WAIT Or DDBLTFAST_SRCCOLORKEY
+            Next i
+                        
+            GetWindowRect frmMain.mnCan.hwnd, DR
+            DDS.Blt DR, bB, BBR, DDBLT_WAIT
+            
+            Sleep 50
+        Case 5
+        
+            Dim rSprite As DxVBLib.RECT
+            
+            currentframe = currentframe + 1
+            If currentframe > rows * cols - 1 Then currentframe = 0
+            
+            col = currentframe Mod cols
+            row = Int(currentframe / cols)
+            rSprite.Left = col * spriteWidth
+            rSprite.Top = row * spriteHeight
+            rSprite.Right = rSprite.Left + spriteWidth
+            rSprite.bottom = rSprite.Top + spriteHeight
+              
+           
+    
+            bB.BltColorFill BBR, &H0
+            Set bB = MoveBackRight(bB, Sprites(9), slide)
+           
+            DoEvents
+            
+            bB.BltFast 0, frmMain.mnCan.ScaleHeight \ 3, Sprites(Index), rSprite, DDBLTFAST_SRCCOLORKEY Or DDBLTFAST_WAIT
+            
+                        
+            GetWindowRect frmMain.mnCan.hwnd, DR
+            DDS.Blt DR, bB, BBR, DDBLT_WAIT
+            
+            
+            Sleep 80
+        Case 6
+           
+           
+            bB.Blt BBR, Sprites(8), SpriteR(8), DDBLT_WAIT
+            
+            
+                bB.Lock AlphaRect, BD, DDLOCK_WAIT, 0
+                bB.GetLockedArray ar()
+                DoEvents
+            
+    
+            For y = 0 To (AlphaRect.bottom - 1)
+            For x = 0 To (AlphaRect.Right - 1) * 2
+    
+            If ar(x, y) <> 0 And ar(x, y) <> 255 Then
+                    ar(x, y) = Rnd * 255
+            End If
+            Next
+            DoEvents
+            
+            Next
+            DoEvents
+            bB.Unlock AlphaRect
+            DDS.Blt DR, bB, BBR, DDBLT_WAIT
+           
+        
+                        
+            GetWindowRect frmMain.mnCan.hwnd, DR
+            DDS.Blt DR, bB, BBR, DDBLT_WAIT
+            
+'            Sleep 20
+    
+    End Select
+    
+    Exit Sub
+err_:
+    
+    If Not (DD Is Nothing) Then
+        DD.SetCooperativeLevel frmMain.hwnd, DDSCL_NORMAL
+        DoEvents
+    End If
+    MsgBox "There was an issue with playing the current frame." & vbCrLf & _
+            Err.Number & vbCrLf & _
+            Err.Description, vbApplicationModal
+    End
+    
+    
+End Sub
+
+
+Public Sub StripVert(cChop() As DxVBLib.RECT, wD As Long, hD As Long)
+    Dim cntr As Integer
+    Dim nN As Long
+    Dim sZ As Long
+    
+    For cntr = 0 To UBound(cChop)
+        sZ = wD / UBound(cChop)
+        nN = nN + sZ
+        
+        cChop(cntr).Left = (nN - sZ)
+        cChop(cntr).Right = nN
+        cChop(cntr).bottom = hD
+    Next
+    
+    'StripVert = cChop
+    
+End Sub
+
+Public Function MoveBackRight(ByVal bB As DirectDrawSurface7, ByVal backgrounds As DirectDrawSurface7, recArray() As DxVBLib.RECT) As DirectDrawSurface7
+    Dim tmpC As Integer
+    Dim stp As Integer
+    Static cntrFR As Integer
+    
+    For tmpC = 0 To UBound(recArray)
+           If cntrFR >= (UBound(recArray) - 1) Then
+               cntrFR = 0
+           End If
+            bB.BltFast recArray(cntrFR).Left, (frmMain.mnCan.ScaleHeight \ 3), backgrounds, recArray(tmpC), DDBLTFAST_WAIT
+            cntrFR = cntrFR + 1
+           DoEvents
+    Next
+    
+    Set MoveBackRight = bB
+    DoEvents
+End Function
+
+Public Function LoadMSg(Index As Integer) As String
+
+    Dim tempMSG(7) As String
+    
+    'wed
+    tempMSG(0) = "Big Band!" & vbCrLf & _
+                 "Join us for a blast from the past!  Enjoy cutting the rug " & vbCrLf & _
+                 "with the finest big band musicians from the area.  Whether " & vbCrLf & _
+                 "you want to swing dance the night away, or just listen to " & vbCrLf & _
+                 "the big sound from the stage, you're sure to have a great time." & vbCrLf & _
+                 "Just don't forget the zoot suit at home!"
+    'thur
+    tempMSG(1) = "Jazz Night!" & vbCrLf & _
+                 "Thursdays are a big night at Club Met, because our jazz music" & vbCrLf & _
+                 "is always cool and fresh.  The musicians that join us are always" & vbCrLf & _
+                 "Grade A, including local band Benny HaHa and the Blue Wave." & vbCrLf & _
+                 "Jazz has never been better!"
+    'fri
+    tempMSG(2) = "Disco!" & vbCrLf & _
+                 "If the 70's are making a comeback, you'll find Friday Night at Club Met" & vbCrLf & _
+                 "to be the headquarters.  Always a blast, we bring in some of the original" & vbCrLf & _
+                 "disco artists to play their most popular numbers.  It's even more fun to" & vbCrLf & _
+                 "come dressed to the part.  Come once and it's sure to be your Friday Night" & vbCrLf & _
+                 "hang out!"
+    'sat
+    tempMSG(3) = "Dance Night!" & vbCrLf & _
+                 "A definite favorite of Generation X (and Y) is Dance night at Club Met." & vbCrLf & _
+                 "Our own DJ, Flavor Mike, spins the latest dance hits all night long." & vbCrLf & _
+                 "Once you start dancing, you can't slow down.  Plenty of new people to " & vbCrLf & _
+                 "meet, and always a good time."
+                 
+    'sun
+    tempMSG(4) = "Classical!" & vbCrLf & _
+                 "If your tastes are more refined, we encourage you to join us on Sunday" & vbCrLf & _
+                 "night at Club Met.  You'll enjoy intellectual conversation and delightful" & vbCrLf & _
+                 "music from the Baroque, Classical, and Romantic eras, played by renowned" & vbCrLf & _
+                 "local artists.  A great way to energize yourself for the week ahead."
+                 
+                 
+    LoadMSg = tempMSG(Index)
+                 
+
+End Function
+

Library/dxx8/samples/Multimedia/VBSamples/Demos/ClubMet/vb_ClubMet.vbp

@@ -0,0 +1,38 @@
+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
+Reference=*\G{E1211242-8E94-11D1-8808-00C04FC2C602}#1.0#0#dx7vb.dll#DirectX 7 for Visual Basic Type Library
+Form=ClubMet.frm
+Module=basDD; basDD.bas
+ResFile32="ClubMet.RES"
+Module=MediaDir; ..\..\common\media.bas
+IconForm="frmMain"
+Startup="frmMain"
+HelpFile=""
+Title="ClubMet"
+Command32=""
+Name="vbClubMet"
+HelpContextID="0"
+CompatibleMode="0"
+MajorVer=1
+MinorVer=0
+RevisionVer=0
+AutoIncrementVer=0
+ServerSupportFiles=0
+VersionCompanyName="MS"
+CondComp="RunInIDE = 0"
+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