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

When exiting one controller game and launching another, it's annoying to have to reach for the mouse in between. Here's a game menu the joystick can control. Works flawlessly with my brand new xbox wireless controller (carbon black).

All native VB6 code plus some API calls, thus it's "portable" with no installation. No idea how far back it's compatible with; I'll guess Windows XP but don't hold me to it. With right around 1250 total lines of code it compiles to a svelte 72k exe.

The joystick support is based on Ben321's excellent CodeBank entry here. I use the same method, but wrap it inside a usercontrol with its own internal timer the programmer never has to see. Instead of having to check the joystick state inside a timer, you can just respond to the usercontrol events, which fire off similarly to keyboard events.

Here's how GameMenu looks on my machine:

Attachment 180977

You can see my shortcut to it in my quicklaunch area so it ends up being extremely similar to just hitting the start menu.

The program uses an "ini"-style text file to customize your game list as well as any of the many customizable settings. Any game you add to the menu, you also need to add an *.ico (or *.bmp) file to the icons folder with the same name as the title, as well as a shortcut file (*.lnk or *.url) in the shortcuts folder. This was the key breakthrough for me, as the Microsoft Store games I have (Halo, AoE) are resistant to ShellExecute-ing with the paths and filenames hidden inside a walled garden. But all games let you create a shortcut on the desktop, and shortcuts ShellExecute just fine.

Here's the contents of the GameMenu.txt in the zip:

Code:

---

; Joystick sensitivity ranges from 0 to 32767; lower is more sensitive.
Sensitivity: 7000
InitialDelay: 260
RepeatDelay: 80

; Icon files can be *.ico or *.bmp  Shortcuts can be *.lnk or *.url
IconPath: Icons\48x48
ShortcutPath: Shortcuts

; Right-click anywhere on the form (or game) to see what font values actually apply
FontName: Segoe UI
FontSize: 10.2
FontBold: False

; Colors (eg Blue) can be html (#0000FF) long integer (16711680) or an RGB list (0, 0, 255)
; System color constants are negative (eg: vbHighlight = -2147483635)
TextColor: 255, 255, 255
DimColor: 196, 196, 196
BackColor: 54, 53, 51
Highlight: 38, 37, 36
Activated: -2147483635
Separator: 71, 70, 67

; Offsets (in pixels) to position window flush with bottom left corner of desktop
OffsetX: -2
OffsetY: 2

; Margins (in pixels) for column spacing, separator height, etc...
MarginX: 12
MarginY: 12

; MENU DEFINITIONS
;
; Program will look for icon and shortcut files named the
; same as the title with the following substitutions:
;    : ==> _  / ==> -  \ ==> -  | ==> -  * ==> @  " ==> '  < ==> [  > ==> ]
;    ? removed (no replacement)
; eg: Title "Bob: Lobl*w?" would look for files named "Bob_ Lobl@w.*"

[Column]
Title: Geometry Wars
Title: The Ur-Quan Masters
Title: Oxygen Not Included
Title: Subnautica
Title: Defense Zone 3
Title: -
Title: X-COM: Enemy Within
Title: Hitman: Absolution

[Column]
Title: Grid 2
Title: PGA Tour 2K21
Title: -
Title: Halo
Title: DOOM
Title: -
Title: Starcraft
Title: Starcraft II
Title: Age of Empires

---

Checking some other postings, it appears that including the exe along with the source code is the protocol so I've included the exe.

Note that the shortcuts aren't expected to work for you; you need to make your own for your own games. You also need to make icons. I extracted icons from my game exe's with the freeware utility IconViewer 3.02, and then opened those icons with open source freeware GreenFish Icon Editor and chose "export page" to create vb6-compatible ico files of a fixed size. Worked a treat, actually.

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

Quote:

---

Originally Posted by 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:

vb6 Code:

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.