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
 
Weitere Links zum Thema
Zeichnen mit der Maus
Mausklick simulieren

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: [ 4018 ]

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: Samstag, 24. September 2011