不错呦!smile@林凯西,确保“准备文件”中的几个文件都有安装,S...您好,看了您这篇帖子觉得很有帮助。但是有个问题想请...我的修改过了怎么还被恶意注册呢 @jjjjiiii 用PJ快9年了,主要是A...PJ3啊,貌似很少有人用PJ了,现在不是WP就是z...@332347365,我当时接入时错误码没有-10...楼主,ChkValue值应为-103是什么意思呢?...大哥 你最近能看到我发的信息,请跟我联系,我有个制...
VB6.0调用win32api模拟鼠标单击等操作
编辑:dnawo 日期:2010-09-30
1.获取窗口坐标
2.获取指定坐标的颜色
3.模拟鼠标单击
4.延时
5.获取鼠标坐标
复制内容到剪贴板
程序代码

'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
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
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
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
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
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
发表评论
请登录后再发表评论!