Visual Basic Game Programming for Teens/VBGPFT.cdr/sources/chapter11/JoystickTest/Form1.frm

Visual Basic Form | 2004-10-22 | 7.1 KB | 211 lines

VERSION 5.00
Begin VB.Form Form1
   AutoRedraw      =   -1  'True
   BorderStyle     =   1  'Fixed Single
   Caption         =   "Form1"
   ClientHeight    =   3675
   ClientLeft      =   45
   ClientTop       =   330
   ClientWidth     =   4860
   LinkTopic       =   "Form1"
   MaxButton       =   0   'False
   MinButton       =   0   'False
   ScaleHeight     =   245
   ScaleMode       =   3  'Pixel
   ScaleWidth      =   324
   StartUpPosition =   2  'CenterScreen
Attribute VB_Name = "Form1"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
'----------------------------------------------------------------------
' Visual Basic Game Programming For Teens
' JoystickTest Program
'----------------------------------------------------------------------
Option Explicit
Option Base 0
Implements DirectXEvent8
'DirectX objects and structures
Dim dx As New DirectX8
Dim di As DirectInput8
Dim diDev As DirectInputDevice8
Dim diDevEnum As DirectInputEnumDevices8
Dim joyCaps As DIDEVCAPS
'keep track of analog stick motion
Dim Analog(1 To 2) As D3DVECTOR
'program variables
Dim EventHandle As Long
Private Sub Form_Load()
    On Local Error Resume Next
    'create the DirectInput object
    Set di = dx.DirectInputCreate()
    If Err.Number <> 0 Then
        MsgBox "Error creating DirectInput object"
        Shutdown
    End If
    'enumerate the game controllers
    Set diDevEnum = di.GetDIDevices(DI8DEVCLASS_GAMECTRL, DIEDFL_ATTACHEDONLY)
    If Err.Number <> 0 Then
        MsgBox "Error enumerating game controllers"
        Shutdown
    End If
    'check for the presence of a joystick
    If diDevEnum.GetCount = 0 Then
        MsgBox "No joystick could be found"
        Shutdown
    End If
    'initialize the joystick
    Joystick_Init
    'main polling loop
    Do While True
        diDev.Poll
        DoEvents
    Loop
End Sub
Private Sub Form_KeyDown(KeyCode As Integer, Shift As Integer)
    If KeyCode = 27 Then Shutdown
End Sub
Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer)
    Shutdown
End Sub
Private Sub Shutdown()
    If EventHandle <> 0 Then
        dx.DestroyEvent EventHandle
    End If
    If Not (diDev Is Nothing) Then diDev.Unacquire
    Set diDev = Nothing
    Set di = Nothing
    Set dx = Nothing
    End
End Sub
Private Sub Joystick_Init()
    On Local Error Resume Next
    'see if joystick was already acquired
    If Not diDev Is Nothing Then
      diDev.Unacquire
    End If
    'create the joystick object
    Set diDev = Nothing
    Set diDev = di.CreateDevice(diDevEnum.GetItem(1).GetGuidInstance)
    diDev.SetCommonDataFormat DIFORMAT_JOYSTICK
    diDev.SetCooperativeLevel Me.hWnd, DISCL_BACKGROUND Or DISCL_NONEXCLUSIVE
    'create an event handler for the joystick
    EventHandle = dx.CreateEvent(Me)
    'ask for notification of events
    diDev.SetEventNotification EventHandle
    'set the analog response range
    SetAnalogRanges -1000, 1000
    'acquire joystick for exclusive use
    diDev.Acquire
    'manually poll joystick first time
    DirectXEvent8_DXCallback 0
    'retrieve joystick information
    diDev.GetCapabilities joyCaps
    'display information about the joystick
    Debug.Print diDevEnum.GetItem(1).GetInstanceName
    Debug.Print "Number of axes: " & joyCaps.lAxes
    Debug.Print "Number of buttons: " & joyCaps.lButtons
    Debug.Print "Device type: " & joyCaps.lDevType
    Debug.Print "Driver version: " & joyCaps.lDriverVersion
    Debug.Print "Time resolution: " & joyCaps.lFFMinTimeResolution
    Debug.Print "Sample period: " & joyCaps.lFFSamplePeriod
    Debug.Print "Firware revision: " & joyCaps.lFirmwareRevision
    Debug.Print "Hardware revision: " & joyCaps.lHardwareRevision
    Debug.Print "Number of POVs: " & joyCaps.lPOVs
