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