Simulation souris
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
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.