Results 1 to 2 of 2

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

  1. #1

    Thread Starter
    PowerPoster Ellis Dee's Avatar
    Join Date
    Mar 2007
    Location
    New England
    Posts
    3,530

    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:

    Name:  Screenshot.jpg
Views: 748
Size:  61.3 KB

    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.
    Attached Files Attached Files
    Last edited by Ellis Dee; Apr 10th, 2021 at 03:11 PM.

  2. #2

    Thread Starter
    PowerPoster Ellis Dee's Avatar
    Join Date
    Mar 2007
    Location
    New England
    Posts
    3,530

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

    Quote Originally Posted by Ellis Dee View Post
    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:
    1. Private Const ThirtyK As Long = 32768
    2.  
    3. Public Enum MoveDirectionEnum
    4.     mdeNone
    5.     mdeUp
    6.     mdeDown
    7.     mdeLeft
    8.     mdeRight
    9. End Enum
    10.  
    11. Private Type JoystickInputType
    12.     Direction As MoveDirectionEnum
    13.     Start As Currency ' Used internally by stopwatch
    14.     NextRepeat As Double ' When the next event should be raised (0.3 = 300 milliseconds since stopwatch started)
    15. End Type
    16.  
    17. Private Type JoystickStateType
    18.     LeftStick As JoystickInputType
    19.     RightStick As JoystickInputType
    20.     DPad As JoystickInputType
    21.     LeftTrigger As JoystickInputType
    22.     RightTrigger As JoystickInputType
    23.     Button As JoystickButtonEnum
    24. End Type
    25.  
    26. Private joy As JoystickStateType
    27. Private old As JoystickStateType
    28.  
    29.  
    30. Private Sub tmr_Timer()
    31.     If CheckControllerState() Then RaiseEvents
    32. End Sub
    33.  
    34.  
    35. ' ************* CHECK *************
    36.  
    37.  
    38. Private Function CheckControllerState() As Boolean
    39.     Dim typInfoEx As JOYINFOEX
    40.    
    41.     typInfoEx.dwSize = Len(typInfoEx)
    42.     typInfoEx.dwFlags = JOY_RETURNALL
    43.     ' Note: The first parameter is which joystick to check, 0 being the first one
    44.     ' Can check from 0 to 15 to monitor up to 16 different controllers
    45.     If joyGetPosEx(0, typInfoEx) <> 0 Then Exit Function ' primary joystick not found
    46.     old = joy
    47.     With typInfoEx
    48.         joy.LeftStick.Direction = CheckAnalogStick(.dwXpos, .dwYpos)
    49.         joy.RightStick.Direction = CheckAnalogStick(.dwUpos, .dwRpos)
    50.         joy.DPad.Direction = CheckDPad(.dwPOV)
    51.         joy.Button = .dwButtons ' if multiple buttons are pressed they will be AND'ed together
    52.         CheckTriggers .dwZpos ' single value for both triggers
    53.     End With
    54.     CheckControllerState = True
    55. End Function
    56.  
    57. Private Function CheckAnalogStick(ByVal X As Long, ByVal Y As Long) As MoveDirectionEnum
    58.     X = X - ThirtyK
    59.     Y = Y - ThirtyK
    60.     If Abs(X) > Abs(Y) Then
    61.         CheckAnalogStick = GetDirection(X, mdeLeft, mdeRight)
    62.     Else
    63.         CheckAnalogStick = GetDirection(Y, mdeUp, mdeDown)
    64.     End If
    65. End Function
    66.  
    67. Private Function GetDirection(plngValue As Long, penLow As MoveDirectionEnum, penHigh As MoveDirectionEnum) As MoveDirectionEnum
    68.     If plngValue < -mlngSensitivity Then
    69.         GetDirection = penLow
    70.     ElseIf plngValue > mlngSensitivity Then
    71.         GetDirection = penHigh
    72.     Else
    73.         GetDirection = mdeNone
    74.     End If
    75. End Function
    76.  
    77. Private Function CheckDPad(plngValue As Long) As MoveDirectionEnum
    78.     Select Case plngValue
    79.         Case 0: CheckDPad = mdeUp
    80.         Case 9000: CheckDPad = mdeRight
    81.         Case 18000: CheckDPad = mdeDown
    82.         Case 27000: CheckDPad = mdeLeft
    83.         Case Else: CheckDPad = mdeNone
    84.     End Select
    85. End Function
    86.  
    87. ' 128-32766 = right trigger, 32767 = none, 32768-65408 = left trigger
    88. Private Sub CheckTriggers(ByVal plngValue As Long)
    89.     plngValue = plngValue - ThirtyK
    90.     joy.LeftTrigger.Direction = BooleanToDirection(plngValue > mlngSensitivity)
    91.     joy.RightTrigger.Direction = BooleanToDirection(plngValue < -mlngSensitivity)
    92. End Sub
    93.  
    94. Private Function BooleanToDirection(pblnBoolean As Boolean) As MoveDirectionEnum
    95.     If pblnBoolean Then BooleanToDirection = mdeUp Else BooleanToDirection = mdeNone
    96. End Function
    97.  
    98.  
    99. ' ************* EVENTS *************
    100.  
    101.  
    102. Private Sub RaiseEvents()
    103.     If Repeat(joy.LeftStick, old.LeftStick) Then RaiseEvent LeftStick(joy.LeftStick.Direction)
    104.     If Repeat(joy.RightStick, old.RightStick) Then RaiseEvent RightStick(joy.RightStick.Direction)
    105.     If Repeat(joy.DPad, old.DPad) Then RaiseEvent DPad(joy.DPad.Direction)
    106.     If Repeat(joy.LeftTrigger, old.LeftTrigger) Then RaiseEvent LeftTrigger
    107.     If Repeat(joy.RightTrigger, old.RightTrigger) Then RaiseEvent RightTrigger
    108.     If joy.Button <> old.Button And joy.Button <> jbeNone Then RaiseEvent ButtonPress(joy.Button)
    109. End Sub
    110.  
    111. Private Function Repeat(typNew As JoystickInputType, typOld As JoystickInputType) As Boolean
    112.     If typNew.Direction = mdeNone Then
    113.         If typOld.Direction <> mdeNone Then
    114.             typNew.Start = 0
    115.             typNew.NextRepeat = 0
    116.         End If
    117.     ElseIf typNew.Direction <> typOld.Direction Then
    118.         typNew.Start = StopwatchStart()
    119.         typNew.NextRepeat = mdblInitialDelay
    120.         Repeat = True
    121.     ElseIf StopwatchElapsed(typNew.Start) >= typNew.NextRepeat Then
    122.         typNew.NextRepeat = typNew.NextRepeat + mdblRepeatDelay
    123.         Repeat = True
    124.     End If
    125. End Function
    126.  
    127.  
    128. ' ************* STOPWATCH *************
    129.  
    130.  
    131. Private Sub StopwatchInit()
    132.     Dim curFrequency As Currency
    133.    
    134.     QueryPerformanceFrequency curFrequency
    135.     mdblFrequency = CDbl(curFrequency)
    136. End Sub
    137.  
    138. Private Function StopwatchStart() As Currency
    139.     Dim curStart As Currency
    140.    
    141.     QueryPerformanceCounter curStart
    142.     StopwatchStart = curStart
    143. End Function
    144.  
    145. Private Function StopwatchElapsed(pcurStart As Currency) As Double
    146.     Dim curStop As Currency
    147.    
    148.     QueryPerformanceCounter curStop
    149.     StopwatchElapsed = CDbl((curStop - pcurStart) / mdblFrequency)
    150. End Function

    I rather like this code.
    Last edited by Ellis Dee; Apr 10th, 2021 at 03:34 PM.

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •  



Click Here to Expand Forum to Full Width