Startseite / Tipps / VB 5/6-Tipp 0459: Joystickabfrage ohne DirectX

VB 5/6-Tipp 0459: Joystickabfrage ohne DirectX

 von Michael Gieser

'Dieser Quellcode stammt von http://www.activevb.de
'und kann frei verwendet werden. Für eventuelle Schäden
'wird nicht gehaftet.

'Um Fehler oder Fragen zu klären, nutzen Sie bitte unser Forum.
'Ansonsten viel Spaß und Erfolg mit diesem Source!

'------------- Anfang Projektdatei Projekt1.vbp -------------
'-------- Anfang Formular "Form1" alias joystick.frm --------
' Steuerelement: Timersteuerelement "Timer1"
Option Explicit

Private Const JOY_BUTTON1 As Long = &H1&
Private Const JOY_BUTTON2 As Long = &H2&
Private Const JOY_BUTTON3 As Long = &H4&
Private Const JOY_BUTTON4 As Long = &H8&

Private Const JOYERR_BASE As Long = 160&
Private Const JOYERR_NOERROR As Long = 0&
Private Const JOYERR_NOCANDO As Long = (JOYERR_BASE + 6&)
Private Const JOYERR_PARMS As Long = (JOYERR_BASE + 5&)
Private Const JOYERR_UNPLUGGED As Long = (JOYERR_BASE + 7&)

Private Const MAXPNAMELEN As Long = 32&

Private Const JOYSTICKID1 As Long = 0&
Private Const JOYSTICKID2 As Long = 1&

Private Type JOYINFO
    X As Long
    Y As Long
    Z As Long
    Buttons As Long
End Type

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 Declare Function joyGetDevCaps Lib "winmm.dll" _
                         Alias "joyGetDevCapsA" ( _
                         ByVal id As Long, _
                         lpCaps As JOYCAPS, _
                         ByVal uSize As Long) As Long
                         
Private Declare Function joyGetNumDevs Lib "winmm.dll" () As Long

Private Declare Function joyGetPos Lib "winmm.dll" ( _
                         ByVal uJoyID As Long, _
                         pji As JOYINFO) As Long

Private Function GetJoyMax(ByVal joy As Integer, JI As JOYINFO) As Boolean
    Dim jc As JOYCAPS
    If joyGetDevCaps(joy, jc, Len(jc)) <> JOYERR_NOERROR Then
        GetJoyMax = False
    Else
        JI.X = jc.wXmax
        JI.Y = jc.wYmax
        JI.Z = jc.wZmax
        JI.Buttons = jc.wNumButtons
        GetJoyMax = True
    End If
End Function

Private Function GetJoyMin(ByVal joy As Integer, JI As JOYINFO) As Boolean
    Dim jc As JOYCAPS
    If joyGetDevCaps(joy, jc, Len(jc)) <> JOYERR_NOERROR Then
        GetJoyMin = False
    Else
        JI.X = jc.wXmin
        JI.Y = jc.wYmin
        JI.Z = jc.wZmin
        JI.Buttons = jc.wNumButtons
        GetJoyMin = True
    End If
End Function

Private Function GetJoystick(ByVal joy As Integer, JI As JOYINFO) As Boolean
    If joyGetPos(joy, JI) <> JOYERR_NOERROR Then
        GetJoystick = False
    Else
        GetJoystick = True
    End If
End Function

Private Function IsJoyPresent(Optional IsConnected As Variant) As Long
    Dim ic As Boolean
    Dim i As Long
    Dim j As Long
    Dim ret As Long
    Dim JI As JOYINFO
    ic = IIf(IsMissing(IsConnected), True, CBool(IsConnected))
    i = joyGetNumDevs
    If ic Then
        j = 0
        Do While i > 0
            i = i - 1
            If joyGetPos(i, JI) = JOYERR_NOERROR Then
                j = j + 1
            End If
        Loop
        IsJoyPresent = j
    Else
        IsJoyPresent = i
    End If
End Function

