VB6.0调用win32api模拟鼠标单击等操作

1.获取窗口坐标

'Win32 Api
Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
Private Declare Function GetWindowRect Lib "user32" (ByVal hwnd As Long, lpRect As Rect) As Long

Private Type Rect
    Left As Long
    Top As Long
    Right As Long
    Bottom As Long
End Type

Private Sub Command1_Click()
    Dim hwnd As Long
    Dim result As Long, myrect As Rect
    
    hwnd = FindWindow(vbNullString, "木子屋")
    If hwnd <> 0 Then
        result = GetWindowRect(hwnd, myrect)
        If result <> 0 Then
            MsgBox "左上角坐标:(" & myrect.Left & "," & myrect.Top & ") 右下角坐标:(" & myrect.Right & "," & myrect.Bottom & ")"
        Else
            MsgBox "窗口坐标获取失败!"
        End If
    Else
        MsgBox "获取窗口句柄失败!"
    End If
End Sub

2.获取指定坐标的颜色

'Win32 Api
Private Declare Function GetPixel Lib "gdi32" (ByVal hdc As Long, ByVal x As Long, ByVal y As Long) As Long
Private Declare Function GetDC Lib "user32" (ByVal hwnd As Long) As Long

Private Sub Command1_Click()
    MsgBox GetPixel(GetDC(0), 62, 704)
End Sub

3.模拟鼠标单击

'Win32 Api
Private Declare Function SetCursorPos Lib "user32" (ByVal x As Long, ByVal y As Long) As Long
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)

Const MOUSEEVENTF_ABSOLUTE = &H8000
Const MOUSEEVENTF_MOVE = &H1
Const MOUSEEVENTF_LEFTDOWN = &H2
Const MOUSEEVENTF_LEFTUP = &H4
Const MOUSEEVENTF_MIDDLEDOWN = &H20
Const MOUSEEVENTF_MIDDLEUP = &H40
Const MOUSEEVENTF_RIGHTDOWN = &H8
Const MOUSEEVENTF_RIGHTUP = &H10

Private Sub Command1_Click()
    Dim result As Boolean
    result = SetCursorPos(62, 704)
    If result Then
        '两个连续动作使用OR相连
        mouse_event MOUSEEVENTF_RIGHTDOWN or MOUSEEVENTF_RIGHTUP, 0, 0, 0, 0
    End If
End Sub

4.延时

'Win32 Api
Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)

Private Sub Command1_Click()
    Dim time1 As Date, time2 As Date
    time1 = Now()
    Sleep 3000 '延时3秒
    time2 = Now()
    MsgBox "延时" & DateDiff("s", time1, time2) & "秒"
End Sub

5.获取鼠标坐标

'Win32 Api
Private Declare Function GetCursorPos Lib "user32" (lpPoint As POINTAPI) As Long

Private Type POINTAPI
    X As Long
    Y As Long
End Type

Private Sub Command1_Click()
    Dim result As Long
    Dim point As POINTAPI
    result = GetCursorPos(point)
    If result <> 0 Then
        MsgBox "x=" & point.X & ",y=" & point.Y
    End If
End Sub


评论: 0 | 引用: 0 | 查看次数: 6960
发表评论
登录后再发表评论!