木子屋
 

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

作者: dnawo

日期: 2010-09-30 05:21 PM

分类: Win编程

内容: 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)

 

登录

────────────

木子屋

PJBlog3 v3.2.9.518 Inside.

Processed In 0.047 ms

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

你没有权限发表评论

────────────

木子屋

PJBlog3 v3.2.9.518 Inside.

Processed In 0.047 ms

暂无评论

返回

────────────

木子屋

PJBlog3 v3.2.9.518 Inside.

Processed In 0.047 ms