Die Community zu .NET und Classic VB.
Menü

VB 5/6-Tipp 0524: Joystikbewegungen abfangen und auswerten

 von 

Beschreibung 

Mit Hilfe von 3 API-Aufrufen ist es ganz einfach möglich, in ein Spiel den JoyStick zu integrieren

Schwierigkeitsgrad:

Schwierigkeitsgrad 2

Verwendete API-Aufrufe:

joyGetPosEx, joyReleaseCapture, joySetCapture

Download:

Download des Beispielprojektes [4,14 KB]

'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 Project1.vbp -------------
'--------- Anfang Formular "Form1" alias Form1.frm  ---------
' Steuerelement: Rahmensteuerelement "Frame1"
' Steuerelement: Beschriftungsfeld "lblY" auf Frame1
' Steuerelement: Beschriftungsfeld "lblX" auf Frame1
' Steuerelement: Beschriftungsfeld "Label1" auf Frame1
' Steuerelement: Anzeige-Steuerelement "Image1" (Index von 0 bis 3) auf Frame1
' Steuerelement: Schaltfläche "Command1"
' Steuerelement: Bildfeld-Steuerelement "Picture1"
' Steuerelement: Anzeige-Steuerelement "imgJoy" auf Picture1
' Steuerelement: Timersteuerelement "Timer1"
' Steuerelement: Beschriftungsfeld "Label2"
' Steuerelement: Anzeige-Steuerelement "Image2"
' Steuerelement: Anzeige-Steuerelement "imgOff"
' Steuerelement: Anzeige-Steuerelement "imgOn"
' Steuerelement: Beschriftungsfeld "Label8"


' Copyright ST-software
' 08/2002
' http://www.st-software.at
'
' mailto:st-software@eunet.at
'
' Um die Position auszuwerten, genügt es die myJoy.dwX und .dwY Position
' abzufragen. Einer Verwendung für eigene Spiele steht nichts mehr im
' Weg...

Private Type JOYINFOEX
        dwSize As Long
        dwFlags As Long
        dwXpos As Long
        dwYpos As Long
        dwZpos As Long
        dwRpos As Long
        dwUpos As Long
        dwVpos As Long
        dwButtons As Long
        dwButtonNumber As Long
        dwPOV As Long
        dwReserved1 As Long
        dwReserved2 As Long
End Type

Private Const JOYSTICKID1 = 0
Private Const JOYSTICKID2 = 1
Private Const JOY_POVCENTERED = -1
Private Const JOY_POVFORWARD = 0
Private Const JOY_POVLEFT = 27000
Private Const JOY_POVRIGHT = 9000
Private Const JOY_POVBACKWARD = 18000
Private Const JOY_RETURNX = &H1&
Private Const JOY_RETURNY = &H2&
Private Const JOY_RETURNZ = &H4&
Private Const JOY_RETURNR = &H8&
Private Const JOY_RETURNU = &H10
Private Const JOY_RETURNV = &H20
Private Const JOY_RETURNPOV = &H40&
Private Const JOY_RETURNBUTTONS = &H80&
Private Const JOY_RETURNRAWDATA = &H100&
Private Const JOY_RETURNPOVCTS = &H200&
Private Const JOY_RETURNCENTERED = &H400&
Private Const JOY_USEDEADZONE = &H800&
Private Const JOY_RETURNALL = (JOY_RETURNX Or JOY_RETURNY Or JOY_RETURNZ Or _
    JOY_RETURNR Or JOY_RETURNU Or JOY_RETURNV Or JOY_RETURNPOV Or JOY_RETURNBUTTONS)
Private Const JOY_CAL_READALWAYS = &H10000
Private Const JOY_CAL_READXONLY = &H100000
Private Const JOY_CAL_READ3 = &H40000
Private Const JOY_CAL_READ4 = &H80000
Private Const JOY_CAL_READXYONLY = &H20000
Private Const JOY_CAL_READYONLY = &H200000
Private Const JOY_CAL_READ5 = &H400000
Private Const JOY_CAL_READ6 = &H800000
Private Const JOY_CAL_READZONLY = &H1000000
Private Const JOY_CAL_READRONLY = &H2000000
Private Const JOY_CAL_READUONLY = &H4000000
Private Const JOY_CAL_READVONLY = &H8000000

