by Adam M. Denoon (1 Submission)
Category: Games
Compatability: VB 6.0
Difficulty: Unknown Difficulty
Originally Published: Sun 5th December 2004
Date Added: Mon 8th February 2021
Rating:
(1 Votes)
Use a joystick in your VB App. You can use it for anything, INCLUDING moving the mouse. This is my first time submitting code to VBCode.com.
API Declarations
Option Explicit
Dim dx As New DirectX8
Dim di As DirectInput8
Dim diDev As DirectInputDevice8
Dim diDevEnum As DirectInputEnumDevices8
Dim joyCaps As DIDEVCAPS
Dim js As DIJOYSTATE
Dim xPos, yPos As Integer
Dim ixpos, iypos As Integer
Dim running As Boolean
Dim DiProp_Dead As DIPROPLONG
Dim DiPRop_Range As DIPROPRANGE
Dim DiProp_Saturation As DIPROPLONG
Private Sub cmdInitialize_Click()
'Set Direct X controls...If you want more documentation, email me at my hotmail inbox.
Set di = dx.DirectInputCreate
Set diDevEnum = di.GetDIDevices(DI8DEVCLASS_GAMECTRL, DIEDFL_ATTACHEDONLY)
Set diDev = di.CreateDevice(diDevEnum.GetItem(1).GetGuidInstance)
diDev.SetCommonDataFormat DIFORMAT_JOYSTICK
diDev.GetCapabilities joyCaps
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
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
With DiPRop_Range
.lHow = DIPH_DEVICE
.lMin = 0
.lMax = 10000
End With
diDev.SetProperty "DIPROP_RANGE", DiPRop_Range
diDev.Acquire
callback
End Sub
Private Sub Form_Load()
'Set values to zero
xPos = 0
yPos = 0
ixpos = 0
iypos = 0
Me.Move xPos, yPos
imgPict.Move ixpos, iypos
'Start input loop
running = True
End Sub
Private Sub Form_Unload(Cancel As Integer)
'Stop calling input
running = False
End Sub
Public Sub callback()
'This sub is for input
While running = True
diDev.GetDeviceStateJoystick js
'THIS CODE IS FOR THE D-PAD (OR STICK) IT MOVES THE FORM!!!
Select Case js.x
Case 0
If Not xPos < 0 Then xPos = xPos - 1
Case 10000
xPos = xPos + 1
End Select
Select Case js.y
Case 0
If Not yPos < 0 Then yPos = yPos - 1
Case 10000
yPos = yPos + 1
End Select
'YOU MAY CHANGE THIS CODE.....THIS CODE IS FOR THE BUTTONS.....IT MOVES THE IMAGE!!!!
If js.Buttons(0) Then 'DOWN (Button 0)
iypos = iypos + 1
ElseIf js.Buttons(3) Then 'UP (Button 3)
iypos = iypos - 1
ElseIf js.Buttons(1) Then 'Right (Button 1)
ixpos = ixpos + 1
ElseIf js.Buttons(2) Then 'Left (Button 2)
ixpos = ixpos - 1
ElseIf js.Buttons(4) Then 'Zoom out (Button 4)
imgPict.Width = imgPict.Width - 1
imgPict.Height = imgPict.Height - 1
ElseIf js.Buttons(5) Then 'Zoom In (Button 5)
imgPict.Width = imgPict.Width + 1
imgPict.Height = imgPict.Height + 1
End If
Me.Move xPos, yPos
imgPict.Move ixpos, iypos
'Keep from freezing!!! (Sounds like something you would find on a liquid container
DoEvents
Wend
End Sub
'Please email me before you use my code for sale purposes
'Martin Sykes is my hero ;)
No comments have been posted about Use a joystick in your VB App. You can use it for anything, INCLUDING moving the mouse. This is my . Why not be the first to post a comment about Use a joystick in your VB App. You can use it for anything, INCLUDING moving the mouse. This is my .