VB模拟鼠标类

Private Declare Sub mouse_event Lib "user32" (ByVal dwFlags As Long, ByVal dx As Long, ByVal dy As Long, ByVal dwData As Long, ByVal dwExtraInfo As Long)
Private Declare Sub keybd_event Lib "user32" (ByVal bVk As Byte, ByVal Scan As Byte, ByVal dwFlags As Long, ByVal dwExtraInfo As Long)
Private Declare Function MapVirtualKey Lib "user32" Alias "MapVirtualKeyA" (ByVal wCode As Long, ByVal wMapType As Long) As Long
Private Declare Function GetTickCount Lib "kernel32" () As Long  ' GetTickCount 模拟一个不卡机 Sleep 函数
Private Declare Function PostMessage Lib "user32" Alias "PostMessageA" (ByVal hWnd As Long, ByVal wMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long '后台

Private Type POINTAPI
  x As Long
  y As Long
End Type

'键盘常量
Private Const KEYEVENTF_KEYUP = &H2
Private Const KEYEVENTF_KEYDOWN = &H0

'鼠标常量
Private Const MOUSEEVENTF_ABSOLUTE = &H8000& ' absolute move
Private Const MOUSEEVENTF_LEFTDOWN = &H2     ' left button down
Private Const MOUSEEVENTF_LEFTUP = &H4       ' left button up
Private Const MOUSEEVENTF_MIDDLEDOWN = &H20  ' middle button down
Private Const MOUSEEVENTF_MIDDLEUP = &H40    ' middle button up
Private Const MOUSEEVENTF_MOVE = &H1         ' mouse move
Private Const MOUSEEVENTF_RIGHTDOWN = &H8    ' right button down
Private Const MOUSEEVENTF_RIGHTUP = &H10     ' right button up
Private Const MOUSEEVENTF_WHEEL = &H800      ' wheel button rolled

Private Const WHEEL_DELTA As Long = 120
Private Const M_SCALE As Long = &HFFFF&
Public Enum WheelDirections
    meWheelForward = WHEEL_DELTA
    meWheelBackward = -WHEEL_DELTA
End Enum

' 和 API Kernel32/Sleep 使用方法一样
' 为了方便程序流程，我们这里加了一个 boolean 值 blnVar
' 如果程序传入的 blnVar = False，那么 Sleep 函数将不进行延迟操作
' 当然， blnVar 参数是可选的
Public Sub Sleep(ByVal msec As Long, Optional blnVar As Boolean = True)
    Dim iTick As Long
    iTick = GetTickCount
    While GetTickCount - iTick < msec And blnVar
        DoEvents
    Wend
End Sub

Public Function h_LeftClick(ByVal mHandle As Long, ByVal x As Long, ByVal y As Long)
'//后台发送鼠标左键命令
    Dim lParam As Long
    lParam = (y * &H10000) + x
    PostMessage mHandle, &H201, 0&, ByVal lParam
    PostMessage mHandle, &H202, 0&, ByVal lParam
End Function

Public Function h_RightClick(ByVal mHandle As Long, ByVal x As Long, ByVal y As Long)
'//后台发送鼠标右键命令
    Dim lParam As Long
    lParam = (y * &H10000) + x
    PostMessage mHandle, &H204, 0&, ByVal lParam
    PostMessage mHandle, &H205, 0&, ByVal lParam
End Function

Public Function h_MiddleClick(ByVal mHandle As Long, ByVal x As Long, ByVal y As Long)
'//后台发送鼠标中键命令
    Dim lParam As Long
    lParam = (y * &H10000) + x
    PostMessage mHandle, &H207, 0&, ByVal lParam
    PostMessage mHandle, &H208, 0&, ByVal lParam
End Function

Public Function h_KeyPress(ByVal mHandle As Long, ByVal keyCode As Long, Optional lClickDelay As Long = 30)
'//后台发送键盘命令
    PostMessage mHandle, &H100, keyCode, 0
    Sleep lClickDelay
    PostMessage mHandle, &H101, keyCode, 0
End Function

Public Sub KeyDown(keyCode As Long)
'// 键按下
    Call keybd_event(keyCode, MapVirtualKey(keyCode, 0), KEYEVENTF_KEYDOWN, &H0)
End Sub

Public Sub KeyUp(keyCode As Long)
'// 键弹起
    Call keybd_event(keyCode, MapVirtualKey(keyCode, 0), KEYEVENTF_KEYUP, &H0)
End Sub

Public Sub KeyPress(keyCode As Long, Optional lClickDelay As Long = 30)
'// 按键
    Call keybd_event(keyCode, MapVirtualKey(keyCode, 0), KEYEVENTF_KEYDOWN, &H0)
    If lClickDelay Then
        DoEvents
        Call Sleep(lClickDelay)
    End If
    Call keybd_event(keyCode, MapVirtualKey(keyCode, 0), KEYEVENTF_KEYUP, &H0)
End Sub

Public Sub MouseDown(ByVal Button As MouseButtonConstants)
'// 在屏幕中按下鼠标的一个键
    Select Case Button
        Case vbLeftButton, vbMiddleButton, vbRightButton
            Call mouse_event(MOUSEEVENTF_LEFTDOWN, 0, 0, 0, 0)
        Case vbMiddleButton
            Call mouse_event(MOUSEEVENTF_MIDDLEDOWN, 0, 0, 0, 0)
        Case vbRightButton
            Call mouse_event(MOUSEEVENTF_RIGHTDOWN, 0, 0, 0, 0)
    End Select
End Sub

Public Sub MouseUp(ByVal Button As MouseButtonConstants)
'// 弹起鼠标的一个键
    Select Case Button
        Case vbLeftButton, vbMiddleButton, vbRightButton
            Call mouse_event(MOUSEEVENTF_LEFTUP, 0, 0, 0, 0)
        Case vbMiddleButton
            Call mouse_event(MOUSEEVENTF_MIDDLEUP, 0, 0, 0, 0)
        Case vbRightButton
            Call mouse_event(MOUSEEVENTF_RIGHTUP, 0, 0, 0, 0)
   End Select
End Sub

Public Sub Click(Optional lClickDelay As Long = 100)
'// 鼠标左键单击
    Call mouse_event(MOUSEEVENTF_LEFTDOWN, 0, 0, 0, 0)
    If lClickDelay Then
        DoEvents
        Call Sleep(lClickDelay)
    End If
    Call mouse_event(MOUSEEVENTF_LEFTUP, 0, 0, 0, 0)
End Sub

Public Sub RightClick(Optional lClickDelay As Long = 100)
'// 鼠标右键单击
    Call mouse_event(MOUSEEVENTF_RIGHTDOWN, 0, 0, 0, 0)
    If lClickDelay Then
        DoEvents
        Call Sleep(lClickDelay)
    End If
    Call mouse_event(MOUSEEVENTF_RIGHTUP, 0, 0, 0, 0)
End Sub

' X/Y need to be passed as pixels!
Public Sub MoveToClick(ByVal x As Long, ByVal y As Long)
'// 移动并单击
    ' Move cursor to destination, first.
    Call MoveTo(x, y)
    ' Click it
    Call Click
End Sub

' X/Y need to be passed as pixels!
Public Sub MoveTo(ByVal x As Long, ByVal y As Long)
'// 移动鼠标
    mouse_event MOUSEEVENTF_ABSOLUTE Or MOUSEEVENTF_MOVE, 0, 0, 0, 0
    mouse_event MOUSEEVENTF_MOVE, x, y, 0, 0
End Sub

' Not supported in Windows95!
Public Sub TurnWheel(Optional ByVal Notches As Long = 1, Optional ByVal Direction As WheelDirections = meWheelBackward)
'// 转动鼠标中建
    Dim dwData As Long
    ' Validate direction
    If Direction <> meWheelBackward And Direction <> meWheelForward Then
        Direction = meWheelBackward
    End If
    ' Turn the wheel
    dwData = Notches * Direction
    Call mouse_event(MOUSEEVENTF_WHEEL, 0, 0, dwData, 0)
End Sub