鼠标模拟键盘.frm

时间:2013-06-01 11:02:29
【文件属性】:

文件名称:鼠标模拟键盘.frm

文件大小:6KB

文件格式:FRM

更新时间:2013-06-01 11:02:29

鼠标模拟键盘

鼠标模拟键盘.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


网友评论