Simulation souris

Soyez le premier à donner votre avis sur cette source.

Snippet vu 15 858 fois - Téléchargée 7 fois

Contenu du snippet

Private Const SM_CXSCREEN = 0
Private Const SM_CYSCREEN = 1
Private Const INPUT_MOUSE = 0
Private Const MOUSEEVENTF_MOVE = &H1
Private Const MOUSEEVENTF_LEFTDOWN = &H2
Private Const MOUSEEVENTF_LEFTUP = &H4
Private Const MOUSEEVENTF_RIGHTDOWN = &H8
Private Const MOUSEEVENTF_RIGHTUP = &H10
Private Const MOUSEEVENTF_MIDDLEDOWN = &H20
Private Const MOUSEEVENTF_MIDDLEUP = &H40
Private Const MOUSEEVENTF_XDOWN = &H80
Private Const MOUSEEVENTF_XUP = &H100
Private Const MOUSEEVENTF_WHEEL = &H800
Private Const MOUSEEVENTF_HWHEEL = &H1000
Private Const MOUSEEVENTF_ABSOLUTE = &H8000
Private Const MOUSE_XBUTTON1 = &H1
Private Const MOUSE_XBUTTON2 = &H2
Private Const WHEEL_DELTA = 120

Public Enum MouseButtons
  None = 0
  Left = 1
  Right = 2
  Middle = 4
  XButton1 = 8
  XButton2 = 16
End Enum

Private Type MOUSEINPUT
  dx As Long
  dy As Long
  mouseData As Long
  dwFlags As Long
  time As Long
  dwExtraInfo As Long
End Type
Private Type INPUT_TYPE
  type As Long
  mi As MOUSEINPUT
End Type

Private Declare Function GetSystemMetrics Lib "user32.dll" (ByVal nIndex As Long) As Long
Private Declare Function SendInput Lib "user32.dll" (ByVal nInputs As Long, pInputs As INPUT_TYPE, ByVal cbSize As Long) As Long

' Evénement souris personnalisé
Public Function MouseEvent(ByVal dx As Long, ByVal dy As Long, ByVal mouseData As Long, ByVal dwFlags As Long, ByVal time As Long, ByVal dwExtraInfo As Long) As Long
  Dim mInput As INPUT_TYPE
  mInput.type = INPUT_MOUSE
  mInput.mi.dx = dx
  mInput.mi.dy = dy
  mInput.mi.mouseData = mouseData
  mInput.mi.dwFlags = dwFlags
  mInput.mi.time = time
  mInput.mi.dwExtraInfo = dwExtraInfo
  MouseEvent = SendInput(1, mInput, LenB(mInput))
End Function

' Simule le déplacement de la souris
Public Function MouseMove(ByVal dx As Long, ByVal dy As Long) As Long
  MouseMove = MouseEvent(dx * 65535 \ GetSystemMetrics(SM_CXSCREEN), dy * 65535 \ GetSystemMetrics(SM_CYSCREEN), &O0, MOUSEEVENTF_ABSOLUTE Or MOUSEEVENTF_MOVE, &O0, &O0)
End Function

' Simule l'enfoncement d'un bouton de la souris
Public Function MouseButtonDown(ByVal Button As MouseButtons) As Long
  Select Case Button
    Case MouseButtons.Left
      MouseButtonDown = MouseEvent(0&, 0&, 0&, MOUSEEVENTF_LEFTDOWN, 0&, 0&)
    Case MouseButtons.Middle
      MouseButtonDown = MouseEvent(0&, 0&, 0&, MOUSEEVENTF_MIDDLEDOWN, 0&, 0&)
    Case MouseButtons.Right
      MouseButtonDown = MouseEvent(0&, 0&, 0&, MOUSEEVENTF_RIGHTDOWN, 0&, 0&)
    Case MouseButtons.XButton1
      MouseButtonDown = MouseEvent(0&, 0&, MOUSE_XBUTTON1, MOUSEEVENTF_XDOWN, 0&, 0&)
    Case MouseButtons.XButton2
      MouseButtonDown = MouseEvent(0&, 0&, MOUSE_XBUTTON2, MOUSEEVENTF_XDOWN, 0&, 0&)
    Case Else
      MouseButtonDown = 0
  End Select
End Function

' Simule l'enfoncement d'un bouton de la souris après un déplacement
Public Function MouseButtonDownXY(ByVal Button As MouseButtons, ByVal dx As Long, ByVal dy As Long) As Long
    MouseButtonDownXY = MouseMove(dx, dy) + MouseButtonDown(Button)
End Function

' Simule le relâchement d'une bouton de la souris
Public Function MouseButtonUp(ByVal Button As MouseButtons) As Long
  Select Case Button
    Case MouseButtons.Left
      MouseButtonUp = MouseEvent(0&, 0&, 0&, MOUSEEVENTF_LEFTUP, 0&, 0&)
    Case MouseButtons.Middle
      MouseButtonUp = MouseEvent(0&, 0&, 0&, MOUSEEVENTF_MIDDLEUP, 0&, 0&)
    Case MouseButtons.Right
      MouseButtonUp = MouseEvent(0&, 0&, 0&, MOUSEEVENTF_RIGHTUP, 0&, 0&)
    Case MouseButtons.XButton1
      MouseButtonUp = MouseEvent(0&, 0&, MOUSE_XBUTTON1, MOUSEEVENTF_XUP, 0&, 0&)
    Case MouseButtons.XButton2
      MouseButtonUp = MouseEvent(0&, 0&, MOUSE_XBUTTON2, MOUSEEVENTF_XUP, 0&, 0&)
    Case Else
      MouseButtonUp = 0
  End Select
End Function

' Simule le relâchement d'une bouton de la souris après un déplacement
Public Function MouseButtonUpXY(ByVal Button As MouseButtons, ByVal dx As Long, ByVal dy As Long) As Long
  MouseButtonUpXY = MouseMove(dx, dy) + MouseButtonUp(Button)
End Function

' Simule un clique souris simple
Public Function MouseButtonClick(ByVal Button As MouseButtons) As Long
  MouseButtonClick = MouseButtonDown(Button) + MouseButtonUp(Button)
End Function

' Simule un clique souris simple après un déplacement
Public Function MouseButtonClickXY(ByVal Button As MouseButtons, ByVal dx As Long, ByVal dy As Long) As Long
  MouseButtonClickXY = MouseMove(dx, dy) + MouseButtonDown(Button) + MouseButtonUp(Button)
End Function

' Simule la molette souris
Public Function MouseWheel(ByVal Count As Long) As Long
  MouseWheel = MouseEvent(0&, 0&, WHEEL_DELTA * Count, MOUSEEVENTF_WHEEL, 0&, 0&)
End Function

' Simule la molette horizontale souris
Public Function MouseHWheel(ByVal Count As Long) As Long
  MouseHWheel = MouseEvent(0&, 0&, WHEEL_DELTA * Count, MOUSEEVENTF_HWHEEL, 0&, 0&)
End Function

Compatibilité : VB6, VBA

Disponible dans d'autres langages :

A voir également

Vous n'êtes pas encore membre ?

inscrivez-vous, c'est gratuit et ça prend moins d'une minute !

Les membres obtiennent plus de réponses que les utilisateurs anonymes.

Le fait d'être membre vous permet d'avoir un suivi détaillé de vos demandes et codes sources.

Le fait d'être membre vous permet d'avoir des options supplémentaires.