Private Declare Function joyGetPosEx Lib "winmm.dll" ( _
                         ByVal uJoyID As Long, _
                         pji As JOYINFOEX) As Long
                         
Private Declare Function joyReleaseCapture Lib "winmm.dll" ( _
                         ByVal id As Long) As Long
                         
Private Declare Function joySetCapture Lib "winmm.dll" ( _
                         ByVal hwnd As Long, _
                         ByVal uID As Long, _
                         ByVal uPeriod As Long, _
                         ByVal bChanged As Long) As Long

Private Sub Command1_Click()
    Unload Me
End Sub

Private Sub Form_Load()

    Dim R As Long
    Dim hwnd As Long
    Dim i As Long

    ' Initialisierung
    R = joySetCapture(hwnd, JOYSTICKID1, 1, 0)
    R = joyReleaseCapture(JOYSTICKID1)

    ' Eigene Koordinaten verwenden
    Picture1.Scale (0, 0)-(65535, 65535)

    ' Zuweisung der Bilder an Buttons 1 - 4
    For i = 0 To 3
        Image1(i).Picture = imgOff.Picture
    Next
    Dim MyJoy As JOYINFOEX

End Sub

Private Sub Timer1_Timer()

    Dim MyJoy As JOYINFOEX

    MyJoy.dwSize = 64
    MyJoy.dwFlags = JOY_RETURNALL
    R& = joyGetPosEx(JOYSTICKID1, MyJoy)

    ' Bewege den "Cursor"
    imgJoy.Move _
        MyJoy.dwXpos - imgJoy.Width / 2, _
        MyJoy.dwYpos - imgJoy.Height / 2
    
    ' Anzeige in den Labels (X und Y-Achse)
    lblX.Caption = "X-Achse: " & MyJoy.dwXpos
    lblY.Caption = "Y-Achse: " & MyJoy.dwYpos
    
    Select Case MyJoy.dwButtons
        Case 1 ' Button1
            Image1(0).Picture = imgOn.Picture
        Case 2 ' Button2
            Image1(1).Picture = imgOn.Picture
        Case 4 ' Button3
            Image1(2).Picture = imgOn.Picture
        Case 8 ' Button4
            Image1(3).Picture = imgOn.Picture
        Case Else ' Kein Button gedrückt (0)
            Dim i As Long
            For i = 0 To 3
                Image1(i).Picture = imgOff.Picture
            Next
    End Select
End Sub
'---------- Ende Formular "Form1" alias Form1.frm  ----------
'-------------- Ende Projektdatei Project1.vbp --------------

Tipp-Kompatibilität:

Windows/VB-VersionWin32sWin95Win98WinMEWinNT4Win2000WinXP
VB4
VB5
VB6

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

Ja, funktioniert!

Nein, funktioniert nicht bei mir!

VB-Version:

Windows-Version:

Ihre Meinung  

Falls Sie Fragen zu diesem Artikel haben oder Ihre Erfahrung mit anderen Nutzern austauschen möchten, dann teilen Sie uns diese bitte in einem der unten vorhandenen Themen oder über einen neuen Beitrag mit. Hierzu können sie einfach einen Beitrag in einem zum Thema passenden Forum anlegen, welcher automatisch mit dieser Seite verknüpft wird.

Archivierte Nutzerkommentare 

Klicken Sie diesen Text an, wenn Sie die 2 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.

Kommentar von Alexander am 06.02.2004 um 19:28

Läuft Probelmlos unter 9x
WEer benutz es noch?

Kommentar von VielleichtBasic am 20.04.2003 um 14:43

Läuft zwar... aber es lässt sich immer nur 1 Button registrieren und das VB stürzt nach dem Beenden des Debugmodus ab!