Tipp 0196 DirectInput - GamePad & Joystick
Autor/Einsender:
Datum:
  Alexander Csadek
01.04.2002
Entwicklungsumgebung:
DirectX-Version:
  VB 6
DirectX 7
Mit DirectInput ist es einfach, dem User die Möglichkeit zu geben, das Spiel mit einem GamePad oder Joystick zu steuern, da alle DirectX-fähigen Eingabegeräte, vom GamePad bis zum FlightStick usw. unterstützt werden.
In der Regel haben GamePads und Joysticks eine X- und Y-Achse, und eine Reihe von Buttons. Da die Anzahl der Buttons variiert, sollte man deshalb die Anzahl immer einlesen. Die Achsen liefern im Ruhezustand (Mittelpunkt) den Wert 32768 und nicht 0.
Dieser Tipp zeigt auf einfache Weise, wie man sich die wichtigsten Informationen und Daten von einem GamePad bzw. Joystick in sein Spiel holt.
 
Option Explicit

Dim DX As New DirectX7
Dim DI As DirectInput
Dim diJoystick() As DirectInputDevice
Dim JSButton() As Single
Dim Button() As Long

Const JOYSTICKCENTERED = 32768

Public Function DInput_Init() As Boolean
  Dim Caps As DIDEVCAPS
  Dim diEnumObjects As DirectInputEnumDeviceObjects
  Dim enumDevice As DirectInputEnumDevices
  Dim i As Single

  On Error GoTo ErrEnd

  Set DI = DX.DirectInputCreate()

  Set enumDevice = _
      DI.GetDIEnumDevices(DIDEVTYPE_JOYSTICK, DIEDFL_ATTACHEDONLY)

  If enumDevice.GetCount = 0 Then
    MsgBox "Es sind keine Joysticks am PC angeschlossen.", _
          vbInformation
    Exit Function
  End If

  frmMain.lst_Liste.Clear
  ReDim diJoystick(enumDevice.GetCount) As DirectInputDevice
  ReDim JSButton(enumDevice.GetCount) As Single

  For i = 1 To enumDevice.GetCount
    Set diJoystick(i) = _
        DI.CreateDevice(enumDevice.GetItem(i).GetGuidInstance)
    frmMain.lst_Liste.AddItem enumDevice.GetItem(i).GetProductName
    diJoystick(i).SetCommonDataFormat DIFORMAT_JOYSTICK
    diJoystick(i).SetCooperativeLevel frmMain.hWnd, _
          DISCL_BACKGROUND Or DISCL_EXCLUSIVE
    diJoystick(i).GetCapabilities Caps

    If Caps.lFlags Then
      Set diEnumObjects = _
            diJoystick(i).GetDeviceObjectsEnum(DIDFT_BUTTON)
      JSButton(i) = diEnumObjects.GetCount
      ReDim Button(i, diEnumObjects.GetCount)
      diJoystick(i).Acquire
      diJoystick(i).Poll
      Set diEnumObjects = Nothing
    End If
  Next i

  DInput_Init = True
  Exit Function

ErrEnd:
  MsgBox "Direct Input konnte nicht initialisiert werden!" & _
         vbCr & "Anwendung wird beendet.", vbExclamation
  DInput_Init = False
End Function

Public Sub CheckInput()
  Dim JoystickState As DIJOYSTATE
  Dim i As Single
  Dim strhilf As String

  On Error Resume Next

  diJoystick(frmMain.lst_Liste.ListIndex + 1).Acquire
  diJoystick(frmMain.lst_Liste.ListIndex + 1).Poll
  diJoystick(frmMain.lst_Liste.ListIndex + 1).GetDeviceState _
        Len(JoystickState), JoystickState

  frmMain.txt_XY.Text = _
      "X: " & (JoystickState.x - JOYSTICKCENTERED) & vbCrLf & _
      "Y: " & (JoystickState.y - JOYSTICKCENTERED) & vbCrLf & _
      "Z: " & (JoystickState.z - JOYSTICKCENTERED)

  frmMain.txt_Buttons.Text = ""
  For i = 1 To JSButton(frmMain.lst_Liste.ListIndex + 1)
      strhilf = "Nein"
      If JoystickState.buttons(i - 1) > 0 Then strhilf = "Ja"
      frmMain.txt_Buttons.Text = frmMain.txt_Buttons.Text & _
          "Button " & i & " : " & strhilf & vbCrLf
  Next i
End Sub

Public Sub DInput_ControlPanel()
  DI.RunControlPanel frmMain.hWnd
End Sub

Public Sub DInput_Kill()
  Dim i As Single

  If frmMain.lst_Liste.ListCount > 0 Then
    For i = 1 To frmMain.lst_Liste.ListCount
      Set diJoystick(i) = Nothing
    Next i
  End If

  Set DI = Nothing
  Set DX = Nothing
End Sub
 
Weitere Links zum Thema
DirectInput - Maus
DirectInput - Tastatur
Hinweis
Um dieses Beispiel ausführen zu können, wird die DirectX 7 for Visual Basic Type Library benötigt (siehe dazu die Erläuterungen in der DirectX-Rubrik).

Windows-Version
95
98/SE
ME
NT
2000
XP
Vista
Win 7
VB-Version
VBA 5
VBA 6
VB 4/16
VB 4/32
VB 5
VB 6


Download  (3,7 kB) Downloads bisher: [ 3938 ]

Vorheriger Tipp Zum Seitenanfang Nächster Tipp

Startseite | Projekte | Tutorials | API-Referenz | VB-/VBA-Tipps | Komponenten | Bücherecke | VB/VBA-Forum | VB.Net-Forum | DirectX-Forum | Foren-Archiv | DirectX | VB.Net-Tipps | Chat | Spielplatz | Links | Suchen | Stichwortverzeichnis | Feedback | Impressum

Seite empfehlen Bug-Report
Letzte Aktualisierung: Donnerstag, 22. September 2011