Mausroutinen
[Windows 95/98/NT/2000]

23.07.2001


Verschiedene Mausroutinen,
     zum Beispiel das Bewegen an eine bestimmte Stelle,
     x- und y-Koordinaten ermitteln und Mausklicks simulieren:

   Private Declare Sub mouse_event Lib "user32" _
      (ByVal dwFlags As Long, ByVal dx As Long, _
      ByVal dy As Long, ByVal cButtons As Long, _
      ByVal dwExtraInfo As Long)
   Private Declare Function SetCursorPos Lib "user32" _
      (ByVal x As Long, ByVal y As Long) As Long
   Private Declare Function GetCursorPos Lib "user32" _
      (lpPoint As POINTAPI) As Long
   Private Type POINTAPI
      x As Long
      y As Long
   End Type
   'Mausposition X ermitteln
   Public Function Maus_X() As Long
      Dim n As POINTAPI
      GetCursorPos n
      Maus_X = n.x
   End Function
   'Mausposition Y ermitteln
   Public Function Maus_Y() As Long
      Dim n As POINTAPI
      GetCursorPos n
      Maus_Y = n.y
   End Function
   'Linke Maustaste simulieren
   Public Sub LinksKlick()
      mouse_event &H2, 0, 0, 0, 0
      mouse_event &H4, 0, 0, 0, 0
   End Sub
   'Mittlerer Maustaste simulieren
   Public Sub MiddleClick()
      mouse_event &H20, 0, 0, 0, 0
      mouse_event &H40, 0, 0, 0, 0
   End Sub
   'Rechte Maustaste simulieren
   Public Sub RechtsKlick()
      mouse_event &H8, 0, 0, 0, 0
      mouse_event &H10, 0, 0, 0, 0
   End Sub
   'Maus nach x,y bewegen
   Public Sub MausBewegen(x As Long, y As Long)
      SetCursorPos x, y
   End Sub
     Eine oft gestellte Frage:
     Mausklicks systemweit abfangen:
   Private Declare Function GetAsyncKeyState Lib "user32" _
      (ByVal vKey As Long) As Integer
   If GetAsyncKeyState(&H1) Then ... 'links
   If GetAsyncKeyState(&H2) Then ... 'rechts


    
Und hier noch ein kleiner "Gag",
      kreisförmiges Bewegen des Mauszeigers:

   Private Sub DegreesToXY(CenterX As Long, CenterY As Long, _
      Winkel As Double, RadiusX As Long, RadiusY As Long)
      Dim convert As Double
      Dim x As Long
      Dim y As Long
      convert = 3.141593 / 180
      x = CenterX - (Sin(-Winkel * convert) * RadiusX)
      y = CenterY - (Sin((90 + (Winkel)) * convert) * RadiusY)
      MausBewegen x, y
      Sleep 0.009
   End Sub
   Private Sub Sleep(Sekunden As Double)
      Dim tmp As Double
      tmp = Timer
      Do While Timer - tmp < Sekunden
         DoEvents
         If Timer < tmp Then tmp = tmp - 24# * 3600#
      Loop
   End Sub
   Public Sub Kreisbewegung()
      Dim Winkel As Double
      For Winkel = 0 To 360
         DegreesToXY Screen.Width / 15 / 2, Screen.Height / 15 / 2, _
            Winkel, 200, 200
       Next Winkel
   End Sub
     Hier noch eine kleine, nette Routine:
      Systemweit den aktuellen Mauszeiger abfragen:


ERFORDERLICHE OBJEKTE
   1 Picturebox (Picture1)
   1 CommandButton (Command1)
   1 Timer (Timer1)

 FORM-CODE
   Private Declare Function WindowFromPoint Lib "user32" _
      (ByVal xPoint As Long, ByVal yPoint As Long) As Long
   Private Declare Function GetCursor Lib "user32" () As Long
   Private Declare Function GetCursorPos Lib "user32" _
      (lpPoint As POINTAPI) As Long
   Private Declare Function GetWindowThreadProcessId Lib "user32" _
      (ByVal hWnd As Long, lpdwProcessId As Long) As Long
   Private Declare Function GetCurrentThreadId Lib "kernel32" () As Long
   Private Declare Function AttachThreadInput Lib "user32" _
      (ByVal idAttach As Long, ByVal idAttachTo As Long, _
      ByVal fAttach As Long) As Long
   Private Declare Function DrawIcon Lib "user32" (ByVal hdc As Long, _
      ByVal x As Long, ByVal y As Long, ByVal hIcon As Long) As Long
   Private Type POINTAPI
      x As Long
      y As Long
   End Type
   Private Declare Function SetWindowPos Lib "user32" _
      (ByVal hWnd As Long, ByVal hWndInsertAfter As Long, _
      ByVal x As Long, ByVal y As Long, ByVal cx As Long, _
      ByVal cy As Long, ByVal wFlags As Long) As Long
   Private Sub OnTop(frm As Form, OnTop As Boolean)
      If OnTop = True Then
         SetWindowPos frm.hWnd, 1, 0, 0, 0, 0, &H1
      Else
         SetWindowPos frm.hWnd, -2, 0, 0, 0, 0, &H1
      End If
   End Sub
   Private Sub PaintCursor()
      Dim pt As POINTAPI
      Dim hWnd As Long
      Dim dwThreadID, dwCurrentThreadID As Long
      Dim hCursor
      GetCursorPos pt
      hWnd = WindowFromPoint(pt.x, pt.y)
      ThreadID = GetWindowThreadProcessId(hWnd, vbNull)
      CurrentThreadID = App.ThreadID
      If CurrentThreadID <> ThreadID Then
         AttachThreadInput CurrentThreadID, ThreadID, True
         hCursor = GetCursor()
         AttachThreadInput CurrentThreadID, ThreadID, False
     Else
        hCursor = GetCursor()
     End If
     Picture1.Cls
     DrawIcon Picture1.hdc, 0, 0, hCursor
   End Sub
   Private Sub Timer1_Timer()
      Call PaintCursor
   End Sub
   Private Sub Command1_Click()
      Timer1.Enabled = False
      OnTop Me, False
      End
   End Sub
   Private Sub Form_Load()
      Command1.Caption = "Beenden"
      OnTop Me, True
      With Timer1
         .Enabled = True
         .Interval = 100
      End With
   End Sub

 


Dieses Beispiel beinhaltet alle o.g. Routinen,
außerdem eine Routine, um den Mausbereich einzugrenzen und
die Anzahl der Maustasten festzustellen.

Download - 4 KB