![]() |
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
|
|
|
|
|
|
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: [ 3179 ]
|
|
|