Tipp 0043 DirectInput - Tastatur
Autor/Einsender:
Datum:
  Jack Hoxley
27.04.2001
Entwicklungsumgebung:
DirectX-Version:
  VB 6
DirectX 7
Dieses Beispiel zeigt die Möglichkeiten der Tastatursteuerung mit Auswertung der gedrückten mittels DirectInput.
Der Autor hat den Quellcode im Download-Beispiel vorbildlich kommentiert.
 
Option Explicit

Dim dx As New DirectX7
Dim di As DirectInput
Dim diDEV As DirectInputDevice
Dim diState As DIKEYBOARDSTATE
Dim iKeyCounter As Integer

Implements DirectXEvent

Dim DXEvent As Long

Private Sub DirectXEvent_DXCallback(ByVal eventid As Long)
  If diDEV Is Nothing Then Exit Sub

  On Local Error Resume Next
  diDEV.GetDeviceStateKeyboard diState

  If Err.Number = DIERR_NOTACQUIRED Then
    diDEV.Acquire
  End If

  For iKeyCounter = 0 To 255
    If diState.Key(iKeyCounter) <> 0 Then
      lstKeys.AddItem "Taste " & iKeyCounter & _
          " wurde gedrückt", 0
    End If
  Next

  ' Hier zur Demonstration nur ein Teil des
  ' Tastaturabfragecodes
  If diState.Key(DIK_A) <> 0 Then
    Button(10).Value = True
  Else
    Button(10).Value = False
  End If

  If diState.Key(DIK_B) <> 0 Then
    Button(23).Value = True
  Else
    Button(23).Value = False
  End If

  If diState.Key(DIK_SEMICOLON) <> 0 Then
    Button(27).Value = True
  Else
    Button(27).Value = False
  End If

  If diState.Key(DIK_COMMA) <> 0 Then
    Button(28).Value = True
  Else
    Button(28).Value = False
  End If

  If diState.Key(DIK_PERIOD) <> 0 Then
    Button(29).Value = True
  Else
    Button(29).Value = False
  End If

  If diState.Key(DIK_B) And diState.Key(DIK_LMENU) <> 0 Then
    Unload Me
    Exit Sub
  End If

  DoEvents
  lstKeys.Selected(0) = True
End Sub

Private Sub Form_Load()
  Set di = dx.DirectInputCreate()

  If Err.Number <> 0 Then
     MsgBox "Fehler beim Starten von DirectInput." & vbCrLf & _
        "Bitte installieren Síe DirectX" & _
        " um dieses Beispiel zu testen.", vbApplicationModal
     End
  End If

  Set diDEV = di.CreateDevice("GUID_SysKeyboard")

  diDEV.SetCommonDataFormat DIFORMAT_KEYBOARD
  diDEV.SetCooperativeLevel Me.hWnd, DISCL_BACKGROUND Or _
      DISCL_NONEXCLUSIVE

  Me.Show

  DXEvent = dx.CreateEvent(Me)
  diDEV.SetEventNotification DXEvent

  diDEV.Acquire
End Sub

Private Sub Form_Unload(Cancel As Integer)
  If DXEvent <> 0 Then dx.DestroyEvent (DXEvent)
  diDEV.Unacquire
End Sub

Private Sub tmrKey_Timer()
  dx.SetEvent DXEvent
End Sub
 
Weitere Links zum Thema
DirectInput - Maus
DirectInput - GamePad & Joystick
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  (4,5 kB) Downloads bisher: [ 3097 ]

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: Montag, 29. August 2011