“一键功能”的设计、实现与应用.doc

“一键功能”的设计、实现与应用相关程序代码_Const EWX_SHUTDOWN = 1Const EWX_REBOOT = 2Const WM_SYSCOMMAND = &H112&Const WM_SCREENSAVE = &HF140&Private Declare Function GetAsyncKeyState Lib user32 (ByVal vKey As Long) As IntegerPrivate Declare Function ExitWindowsEx Lib user32 (ByVal uFlags As Long, _ByVal dwReserved As Long) As LongPrivate Declare Function mciSendString Lib winmm.dll Alias mciSendStringA _ (ByVal lpstrCommand As String, ByVal lpstrReturnString As String, ByVal uReturnLength _As Long, ByVal hwndCallback As Long) As LongPrivate Declare Function GetWindowsDirectory Lib kernel32 Alias _ GetWindowsDirectoryA (ByVal lpBuffer As String, ByVal nSize As Long) As LongPrivate Declare Function SendMessage Lib user32 Alias SendMessageA (ByVal hWnd _ As Long, ByVal wMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As LongDim iFunctionKey(5) As Integer, a() As String, iCustomFunction() As IntegerDim strKeyFile() As String, strKey检测到定义的快捷键被按下时，返回True，否则为FalshPrivate Function MyHotKey(vKeyCode As Integer) As Boolean MyHotKey = (GetAsyncKeyState(vKeyCode) 0)End Function重新启动计算机Private Sub RebootComputer() Dim a As Integer a = ExitWindowsEx(EWX_REBOOT, 0)End Sub关闭计算机Private Sub CloseComputer() Dim a As Integer a = ExitWindowsEx(EWX_SHUTDOWN, 0)End Sub打开屏幕保护程序Private Sub LockComputer() Dim result As Long result = SendMessage(Form1.hWnd, WM_SYSCOMMAND, WM_SCREENSAVE, 0&)End Sub打开光驱Private Sub OpenCDROM() Dim Ret As Long Dim RetStr As String Ret = mciSendString(set CDAudio door open, RetStr, 0, 0)End Sub关闭光驱Private Sub CloseCDROM() Dim Ret As Long Dim RetStr As String Ret = mciSendString(set CDAudio door closed, RetStr, 0, 0)End Sub检测是否重复定义快捷键Private Sub RedefineFuncKey(strCmbtxt As String, inumber As Integer) Dim i As Integer 检测当前要定义的快捷键是否与特定功能区中已定义的快捷键重复 For i = 0 To 5 If strCmbtxt = cmbChooseKey(i) And strCmbtxt 无 And inumber i Then MsgBox strCmbtxt & 功能键已经定义，请选择其他功能键, vbInformation, 提示 cmbChooseKey(inumber) = 无 Exit Sub End If Next 检测当前要定义的快捷键是否与自定义功能区中已定义的快捷键重复 For i = 0 To List1.ListCount - 1 If strCmbtxt = Trim(Mid(List1.List(i), 1, 3) Then MsgBox strCmbtxt & 功能键已经定义，请选择其他功能键, vbInformation, 提示 cmbChooseKey(inumber) = 无 Exit Sub End If NextEnd Sub以下四个过程是只允许用户从下拉组合框中选择快捷键Private Sub Lockcombobox() Dim i As Integer For i = 0 To 5 锁住下拉组合框中的文本 cmbChooseKey(i).Locked = True NextEnd SubPrivate Sub unLockcombobox() Dim i As Integer For i = 0 To 5 解开下拉组合框中的文本 cmbChooseKey(i).Locked = False NextEnd SubPrivate Sub cmbChooseKey_KeyDown(Index As Integer, KeyCode As Integer, Shift As Integer) Lockcombobox 锁定上、下方向键,禁示用户通过方向键来改变快捷键，从而避免设置相同的快捷键 If KeyCode = vbKeyUp Or KeyCode = vbKeyDown Then KeyCode = 0 End IfEnd SubPrivate Sub cmbChooseKey_KeyUp(Index As Integer, KeyCode As Integer, Shift As Integer) unLockcomboboxEnd Sub把键面字符转变成相应的键盘扫描码Private Function strKeyToLong(strKey As String) As IntegerDim i As Long Select Case strKey Case F2 i = vbKeyF2 Case F3 i = vbKeyF3 Case F4 i = vbKeyF4 Case F5 i = vbKeyF5 Case F6 i = vbKeyF6 Case F7 i = vbKeyF7 Case F8 i = vbKeyF8 Case F9 i = vbKeyF9 Case F10 i = vbKeyF10 Case F11 i = vbKeyF11 End Select strKeyToLong = iEnd FunctionPrivate Sub cmbChooseKey_Click(Index As Integer) 禁止重复定义快捷键 RedefineFuncKey cmbChooseKey(Index).Text, IndexEnd SubPrivate Sub cmdAdd_Click() Dim strFileName As String If cmbChooseKey(5).Text = 无 Or cmbChooseKey(5).Text = Then MsgBox 请先为应用程序定义一个快捷键, vbInformation, 提示 Else cmnAdd.DialogTitle = 添加 cmnAdd.Filter = 可执行文件(*.exe)|*.exe 在添加对话框中只显示EXE文件 cmnAdd.ShowOpen 打开添加对话框 strFileName = cmnAdd.FileName 把定义的快捷键和应用程序添加到列表框中 If strFileName Then List1.AddItem cmbChooseKey(5).Text + + cmnAdd.FileName End If cmbChooseKey(5).Text = 无 End IfEnd SubPrivate Sub cmdApply_Click() Dim strKeyJoin As String, strKeyFile As String strKeyJoin = strKeyFile = 把特定功能区定义的快捷键以逗号为分隔符写入FunctionKey.txt文件 For i = 0 To 4 If i 4 Then strKeyJoin = strKeyJoin & Trim(cmbChooseKey(i).Text) & , Else strKeyJoin = strKeyJoin & Trim(cmbChooseKey(i).Text) End If Next Open App.Path + FunctionKey.txt For Output As #1 Print #1, strKeyJoin Close #1 如果在列表框中有应用程序名和快捷键且检测CustomKey.txt,则删除该文件; If List1.ListCount = 0 And Dir(App.Path + CustomKey.txt) Then Kill App.Path + CustomKey.txt 把定义的快捷键及应用程序以逗号为分隔符写入CustomKey.txt文件 ElseIf List1.ListCount 0 Then For i = 0 To List1.ListCount - 1 If i List1.ListCount - 1 Then strKeyFile = strKeyFile + List1.List(i) + , Else strKeyFile = strKeyFile + List1.List(i) End If Next Open App.Path + CustomKey.txt For Output As #1 Print #1, strKeyFile Close #1 End If List1.Clear 重新从FunctionKey.txt和CustomKey.txt文件中取得定义的快捷键及相应的应用程序名供程序使用 Form_LoadEnd SubPrivate Sub cmdCancel_Click() Unload MeEnd Sub删除列表框中选中的快捷键和应用程序名Private Sub cmdDel_Click() List1.RemoveItem List1.ListIndexEnd SubPrivate Sub cmdOk_Click() cmdApply_Click 调用应用按钮下的代码 Me.Visible = FalseEnd SubPrivate Sub Form_KeyDown(KeyCode As Integer, Shift As Integer) 按快捷键A调用应用按钮下的代码 If KeyCode = vbKeyA Then cmdApply_Click End IfEnd SubPrivate Sub Form_Load() Dim strLine As String 把F2F11和无分别添加到组合框控件数组的下拉列表框和文本框中 For i = 0 To 5 cmbChooseKey(i).Text = 无 cmbChooseKey(i).AddItem 无 cmbChooseKey(i).AddItem F2 cmbChooseKey(i).AddItem F3 cmbChooseKey(i).AddItem F4 cmbChooseKey(i).AddItem F5 cmbChooseKey(i).AddItem F6 cmbChooseKey(i).AddItem F7 cmbChooseKey(i).AddItem F8 cmbChooseKey(i).AddItem F9 cmbChooseKey(i).AddItem F10 cmbChooseKey(i).AddItem F11 Next 如果在应用程序的路径上没有FunctionKey.txt 和CustomKey.txt文件(即没有定义快捷键)， 则显示图1界面 If Dir(App.Path + FunctionKey.txt) = And Dir(App.Path + CustomKey.txt) = Then Me.Show End If If Dir(App.Path + FunctionKey.txt) Then Open App.Path + FunctionKey.txt For Input As #1 Line Input #1, strLine Close #1 把定义的快捷键读到a数组中 a = Split(strLine, ,) For i = 0 To UBound(a) 把从FunctionKey.txt文件取出定义的快捷键并转变成键盘扫描码 iFunctionKey(i) = strKeyToLong(a(i) 如果已经为特定功能定义了快捷键，则在相应的位置显示该快捷键， 否则显示无 If IsNumeric(Right(a(i), 1) Then cmbChooseKey(i).Text = a(i) Else cmbChooseKey(i).Text = 无 End If Next End If Dim strKeyFileJoin As String strLine = 如果CustomKey.txt文件存在，则把所有的快捷键和应用程序名读到变量strLine中 If Dir(App.Path + CustomKey.txt) Then Open App.Path + CustomKey.txt For Input As #1 Do While Not EOF(1) Line Input #1, strLine strKeyFileJoin = strKeyFileJoin + strLine Loop Close #1 strKey = Split(strKeyFileJoin, ,) 把快捷键和与之对应的应用程序名放入strKey数组中 根据strKey数组的大小，重新定义以下数组的大小并保存重新定义前的值 ReDim Preserve iCustomFunction(UBound(strKey) ReDim Preserve strKeyFile(UBound(strKey) 把定义的快捷键和应用程序名添加到列表框中，并把快捷键的扫描码放入相应的数组中 For i = 0 To UBound(strKey) List1.AddItem strKey(i) strKeyFile(i) = Trim(Mid(strKey(i), 1, 4) iCustomFunction(i) = strKeyToLong(strKeyFile(i) Next End IfEnd Sub以下两个过程的作用是完整地显示被遮蔽的应用程序名Private Sub List1_MouseDown(Button As Integer, Shift As Integer, x As Single, Y As Single) List1.ToolTipText = Trim(Mid(List1.Text, 5)End SubPrivate Sub List1_MouseMove(Bu