鼠标模拟键盘.frm
Private Declare Function SetCursorPos Lib "user32" (ByVal x As Long, ByVal y As Long) As Long '这个是设置鼠标的位置!
Private Declare Function CreateDCA& Lib "gdi32" (ByVal lpDriverName As String, ByVal lpDeviceName As String, ByVal lpOutput As String, lpInitData 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)
'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)
Private Declare Function GetCursorPos Lib "user32" (lpPoint As pointapi) As Long
'Private Declare Function CreateDCA& Lib "gdi32" (ByVal lpDriverName As String, ByVal lpDeviceName As String, ByVal lpOutput As String, lpInitData As Long)
Private Declare Function GetPixel Lib "gdi32" (ByVal hdc As Long, ByVal x As Long, ByVal y As Long) As Long
Private Declare Function DeleteDC Lib "gdi32" (ByVal hdc As Long) As Long
Private Type pointapi
x As Long
y As Long
End Type
Dim mx, my
Private Sub Command1_Click()
x = Int(Rnd(1) * 500)
y = Int(Rnd(1) * 500)
Call SetCursorPos(x, y) '让鼠标移动到(10,20)
'mouse_event MOUSEEVENTF_LEFTDOWN Or MOUSEEVENTF_LEFTUP, 0&, 0&, 0&, 0& '模拟鼠标点击
mouse_event LEFTDOWN_RIGHTDOWN, 0, 0, 0, 0
'//模拟按下鼠标右键。
End Sub
Private Sub Command2_Click()
Timer2.Interval = 0
mouse_event MOUSEEVENTF_LEFTDOWN Or MOUSEEVENTF_LEFTUP, 0, 0, 0, 0 '模拟鼠标的左键单击!
End Sub
Private Sub Command3_Click()
End
End Sub
Private Sub Form_Load()
'定义鼠标事件
'上面的是声明部分.只有声明了,才可以使用..
'代码部分
Call SetCursorPos(580, 20) '让鼠标移动到(10,20)
mouse_event MOUSEEVENTF_LEFTDOWN Or MOUSEEVENTF_LEFTUP, 0, 0, 0, 0 '模拟鼠标的左键单击!
End Sub
Private Sub Timer1_Timer()
x = Int(Rnd(1) * 500)
y = Int(Rnd(1) * 500)
Call SetCursorPos(x, y) '让鼠标移动到(10,20)
mouse_event MOUSEEVENTF_LEFTDOWN, 0, 0, 0, 0 '模拟鼠标的左键单击!
mouse_event MOUSEEVENTF_LEFTUP, 0, 0, 0, 0 '模拟鼠标的左键单击!
End Sub
''为 了 指 定 那 些 与 SHIFT、 CTRL 及 ALT 等 按 键 结 合 的 组 合 键 ， 可 在 这 些 按 键 码 的 前 面 放 置 一 个 或 多 个 代 码 ， 这 些 代 码 列 举 如 下 ：
'按 键 代 码
'SHIFT +
'CTRL ^
'ALT %
'{PRTSC}
' 为 了 说 明 在 按 下 其 它 按 键 时 应 同 时 按 下 SHIFT、 CTRL、 及 ALT 的 任 意 组 合 键 ， 请 把 那 些 按 键 的 码 放 在 括 号 当 中 。 例 如 ， 为 了 说 明 按 下 E 与 C 的 时 候 同 时 按 下 SHIFT 键 ， 请 使 用 "+(EC)"。 为 了 说 明 在 按 下 E 的 时 候 同 时 按 下 SHIFT 键 ， 但 接 着 按 C 而 不 按 SHIFT， 则 使 用 "+EC"。
'对 SendKeys 来 说 ， 加 号 (+)、 插 入 符 (^)、 百 分 比 符 号 (%)、 上 划 线 (~) 及 圆 括 号 ( ) 都 具 有 特 殊 意 义 。 为 了 指 定 上 述 任 何 一 个 字 符 ， 要 将 它 放 在 大 括 号 ({}) 当 中 。 例 如 ， 要 指 定 正 号 ， 可 用 {+} 表 示 。 方 括 号 ([ ]) 对 SendKeys 来 说 并 不 具 有 特 殊 意 义 ， 但 必 须 将 它 们 放 在 大 括 号 中 。 在 其 它 应 用 程 序 中 ， 方 括 号 有 特 殊 意 义 ， 在 出 现 动 态 数 据 交 换 (DDE) 的 时 候 ， 它 可 能 具 有 重 要 意 义 。 为 了 指 定 大 括 号 字 符 ， 请 使 用 {{} 及 {}}。
'另 外 ， 参 考 Sendkeys的 帮 助 ， 可 以 找 到 其 他 一 些 特 殊 键 的 传 递 方 法 。
'SendKeys "^B"
'SendKeys ("{PRTSC}")
Private Sub Timer2_Timer()
Dim a As Long
Dim p As pointapi
a = CreateDCA("DISPLAY", vbNullString, vbNullString, 0)
GetCursorPos p
'Command1.Caption = GetPixel(a, p.x, p.y) 'h获取颜色值
If p.x = mx Or p.y = my Then GoTo 50
If p.x > mx Then GoTo 10
If p.x < mx Then GoTo 20
GoTo 50
10
SendKeys "右"
GoTo 50
20
SendKeys "左"
GoTo 50
30
SendKeys "下"
GoTo 60
40
SendKeys "上"
GoTo 60
SendKeys "B"
SendKeys p.x '坐标
SendKeys "a"
SendKeys p.y
50
If p.y > my Then GoTo 30
If p.y < my Then GoTo 40
60
mx = p.x
my = p.y
End Sub