End Sub
Private Sub SetAnalogRanges(ByVal lMin As Long, ByVal lMax As Long)
    Dim DiProp_Dead As DIPROPLONG
    Dim DiProp_Range As DIPROPRANGE
    Dim DiProp_Saturation As DIPROPLONG
    On Local Error Resume Next
    'set range for all axes
    With DiProp_Range
        .lHow = DIPH_DEVICE
        .lMin = lMin
        .lMax = lMax
    End With
    'set the property
    diDev.SetProperty "DIPROP_RANGE", DiProp_Range
    'set deadzone for X and Y axes to 5 percent
    With DiProp_Dead
        .lData = (lMax - lMin) / 5
        .lHow = DIPH_BYOFFSET
        .lObj = DIJOFS_X
        diDev.SetProperty "DIPROP_DEADZONE", DiProp_Dead
        .lObj = DIJOFS_Y
        diDev.SetProperty "DIPROP_DEADZONE", DiProp_Dead
    End With
    'set saturation zone for X and Y axes to 95 percent
    With DiProp_Saturation
        .lData = (lMax - lMin) * 0.95
        .lHow = DIPH_BYOFFSET
        .lObj = DIJOFS_X
         diDev.SetProperty "DIPROP_SATURATION", DiProp_Saturation
        .lObj = DIJOFS_Y
         diDev.SetProperty "DIPROP_SATURATION", DiProp_Saturation
    End With
End Sub
Private Sub Joystick_AnalogMove(ByVal lNum As Long, ByRef vAnalog As D3DVECTOR)
    Debug.Print "Analog stick " & lNum & " = " & _
        vAnalog.x & "," & vAnalog.y & "," & vAnalog.z
End Sub
Private Sub Joystick_SliderMove(ByVal lSlider As Long, ByVal lValue As Long)
    Debug.Print "Slider " & lSlider & " = " & lValue
End Sub
Private Sub DirectXEvent8_DXCallback(ByVal eventid As Long)
    Static Analog1 As D3DVECTOR
    Static Analog2 As D3DVECTOR
    Dim js As DIJOYSTATE
    Dim n As Long
    On Local Error Resume Next
    'retrieve joystick status
    diDev.GetDeviceStateJoystick js
    If Err.Number = DIERR_NOTACQUIRED Or Err.Number = DIERR_INPUTLOST Then
        diDev.Acquire
        Exit Sub
    End If
    'fire off any joystick analog movement events
    For n = 1 To 8
        Select Case n
            Case 1
                Analog1.x = js.x
                Joystick_AnalogMove 1, Analog1
            Case 2
                Analog1.y = js.y
                Joystick_AnalogMove 1, Analog1
            Case 3
                Analog1.z = js.z
                Joystick_AnalogMove 1, Analog1
            Case 4
                Analog2.x = js.rx
                Joystick_AnalogMove 2, Analog2
            Case 5
                Analog2.y = js.ry
                Joystick_AnalogMove 2, Analog2
            Case 6
                Analog2.z = js.rz
                Joystick_AnalogMove 2, Analog2
            Case 7
                Joystick_SliderMove 1, js.slider(0)
            Case 8
                Joystick_SliderMove 2, js.slider(1)
        End Select
     Next n
    'fire off any button events
    For n = 0 To joyCaps.lButtons - 1
        If js.Buttons(n) = 0 Then
            Debug.Print "Joystick ButtonUp: " & n
        Else
            Debug.Print "Joystick ButtonDown: " & n
        End If
    Next n

    'fire off any direction-pad button events
    If js.POV(0) = -1 Then
        Debug.Print "DPAD: -1"
    Else
        Debug.Print "DPAD: " & js.POV(0) / 4500
    End If
End Sub