Approche de la gestion de joystick pour un jeu simplifié et pas optimisé
Source / Exemple :
Option Explicit
Private Declare Function joyGetDevCaps Lib "winmm.dll" Alias "joyGetDevCapsA" (ByVal id As Long, lpCaps As JOYCAPS, ByVal uSize As Long) As Long
Private Declare Function joyGetPos Lib "winmm.dll" (ByVal uJoyID As Long, pji As JOYINFO) As Long
Const MAXPNAMELEN = 32
Private Type JOYCAPS
wMid As Integer
wPid As Integer
szPname As String * MAXPNAMELEN
wXmin As Long
wXmax As Long
wYmin As Long
wYmax As Long
wZmin As Long
wZmax As Long
wNumButtons As Long
wPeriodMin As Long
wPeriodMax As Long
End Type
Private Type JOYINFO
wXpos As Long
wYpos As Long
wZpos As Long
wButtons As Long
End Type
'Constante d'erreur de l'api
Const JOYERR_NOERROR = 0
Const JOYERR_BASE As Long = 160
Const JOYERR_UNPLUGGED As Long = (JOYERR_BASE + 7)
Const MMSYSERR_BASE As Long = 0
Const MMSYSERR_NODRIVER As Long = (MMSYSERR_BASE + 6)
Const MMSYSERR_INVALPARAM As Long = (MMSYSERR_BASE + 11)
Const JOYSTICK1 As Long = &H0
Const JOYSTICK2 As Long = &H1
Const JOY_BUTTON1 = &H1
Const JOY_BUTTON10 = &H200&
Const JOY_BUTTON2 = &H2
Const JOY_BUTTON2CHG = &H200
Const JOY_BUTTON3 = &H4
Const JOY_BUTTON3CHG = &H400
Const JOY_BUTTON4 = &H8
Const JOY_BUTTON4CHG = &H800
Const JOY_BUTTON5 = &H10&
Const JOY_BUTTON6 = &H20&
Const JOY_BUTTON7 = &H40&
Const JOY_BUTTON8 = &H80&
Const JOY_BUTTON9 = &H100&
'Flag de fin de la boucle de jeux
Dim loopEnd As Boolean
'Variable pr conserver les bornes
Dim MaxX As Long
Dim MaxY As Long
Dim MinX As Long
Dim MinY As Long
'Position relative Joystick => fenetre
Dim RelativeX As Long
Dim RelativeY As Long
Dim lgCurseur As Long
Dim htCurseur As Long
Dim HalflgCurseur As Long
Dim HalfhtCurseur As Long
Dim nbButton As Long
Private Sub Form_Load()
Dim rt As Long
Dim JoyTestInfo As JOYINFO
Dim JoyStickCaps As JOYCAPS
'Connexion Ok ?
rt = joyGetPos(JOYSTICK1, JoyTestInfo)
'gestion des ERR
If rt <> JOYERR_NOERROR Then
If rt = JOYERR_UNPLUGGED Then
MsgBox "Joystick non présent" & vbCrLf & "Fin de l'application..."
ElseIf rt = MMSYSERR_NODRIVER Then
MsgBox "Pilote non installé" & vbCrLf & "Fin de l'application..."
Else
MsgBox "Erreur Inconnue" & vbCrLf & "Fin de l'application..."
End If
Unload Me
Exit Sub
End If
'Recupere les position Minimum et Maximum du peripherique
joyGetDevCaps JOYSTICK1, JoyStickCaps, Len(JoyStickCaps)
'Attrib des bornes
With JoyStickCaps
MaxX = .wXmax
MinX = .wXmin
MaxY = .wYmax
MinY = .wYmin
End With
nbButton = JoyStickCaps.wNumButtons 'nb bouttons
frmBB.Caption = nbButton & " bouttons sur le Joystick "
lblInfo.Caption = JoyStickCaps.szPname 'nom de drv
Dim nextL As Integer
Dim nextH As Integer
nextL = pctB(0).Left + pctB(0).Width + 10 'decalage boutons
nextH = pctB(0).Top
Dim i As Integer
'Création des bouttons
For i = 1 To nbButton - 1
Load pctB(i)
pctB(i).Left = nextL
pctB(i).Top = nextH
nextL = pctB(i).Left + pctB(i).Width + 10
pctB(i).Visible = True
Next i
RunLoop
End Sub
Private Sub Form_Resize()
'Valeurs relative en fonction de la taille de la PCTB
RelativeX = MaxX / pctJOY.ScaleWidth
RelativeY = MaxY / pctJOY.ScaleHeight
End Sub
Private Sub Form_Unload(Cancel As Integer)
'Terminaison appli
loopEnd = True
End Sub
Private Sub RunLoop()
Dim X As Long, Y As Long
Dim JoyInformation As JOYINFO
Me.Show
'Boucle primaire de Jeux
Do
pctJOY.Cls
joyGetPos JOYSTICK1, JoyInformation 'Recuperation Etats
X = (JoyInformation.wXpos / RelativeX) - HalflgCurseur 'Recup position
Y = (JoyInformation.wYpos / RelativeY) - HalfhtCurseur
Dim i As Integer
For i = 0 To pctB.Count - 1 'Reset des boutons
pctB(i).BackColor = &H8000000F
Next i
Call calc(JoyInformation.wButtons) 'Afficahge des bouttons
shCtrlPos.Left = X - shCtrlPos.Width / 2 'Position du shape
shCtrlPos.Top = Y - shCtrlPos.Height / 2
pctJOY.Refresh
DoEvents
Loop Until loopEnd
End Sub
Private Sub calc(nb As Long)
'Fonction pour le mutli-boutonning pour les hardcore gamers :)
Dim incr, temp, i As Long
incr = 1024
temp = 0
i = 11
Do
If incr <= nb Then
temp = nb \ incr
nb = nb - incr
End If
If CBool(temp) Then pctB(i - 1).BackColor = vbRed
temp = 0
incr = incr / 2
i = i - 1
Loop While incr >= 1
End Sub
Conclusion :
Gestion pas optimisée , cela reste une approche, les codeurs de games vous enflammez pas pour OpengL et Directx c bcp plus travaillé :)
Vous n'êtes pas encore membre ?
inscrivez-vous, c'est gratuit et ça prend moins d'une minute !
Les membres obtiennent plus de réponses que les utilisateurs anonymes.
Le fait d'être membre vous permet d'avoir un suivi détaillé de vos demandes et codes sources.
Le fait d'être membre vous permet d'avoir des options supplémentaires.