LGram16
e067522598
Game client codebase including: - CharacterActionControl: Character and creature management - GlobalScript: Network, items, skills, quests, utilities - RYLClient: Main client application with GUI and event handlers - Engine: 3D rendering engine (RYLGL) - MemoryManager: Custom memory allocation - Library: Third-party dependencies (DirectX, boost, etc.) - Tools: Development utilities 🤖 Generated with [Claude Code](https://claude.com/claude-code) Co-Authored-By: Claude <noreply@anthropic.com>
421 lines
11 KiB
Plaintext
421 lines
11 KiB
Plaintext
VERSION 5.00
|
|
Begin VB.Form frmMain
|
|
BorderStyle = 1 'Fixed Single
|
|
Caption = "JoyStick Sample"
|
|
ClientHeight = 6240
|
|
ClientLeft = 45
|
|
ClientTop = 330
|
|
ClientWidth = 6000
|
|
Icon = "frmMain.frx":0000
|
|
LinkTopic = "Form1"
|
|
MaxButton = 0 'False
|
|
MinButton = 0 'False
|
|
ScaleHeight = 6240
|
|
ScaleWidth = 6000
|
|
StartUpPosition = 3 'Windows Default
|
|
Begin VB.ListBox lstHat
|
|
Enabled = 0 'False
|
|
Height = 1230
|
|
ItemData = "frmMain.frx":0442
|
|
Left = 4080
|
|
List = "frmMain.frx":0444
|
|
TabIndex = 6
|
|
Top = 3240
|
|
Width = 1695
|
|
End
|
|
Begin VB.ListBox lstButton
|
|
Enabled = 0 'False
|
|
Height = 2790
|
|
ItemData = "frmMain.frx":0446
|
|
Left = 2160
|
|
List = "frmMain.frx":0448
|
|
TabIndex = 2
|
|
Top = 3240
|
|
Width = 1695
|
|
End
|
|
Begin VB.ListBox lstJoyAxis
|
|
Enabled = 0 'False
|
|
Height = 2790
|
|
ItemData = "frmMain.frx":044A
|
|
Left = 240
|
|
List = "frmMain.frx":044C
|
|
TabIndex = 1
|
|
Top = 3240
|
|
Width = 1695
|
|
End
|
|
Begin VB.ListBox lstJoySticks
|
|
Height = 1815
|
|
ItemData = "frmMain.frx":044E
|
|
Left = 240
|
|
List = "frmMain.frx":0450
|
|
TabIndex = 0
|
|
Top = 720
|
|
Width = 5535
|
|
End
|
|
Begin VB.Label lblHats
|
|
Caption = "POVs"
|
|
BeginProperty Font
|
|
Name = "MS Sans Serif"
|
|
Size = 18
|
|
Charset = 0
|
|
Weight = 400
|
|
Underline = 0 'False
|
|
Italic = 0 'False
|
|
Strikethrough = 0 'False
|
|
EndProperty
|
|
Height = 375
|
|
Left = 4080
|
|
TabIndex = 7
|
|
Top = 2760
|
|
Width = 1335
|
|
End
|
|
Begin VB.Label lblButtons
|
|
Caption = "Buttons"
|
|
BeginProperty Font
|
|
Name = "MS Sans Serif"
|
|
Size = 18
|
|
Charset = 0
|
|
Weight = 400
|
|
Underline = 0 'False
|
|
Italic = 0 'False
|
|
Strikethrough = 0 'False
|
|
EndProperty
|
|
Height = 375
|
|
Left = 2160
|
|
TabIndex = 5
|
|
Top = 2760
|
|
Width = 1575
|
|
End
|
|
Begin VB.Label lblAxis
|
|
Caption = "Axes"
|
|
BeginProperty Font
|
|
Name = "MS Sans Serif"
|
|
Size = 18
|
|
Charset = 0
|
|
Weight = 400
|
|
Underline = 0 'False
|
|
Italic = 0 'False
|
|
Strikethrough = 0 'False
|
|
EndProperty
|
|
Height = 495
|
|
Left = 240
|
|
TabIndex = 4
|
|
Top = 2760
|
|
Width = 1335
|
|
End
|
|
Begin VB.Label lblJoy
|
|
Caption = "Joysticks"
|
|
BeginProperty Font
|
|
Name = "MS Sans Serif"
|
|
Size = 18
|
|
Charset = 0
|
|
Weight = 400
|
|
Underline = 0 'False
|
|
Italic = 0 'False
|
|
Strikethrough = 0 'False
|
|
EndProperty
|
|
Height = 375
|
|
Left = 240
|
|
TabIndex = 3
|
|
Top = 120
|
|
Width = 4215
|
|
End
|
|
End
|
|
Attribute VB_Name = "frmMain"
|
|
Attribute VB_GlobalNameSpace = False
|
|
Attribute VB_Creatable = False
|
|
Attribute VB_PredeclaredId = True
|
|
Attribute VB_Exposed = False
|
|
|
|
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
|
|
'
|
|
' Copyright (C) 1999-2001 Microsoft Corporation. All Rights Reserved.
|
|
'
|
|
' File: FrmMain.Frm
|
|
' Content: This sample shows one way to use DirectInput with a Joystick device
|
|
'
|
|
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
|
|
|
|
Option Explicit
|
|
Implements DirectXEvent8
|
|
|
|
|
|
Dim dx As New DirectX8
|
|
Dim di As DirectInput8
|
|
Dim diDev As DirectInputDevice8
|
|
Dim diDevEnum As DirectInputEnumDevices8
|
|
Dim EventHandle As Long
|
|
Dim joyCaps As DIDEVCAPS
|
|
Dim js As DIJOYSTATE
|
|
Dim DiProp_Dead As DIPROPLONG
|
|
Dim DiProp_Range As DIPROPRANGE
|
|
Dim DiProp_Saturation As DIPROPLONG
|
|
Dim AxisPresent(1 To 8) As Boolean
|
|
Dim running As Boolean
|
|
|
|
Sub InitDirectInput()
|
|
|
|
Set di = dx.DirectInputCreate()
|
|
Set diDevEnum = di.GetDIDevices(DI8DEVCLASS_GAMECTRL, DIEDFL_ATTACHEDONLY)
|
|
If diDevEnum.GetCount = 0 Then
|
|
MsgBox "No joystick attached."
|
|
Unload Me
|
|
End If
|
|
|
|
'Add attached joysticks to the listbox
|
|
Dim i As Integer
|
|
For i = 1 To diDevEnum.GetCount
|
|
Call lstJoySticks.AddItem(diDevEnum.GetItem(i).GetInstanceName)
|
|
Next
|
|
|
|
' Get an event handle to associate with the device
|
|
EventHandle = dx.CreateEvent(Me)
|
|
Exit Sub
|
|
|
|
Error_Out:
|
|
MsgBox "Error initializing DirectInput."
|
|
Unload Me
|
|
|
|
End Sub
|
|
|
|
|
|
Private Sub DirectXEvent8_DXCallback(ByVal eventid As Long)
|
|
|
|
' This is called whenever there's a change in the joystick state.
|
|
' We check the new state and update the display.
|
|
|
|
|
|
Dim i As Integer
|
|
Dim ListPos As Integer
|
|
Dim S As String
|
|
|
|
If diDev Is Nothing Then Exit Sub
|
|
|
|
'' Get the device info
|
|
On Local Error Resume Next
|
|
diDev.GetDeviceStateJoystick js
|
|
If Err.Number = DIERR_NOTACQUIRED Or Err.Number = DIERR_INPUTLOST Then
|
|
diDev.Acquire
|
|
Exit Sub
|
|
End If
|
|
|
|
|
|
On Error GoTo err_out
|
|
|
|
' Display axis coordinates
|
|
ListPos = 0
|
|
For i = 1 To 8
|
|
If AxisPresent(i) Then
|
|
Select Case i
|
|
Case 1
|
|
S = "X: " & js.x
|
|
Case 2
|
|
S = "Y: " & js.y
|
|
Case 3
|
|
S = "Z: " & js.z
|
|
Case 4
|
|
S = "RX: " & js.rx
|
|
Case 5
|
|
S = "RY: " & js.ry
|
|
Case 6
|
|
S = "RZ: " & js.rz
|
|
Case 7
|
|
S = "Slider0: " & js.slider(0)
|
|
Case 8
|
|
S = "Slider1: " & js.slider(1)
|
|
|
|
End Select
|
|
lstJoyAxis.List(ListPos) = S
|
|
ListPos = ListPos + 1
|
|
|
|
End If
|
|
Next
|
|
|
|
' Buttons
|
|
|
|
For i = 0 To joyCaps.lButtons - 1
|
|
Select Case js.Buttons(i)
|
|
Case 0
|
|
lstButton.List(i) = "Button " + CStr(i + 1) + ": Up"
|
|
|
|
Case Else
|
|
lstButton.List(i) = "Button " + CStr(i + 1) + ": Down"
|
|
|
|
End Select
|
|
Next
|
|
|
|
' Hats
|
|
For i = 0 To joyCaps.lPOVs - 1
|
|
lstHat.List(i) = "POV " + CStr(i + 1) + ": " + CStr(js.POV(i))
|
|
Next
|
|
|
|
Me.Caption = "Joystick Sample: Available"
|
|
|
|
Exit Sub
|
|
|
|
err_out:
|
|
MsgBox Err.Description & " : " & Err.Number, vbApplicationModal
|
|
End
|
|
|
|
End Sub
|
|
|
|
|
|
Private Sub Form_Load()
|
|
running = True
|
|
InitDirectInput
|
|
End Sub
|
|
|
|
|
|
Private Sub Form_Unload(cancel As Integer)
|
|
On Local Error Resume Next
|
|
If EventHandle <> 0 Then dx.DestroyEvent EventHandle
|
|
|
|
running = False
|
|
|
|
'Unacquire if we are holding a device
|
|
If Not diDev Is Nothing Then
|
|
diDev.Unacquire
|
|
End If
|
|
|
|
DoEvents
|
|
End
|
|
End Sub
|
|
|
|
Private Sub lstJoySticks_Click()
|
|
|
|
|
|
On Local Error Resume Next
|
|
|
|
Call CLRLISTS
|
|
|
|
|
|
'Unacquire the current device
|
|
'if we are holding a device
|
|
If Not diDev Is Nothing Then
|
|
diDev.Unacquire
|
|
End If
|
|
|
|
'Create the joystick device
|
|
Set diDev = Nothing
|
|
Set diDev = di.CreateDevice(diDevEnum.GetItem(lstJoySticks.ListIndex + 1).GetGuidInstance)
|
|
diDev.SetCommonDataFormat DIFORMAT_JOYSTICK
|
|
diDev.SetCooperativeLevel Me.hWnd, DISCL_BACKGROUND Or DISCL_NONEXCLUSIVE
|
|
|
|
' Find out what device objects it has
|
|
diDev.GetCapabilities joyCaps
|
|
Call IdentifyAxes(diDev)
|
|
|
|
' Ask for notification of events
|
|
Call diDev.SetEventNotification(EventHandle)
|
|
|
|
' Set deadzone for X and Y axis to 10 percent of the range of travel
|
|
With DiProp_Dead
|
|
.lData = 1000
|
|
.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 zones for X and Y axis to 5 percent of the range
|
|
With DiProp_Saturation
|
|
.lData = 9500
|
|
.lHow = DIPH_BYOFFSET
|
|
|
|
.lObj = DIJOFS_X
|
|
diDev.SetProperty "DIPROP_SATURATION", DiProp_Saturation
|
|
|
|
.lObj = DIJOFS_Y
|
|
diDev.SetProperty "DIPROP_SATURATION", DiProp_Saturation
|
|
|
|
End With
|
|
|
|
SetPropRange
|
|
|
|
|
|
diDev.Acquire
|
|
Me.Caption = "Joystick Sample: Querying Properties"
|
|
|
|
' Get the list of current properties
|
|
' USB joysticks wont call this callback until you play with the joystick
|
|
' so we call the callback ourselves the first time
|
|
DirectXEvent8_DXCallback 0
|
|
|
|
' Poll the device so that events are sure to be signaled.
|
|
' Usually this would be done in Sub Main or in the game rendering loop.
|
|
|
|
While running = True
|
|
DoEvents
|
|
diDev.Poll
|
|
Wend
|
|
End Sub
|
|
|
|
Sub SetPropRange()
|
|
' NOTE Some devices do not let you set the range
|
|
On Local Error Resume Next
|
|
|
|
' Set range for all axes
|
|
With DiProp_Range
|
|
.lHow = DIPH_DEVICE
|
|
.lMin = 0
|
|
.lMax = 10000
|
|
End With
|
|
diDev.SetProperty "DIPROP_RANGE", DiProp_Range
|
|
End Sub
|
|
|
|
Sub CLRLISTS()
|
|
lstJoyAxis.Clear
|
|
lstButton.Clear
|
|
lstHat.Clear
|
|
End Sub
|
|
|
|
Sub IdentifyAxes(diDev As DirectInputDevice8)
|
|
|
|
' It's not enough to count axes; we need to know which in particular
|
|
' are present.
|
|
|
|
Dim didoEnum As DirectInputEnumDeviceObjects
|
|
Dim dido As DirectInputDeviceObjectInstance
|
|
Dim i As Integer
|
|
|
|
For i = 1 To 8
|
|
AxisPresent(i) = False
|
|
Next
|
|
|
|
' Enumerate the axes
|
|
Set didoEnum = diDev.GetDeviceObjectsEnum(DIDFT_AXIS)
|
|
|
|
' Check data offset of each axis to learn what it is
|
|
Dim sGuid As String
|
|
For i = 1 To didoEnum.GetCount
|
|
|
|
Set dido = didoEnum.GetItem(i)
|
|
|
|
sGuid = dido.GetGuidType
|
|
Select Case sGuid
|
|
Case "GUID_XAxis"
|
|
AxisPresent(1) = True
|
|
Case "GUID_YAxis"
|
|
AxisPresent(2) = True
|
|
Case "GUID_ZAxis"
|
|
AxisPresent(3) = True
|
|
Case "GUID_RxAxis"
|
|
AxisPresent(4) = True
|
|
Case "GUID_RyAxis"
|
|
AxisPresent(5) = True
|
|
Case "GUID_RzAxis"
|
|
AxisPresent(6) = True
|
|
Case "GUID_Slider"
|
|
AxisPresent(8) = True
|
|
AxisPresent(7) = True
|
|
End Select
|
|
|
|
Next
|
|
End Sub
|
|
|
|
|