VB6 GameMenu (like a start menu) with Joystick / Xbox Controller support

[Ellis Dee]

Aside from the utility of the thing, this project contains some of my better coding.

...and of course I forgot to apply the joystick settings from the settings file to the joystick usercontrol. Program reads them, but then doesn't use them. Doh! I've edited the attachment in the OP to correct this.

Glaring mistakes aside, the line quoted above is primarily in reference to the logic of the joystick usercontrol. Here is that logic in its entirety, including selected relevant definitions:

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

I rather like this code.