![]() |
Tipp 0042
|
DirectInput - Maus
|
 |
|
Autor/Einsender: Datum: |
|
Jack Hoxley 27.04.2001 |
|
Entwicklungsumgebung:
DirectX-Version: |
|
VB 6
DirectX 7 |
|
|
Dieses Beispiel zeigt alle Möglichkeiten der Maussteuerung mittels
DirectInput. So kann u.a. die Cursorgeschwindigkeit vorgegeben, die
einzelnen Maus-Tasten abgefragt und der Mausbereich eingeschränkt und
wieder aufgehoben werden. Auch die Positionsabfrage wird anschaulich
dargestellt.
|
Der Autor hat den Quellcode im Download-Beispiel vorbildlich kommentiert.
|
|
Code im Codebereich des Moduls |
|
|
Option Explicit
Implements DirectXEvent
Dim DX As New DirectX7
Dim DI As DirectInput
Dim DIDev As DirectInputDevice
Dim CursorX As Long
Dim CursorY As Long
Const BufferSize = 10
Dim Button_0 As Boolean
Dim Button_1 As Boolean
Dim Button_2 As Boolean
Dim Button_3 As Boolean
Dim EventHandle As Long
Dim NotActive As Boolean
Private Declare Function GetCursorPos Lib "user32" (lpPoint _
As POINTAPI) As Long
Private Declare Function SetCursorPos Lib "user32" (ByVal X _
As Long, ByVal Y As Long) As Long
Private Declare Function ScreenToClient Lib "user32" (ByVal hWnd _
As Long, lpPoint As POINTAPI) As Long
Private Declare Function ClientToScreen Lib "user32" (ByVal hWnd _
As Long, lpPoint As POINTAPI) As Long
Private Type POINTAPI
X As Long
Y As Long
End Type
Sub AquireMouse()
Dim CursorCoord As POINTAPI
Call GetCursorPos(CursorCoord)
Call ScreenToClient(hWnd, CursorCoord)
On Error GoTo AQUIREERROR
DIDev.Acquire
CursorX = CursorCoord.X
CursorY = CursorCoord.Y
UpdateCursor
imgCursor.Visible = True
On Error GoTo 0
Exit Sub
AQUIREERROR:
Exit Sub
End Sub
Sub CleanUp()
Dim m_point As POINTAPI
imgCursor.Visible = False
DIDev.Unacquire
m_point.X = CursorX
m_point.Y = CursorY
Call ClientToScreen(hWnd, m_point)
Call SetCursorPos(m_point.X, m_point.Y)
End Sub
Sub Initialise()
CursorX = Me.ScaleWidth \ 2
CursorY = Me.ScaleHeight \ 2
Call UpdateToolBox
Set DI = DX.DirectInputCreate
Set DIDev = DI.CreateDevice("GUID_SYSMOUSE")
Call DIDev.SetCommonDataFormat(DIFORMAT_MOUSE)
Call DIDev.SetCooperativeLevel(Me.hWnd, DISCL_FOREGROUND Or _
DISCL_EXCLUSIVE)
Dim Property As DIPROPLONG
Property.lHow = DIPH_DEVICE
Property.lObj = 0
Property.lData = BufferSize
Property.lSize = Len(Property)
Call DIDev.SetProperty("DIPROP_BUFFERSIZE", Property)
EventHandle = DX.CreateEvent(Me)
Call DIDev.SetEventNotification(EventHandle)
AquireMouse
End Sub
Sub UpdateCursor()
If CursorX < 0 Then CursorX = 0
If CursorX >= Me.ScaleWidth Then CursorX = Me.ScaleWidth - 1
If CursorY < 0 Then CursorY = 0
If CursorY >= Me.ScaleHeight Then CursorY = Me.ScaleHeight - 1
imgCursor.Left = CursorX
imgCursor.Top = CursorY
End Sub
Sub UpdateToolBox()
Form2.lblX.Caption = "CurrentX: " & CStr(CursorX)
Form2.lblY.Caption = "CurrentY: " & CStr(CursorY)
Form2.lblButton0.Caption = "Button 0: " & CStr(Button_0)
Form2.lblButton1.Caption = "Button 1: " & CStr(Button_1)
Form2.lblButton2.Caption = "Button 2: " & CStr(Button_2)
Form2.lblButton3.Caption = "Button 3: " & CStr(Button_3)
End Sub
Private Sub DirectXEvent_DXCallback(ByVal eventid As Long)
Dim DIDeviceData(1 To BufferSize) As DIDEVICEOBJECTDATA
Dim NumItems As Integer
Dim i As Integer
Static OldSequence As Long
On Error GoTo INPUTLOST
NumItems = DIDev.GetDeviceData(DIDeviceData, 0)
On Error GoTo 0
For i = 1 To NumItems
Select Case DIDeviceData(i).lOfs
Case DIMOFS_X
CursorX = CursorX + DIDeviceData(i).lData * _
Form2.scrlSpeed.Value
If OldSequence <> DIDeviceData(i).lSequence Then
UpdateCursor
OldSequence = DIDeviceData(i).lSequence
Else
OldSequence = 0
End If
Case DIMOFS_Y
CursorY = CursorY + DIDeviceData(i).lData * _
Form2.scrlSpeed.Value
If OldSequence <> DIDeviceData(i).lSequence Then
UpdateCursor
OldSequence = DIDeviceData(i).lSequence
Else
OldSequence = 0
End If
Case DIMOFS_BUTTON0
Button_0 = True
If DIDeviceData(i).lData = 0 Then
Button_0 = False
End If
Case DIMOFS_BUTTON1
Button_1 = True
If DIDeviceData(i).lData = 0 Then
Button_1 = False
End If
Case DIMOFS_BUTTON2
Button_2 = True
If DIDeviceData(i).lData = 0 Then
Button_2 = False
End If
Case DIMOFS_BUTTON3
Button_3 = True
If DIDeviceData(i).lData = 0 Then
Button_3 = False
End If
End Select
Next i
UpdateToolBox
Exit Sub
INPUTLOST:
If (Err.Number = DIERR_INPUTLOST) Or (Err.Number = _
DIERR_NOTACQUIRED) Then
CleanUp
Exit Sub
End If
End Sub
Private Sub Form_KeyDown(KeyCode As Integer, Shift As Integer)
Select Case KeyCode
Case vbKeyEscape
NotActive = True
DIDev.Unacquire
CleanUp
Exit Sub
Case vbKeyReturn
NotActive = False
End Select
End Sub
Private Sub Form_Load()
Form2.Show
DoEvents
Initialise
End Sub
Private Sub Form_MouseMove(Button As Integer, Shift As Integer, _
X As Single, Y As Single)
If NotActive = True Then Exit Sub
Dim didevstate As DIMOUSESTATE
On Error GoTo NOTYETACQUIRED
Call DIDev.GetDeviceStateMouse(didevstate)
On Error GoTo 0
Exit Sub
NOTYETACQUIRED:
Call AquireMouse
End Sub
Private Sub Form_Unload(Cancel As Integer)
Unload Form2
If EventHandle <> 0 Then DX.DestroyEvent EventHandle
End Sub
|
|
|
Code im Codebereich von Form2 |
|
|
Private Sub scrlSpeed_Change()
Sensitivity = scrlSpeed.Value
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 (6,4 kB)
|
Downloads bisher: [ 2522 ]
|
|
|