首页 > 未分类 > VB 类按键精灵源码

VB 类按键精灵源码

2008年3月30日 岩岩魂   访问量: 610 发表评论 阅读评论

VB 类按键精灵源码【摘于网络】

untitled

窗体部分
Private Sub Command1_Click()
Script.AddItem ("坐标:" & MouseX.Text & "-" & MouseY.Text)
End Sub

Private Sub Command2_Click()
Script.AddItem ("鼠标:左键")
End Sub

Private Sub Command3_Click()
Script.AddItem ("鼠标:右键")
End Sub

Private Sub Command4_Click()
If KeyText.Text <> "" Then
    Script.AddItem ("键盘:" & KeyText.Text)
End If
End Sub

Private Sub Command5_Click()
'==============================
'功能:保存脚本
'参数:script.txt -> 脚本文件名
'==============================
Dim i As Integer
Open App.Path + "\script.txt" For Output As #1
For i = 1 To Script.ListCount
Print #1, Script.List(i - 1)            '这里使用 i-1 是因为 ListBox 控件是从 0 开始
Next i
Close #1
MsgBox "保存完毕!", vbOKOnly, "保存脚本"
End Sub
Private Sub Command6_Click()
End
End Sub

Private Sub Command7_Click()
Call Start
End Sub

Private Sub Form_Load()
'==============================
'功能:读取脚本
'参数:script.txt -> 脚本文件名
'==============================
Dim Scriptemp As String

If Dir(App.Path + "\script.txt") = "" Then
Open App.Path + "\script.txt" For Output As #1
Close #1
End If

Open App.Path + "\script.txt" For Input As #1
While Not EOF(1)
Line Input #1, Scriptemp
        Script.AddItem Scriptemp
Wend
Close #1
End Sub

Private Sub KeyText_KeyDown(KeyCode As Integer, Shift As Integer)
Select Case KeyCode
Case 112
        KeyText.Text = "F1"
Case 113
        KeyText.Text = "F2"
Case 114
        KeyText.Text = "F3"
Case 115
        KeyText.Text = "F4"
Case 116
        KeyText.Text = "F5"
Case 117
        KeyText.Text = "F6"
Case 118
        KeyText.Text = "F7"
Case 119
        KeyText.Text = "F8"
Case 120
        KeyText.Text = "F9"
Case 121
        KeyText.Text = "F10"
Case 122
        KeyText.Text = "F11"
Case 123
        KeyText.Text = "F12"
Case Else
        KeyText.Text = Chr(KeyCode)
End Select
End Sub

'处理坐标是否超出一定长度
Private Sub MouseX_Change()
If Len(MouseX.Text) > 4 Then
MsgBox "坐标错误,请重新输入"
    MouseX.Text = "0"
End If
End Sub

Private Sub MouseY_Change()
If Len(MouseY.Text) > 4 Then
MsgBox "坐标错误,请重新输入"
    MouseY.Text = "0"
End If
End Sub

模块部分:
Option Explicit

Public Const MOUSEEVENTF_LEFTDOWN = &H2
Public Const MOUSEEVENTF_LEFTUP = &H4
Public Const MOUSEEVENTF_RIGHTDOWN = &H8
Public Const MOUSEEVENTF_RIGHTUP = &H10

Public Declare Function GetCursorPos Lib "user32" (lpPoint As POINTAPI) As Long '获得鼠标位置的 API
Public Declare Function SetCursorPos Lib "user32" (ByVal X As Long, ByVal Y As Long) As Long '设置鼠标位置的 API

Public Type POINTAPI
    X As Long
    Y As Long
End Type

Public 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)                      '鼠标事件

Public Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)          '程序延迟

模块2
Option Explicit

'=====================
'功能:运行脚本
'=====================
Public Sub Start()
Dim i As Integer
Dim Script1 As String
Dim ScriptLen As Integer
Dim MousePos() As String
Dim MouseCurPos As POINTAPI

If KeyVirtual.Script.ListCount = 0 Then
MsgBox "请添加脚本", vbOKOnly, "错误"
Exit Sub
Else
For i = 0 To KeyVirtual.Script.ListCount - 1                                                    '从 ListBox 的第一个开始
Sleep 1000                                                                                  '程序延迟 1 秒
        Script1 = KeyVirtual.Script.List(i)                                                         '获得脚本
        ScriptLen = Len(Script1)                                                                    '获得脚本字符长度
Select Case Mid(Script1, 1, 2)                                                              '选择脚本字符前两个字符
Case "坐标"
                Script1 = Mid(Script1, 4, ScriptLen - 3)                                            '获得后面的字符
                MousePos = Split(Script1, "-")                                                      '通过 - 来分割获得坐标,并放到 MousePos(数组)里面
SetCursorPos CLng(MousePos(0)), CLng(MousePos(1))                                   '设置鼠标位置
Case "鼠标"
GetCursorPos MouseCurPos                                                            '获得鼠标坐标到 MousePos(数组)
If Mid(Script1, 4, 2) = "左键" Then
mouse_event MOUSEEVENTF_LEFTDOWN, MouseCurPos.X, MouseCurPos.Y, 0, 0            '设置鼠标左键按下
mouse_event MOUSEEVENTF_LEFTUP, MouseCurPos.X, MouseCurPos.Y, 0, 0              '设置鼠标左键弹出
Else
mouse_event MOUSEEVENTF_RIGHTDOWN, MouseCurPos.X, MouseCurPos.Y, 0, 0           '设置鼠标右键按下
mouse_event MOUSEEVENTF_RIGHTUP, MouseCurPos.X, MouseCurPos.Y, 0, 0             '设置鼠标右键弹出
End If
Case "键盘"
SendKeys Mid(Script1, 4, ScriptLen - 3)                                             '发送键盘字符
End Select
Next i
End If
End Sub

相关文章:

  1. 自制控件方面的有关知识
  2. 在Vb下实现多线程
  3. 用VB操作注册表 (二)
  4. 使用Microsoft Agent 控件与电脑交谈-转贴
  5. VB 如何得知Mouse已离开某物件
分类: 未分类 标签:
  1. 本文目前尚无任何评论.
  1. 本文目前尚无任何 trackbacks 和 pingbacks.