Private Const ThirtyK As Long = 32768
Public Enum MoveDirectionEnum
mdeNone
mdeUp
mdeDown
mdeLeft
mdeRight
End Enum
Private Type JoystickInputType
Direction As MoveDirectionEnum
Start As Currency ' Used internally by stopwatch
NextRepeat As Double ' When the next event should be raised (0.3 = 300 milliseconds since stopwatch started)
End Type
Private Type JoystickStateType
LeftStick As JoystickInputType
RightStick As JoystickInputType
DPad As JoystickInputType
LeftTrigger As JoystickInputType
RightTrigger As JoystickInputType
Button As JoystickButtonEnum
End Type
Private joy As JoystickStateType
Private old As JoystickStateType
Private Sub tmr_Timer()
If CheckControllerState() Then RaiseEvents
End Sub
' ************* CHECK *************
Private Function CheckControllerState() As Boolean
Dim typInfoEx As JOYINFOEX
typInfoEx.dwSize = Len(typInfoEx)
typInfoEx.dwFlags = JOY_RETURNALL
' Note: The first parameter is which joystick to check, 0 being the first one
' Can check from 0 to 15 to monitor up to 16 different controllers
If joyGetPosEx(0, typInfoEx) <> 0 Then Exit Function ' primary joystick not found
old = joy
With typInfoEx
joy.LeftStick.Direction = CheckAnalogStick(.dwXpos, .dwYpos)
joy.RightStick.Direction = CheckAnalogStick(.dwUpos, .dwRpos)
joy.DPad.Direction = CheckDPad(.dwPOV)
joy.Button = .dwButtons ' if multiple buttons are pressed they will be AND'ed together
CheckTriggers .dwZpos ' single value for both triggers
End With
CheckControllerState = True
End Function
Private Function CheckAnalogStick(ByVal X As Long, ByVal Y As Long) As MoveDirectionEnum
X = X - ThirtyK
Y = Y - ThirtyK
If Abs(X) > Abs(Y) Then
CheckAnalogStick = GetDirection(X, mdeLeft, mdeRight)
Else
CheckAnalogStick = GetDirection(Y, mdeUp, mdeDown)
End If
End Function
Private Function GetDirection(plngValue As Long, penLow As MoveDirectionEnum, penHigh As MoveDirectionEnum) As MoveDirectionEnum
If plngValue < -mlngSensitivity Then
GetDirection = penLow
ElseIf plngValue > mlngSensitivity Then
GetDirection = penHigh
Else
GetDirection = mdeNone
End If
End Function
Private Function CheckDPad(plngValue As Long) As MoveDirectionEnum
Select Case plngValue
Case 0: CheckDPad = mdeUp
Case 9000: CheckDPad = mdeRight
Case 18000: CheckDPad = mdeDown
Case 27000: CheckDPad = mdeLeft
Case Else: CheckDPad = mdeNone
End Select
End Function
' 128-32766 = right trigger, 32767 = none, 32768-65408 = left trigger
Private Sub CheckTriggers(ByVal plngValue As Long)
plngValue = plngValue - ThirtyK
joy.LeftTrigger.Direction = BooleanToDirection(plngValue > mlngSensitivity)
joy.RightTrigger.Direction = BooleanToDirection(plngValue < -mlngSensitivity)
End Sub
Private Function BooleanToDirection(pblnBoolean As Boolean) As MoveDirectionEnum
If pblnBoolean Then BooleanToDirection = mdeUp Else BooleanToDirection = mdeNone
End Function
' ************* EVENTS *************
Private Sub RaiseEvents()
If Repeat(joy.LeftStick, old.LeftStick) Then RaiseEvent LeftStick(joy.LeftStick.Direction)
If Repeat(joy.RightStick, old.RightStick) Then RaiseEvent RightStick(joy.RightStick.Direction)
If Repeat(joy.DPad, old.DPad) Then RaiseEvent DPad(joy.DPad.Direction)
If Repeat(joy.LeftTrigger, old.LeftTrigger) Then RaiseEvent LeftTrigger
If Repeat(joy.RightTrigger, old.RightTrigger) Then RaiseEvent RightTrigger
If joy.Button <> old.Button And joy.Button <> jbeNone Then RaiseEvent ButtonPress(joy.Button)
End Sub
Private Function Repeat(typNew As JoystickInputType, typOld As JoystickInputType) As Boolean
If typNew.Direction = mdeNone Then
If typOld.Direction <> mdeNone Then
typNew.Start = 0
typNew.NextRepeat = 0
End If
ElseIf typNew.Direction <> typOld.Direction Then
typNew.Start = StopwatchStart()
typNew.NextRepeat = mdblInitialDelay
Repeat = True
ElseIf StopwatchElapsed(typNew.Start) >= typNew.NextRepeat Then
typNew.NextRepeat = typNew.NextRepeat + mdblRepeatDelay
Repeat = True
End If
End Function
' ************* STOPWATCH *************
Private Sub StopwatchInit()
Dim curFrequency As Currency
QueryPerformanceFrequency curFrequency
mdblFrequency = CDbl(curFrequency)
End Sub
Private Function StopwatchStart() As Currency
Dim curStart As Currency
QueryPerformanceCounter curStart
StopwatchStart = curStart
End Function
Private Function StopwatchElapsed(pcurStart As Currency) As Double
Dim curStop As Currency
QueryPerformanceCounter curStop
StopwatchElapsed = CDbl((curStop - pcurStart) / mdblFrequency)
End Function