![]() |
Tipp 0169
|
Mausbewegung aufzeichnen und abspielen
|
 |
|
Autor/Einsender: Datum: |
|
Michael Werner 28.11.2001 |
|
Entwicklungsumgebung: |
|
VB 6 |
|
|
Mit Hilfe der API-Funktionen GetCursorPos, GetClipCursor,
ClipCursor und SetCursorPos ist es möglich, die Bewegungen des Maus-Cursors aufzuzeichnen und anschließend wieder ablaufen zu lassen.
|
|
|
Option Explicit
Private Declare Function GetCursorPos Lib "user32" _
(lpPoint As POINTAPI) As Long
Private Declare Function GetClipCursor Lib "user32" _
(lprc As RECT) As Long
Private Declare Function ClipCursor Lib "user32" _
(lpRect As Any) As Long
Private Declare Function SetCursorPos Lib "user32" (ByVal _
X As Long, ByVal Y As Long) As Long
Private Type POINTAPI
X As Long
Y As Long
End Type
Private Type RECT
Left As Long
Top As Long
Right As Long
Bottom As Long
End Type
Private Rechteck As RECT
Private oldRechteck As RECT
Dim RecordlpRect() As POINTAPI
Dim i As Integer
Dim oldX, oldY As Single
Private Sub Form_Load()
Me.DrawWidth = 2
Check1.Value = 1
Check2.Value = 1
GetClipCursor oldRechteck
End Sub
Private Sub Command1_Click()
Record
End Sub
Private Sub Command2_Click()
Play
End Sub
Private Sub Command3_Click()
Me.Cls
ClipCursor oldRechteck
End Sub
Private Sub Command4_Click()
Form_Unload 0
End Sub
Private Sub Form_MouseMove(button%, shift%, X!, Y!)
If Check1.Value = 0 Then
Exit Sub
End If
If Form1.Caption = "Wiedergabe läuft ..." Then
Me.Line (X, Y)-(oldX, oldY), RGB(128, 0, 255)
oldX = X
oldY = Y
End If
End Sub
Private Sub Form_Unload(Cancel As Integer)
ClipCursor oldRechteck
Unload Me
End
End Sub
Private Sub Record()
Select Case Command1.Caption
Case "&Aufnahme"
i = 0
Erase RecordlpRect
Command1.Caption = "&Stop"
Command2.Enabled = False
RecordTimer.Enabled = True
Case "&Stop"
RecordTimer.Enabled = False
Command1.Caption = "&Aufnahme"
Command2.Enabled = True
Form1.Caption = _
"Aufnahme beendet - Klicken Sie auf Wiedergabe"
Command2.SetFocus
End Select
End Sub
Private Sub Play()
RecordTimer.Enabled = True
End Sub
Private Sub RecordTimer_Timer()
Static Ri As Integer
If Command1.Caption = "&Stop" Then
If Check2.Value = 1 Then
CatchMouse
Else
ClipCursor oldRechteck
End If
i = i + 1
ReDim Preserve RecordlpRect(i)
GetCursorPos RecordlpRect(i)
Form1.Caption = "Aufnahme läuft ..."
Else
Form1.Caption = "Wiedergabe läuft ..."
Ri = Ri + 1
If Ri <= i Then
SetCursorPos RecordlpRect(Ri).X, RecordlpRect(Ri).Y
Else
Form1.Caption = "Wiedergabe beendet"
Ri = 0
RecordTimer.Enabled = False
Command1.Caption = "&Aufnahme"
End If
End If
End Sub
Private Sub CatchMouse()
Rechteck.Left = Me.Left / Screen.TwipsPerPixelX
Rechteck.Top = Me.Top / Screen.TwipsPerPixelY
Rechteck.Bottom = (Me.Top + Me.Height) / Screen.TwipsPerPixelY
Rechteck.Right = (Me.Left + Me.Width) / Screen.TwipsPerPixelX
ClipCursor Rechteck
End Sub
|
|
|
|
|
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 (2,8 kB)
|
Downloads bisher: [ 4025 ]
|
|
|