Private Sub Timer1_Timer()
    Dim JInfo As JOYINFO
    Me.Cls
    Me.Print "Joysticks ID    :" + Str$(IsJoyPresent(False))
    Me.Print "Joysticks found :" + Str$(IsJoyPresent(True))
    GetJoyMax JOYSTICKID1, JInfo
    Me.Print "Max X :" + Str$(JInfo.X)
    Me.Print "Max Y :" + Str$(JInfo.Y)
    '    Me.Print "Max Z:" + Str$(JInfo.Z)
    GetJoyMin JOYSTICKID1, JInfo
    Me.Print "Min X :" + Str$(JInfo.X)
    Me.Print "Min Y :" + Str$(JInfo.Y)
    '    Me.Print "Min Z:" + Str$(JInfo.Z)
    Me.Print "Buttons   :" + Str$(JInfo.Buttons)
    GetJoystick JOYSTICKID1, JInfo
    Me.Print "Button    :" + Str$(JInfo.Buttons)
    Me.Print "Current X :" + Str$(JInfo.X)
    Me.Print "Current Y :" + Str$(JInfo.Y)
End Sub

'--------- Ende Formular "Form1" alias joystick.frm ---------
'-------------- Ende Projektdatei Projekt1.vbp --------------

Tipp-Kompatibilität:

Windows/VB-Version	Win32s	Win95	Win98	WinME	WinNT4	Win2000	WinXP
VB4
VB5
VB6

Hat dieser Tipp auf Ihrem Betriebsystem und mit Ihrer VB-Version funktioniert?

Ja, funktioniert!

Nein, funktioniert nicht bei mir!

VB-Version: VB6 VB5 VB4

Windows-Version: Windows XP Windows 2000 Windows NT4 Windows Me Windows 98 Windows 95 Win32s

Archivierte Nutzerkommentare 

Klicken Sie diesen Text an, wenn Sie die 11 archivierten Kommentare ansehen möchten.
Diese stammen noch von der Zeit, als es noch keine direkte Forenunterstützung für Fragen und Kommentare zu einzelnen Artikeln gab.
Aus Gründen der Vollständigkeit können Sie sich die ausgeblendeten Kommentare zu diesem Artikel aber gerne weiterhin ansehen.

Private Const JOYSTICKID1 As Long = 0&
Private Const JOYSTICKID2 As Long = 1&
Private Const JOYSTICKID3 As Long = 2&
Private Const JOYSTICKID4 As Long = 3&
Private Const JOYSTICKID5 As Long = 4&
Private Const JOYSTICKID6 As Long = 5&
Private Const JOYSTICKID7 As Long = 6&
Private Const JOYSTICKID8 As Long = 7&

Private Const JOY_BUTTON1 As Long = &H1
Private Const JOY_BUTTON10 As Long = &H200&
Private Const JOY_BUTTON11 As Long = &H400&
Private Const JOY_BUTTON12 As Long = &H800&
Private Const JOY_BUTTON13 As Long = &H1000&
Private Const JOY_BUTTON14 As Long = &H2000&
Private Const JOY_BUTTON15 As Long = &H4000&
Private Const JOY_BUTTON16 As Long = &H8000&
Private Const JOY_BUTTON17 As Long = &H10000
Private Const JOY_BUTTON18 As Long = &H20000
Private Const JOY_BUTTON19 As Long = &H40000
Private Const JOY_BUTTON20 As Long = &H80000
Private Const JOY_BUTTON3 As Long = &H4
Private Const JOY_BUTTON4 As Long = &H8
Private Const JOY_BUTTON5 As Long = &H10&
Private Const JOY_BUTTON6 As Long = &H20&
Private Const JOY_BUTTON7 As Long = &H40&
Private Const JOY_BUTTON8 As Long = &H80&
Private Const JOY_BUTTON9 As Long = &H100&

Const MAXPNAMELEN = 32
Const MAX_JOYSTICKOEMVXDNAME = 260

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
    wRmin As Long
    wRmax As Long
    wUmin As Long
    wUmax As Long
    wVmin As Long
    wVmax As Long
    wCaps As Long
    wMaxAxes As Long
    wNumAxes As Long
    wMaxButtons As Long
    szRegKey As String * MAXPNAMELEN
    szOEMVxD As String * MAX_JOYSTICKOEMVXDNAME
End Type