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

onst WM_SCREENSAVE = &HF140&

Private Declare Function GetAsyncKeyState Lib "user32" (ByVal vKey As Long) As Integer
Private Declare Function ExitWindowsEx Lib "user32" (ByVal uFlags As Long, _
ByVal dwReserved As Long) As Long
Private 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 Long
Private Declare Function GetWindowsDirectory Lib "kernel32" Alias _
"GetWindowsDirectoryA" (ByVal lpBuffer As String, ByVal nSize As Long) As Long
Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hWnd _
As Long, ByVal wMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
Dim iFunctionKey(5) As Integer, a() As String, iCustomFunction() As Integer
Dim strKeyFile() As String, strKey

''检测到定义的快捷键被按下时，返回True，否则为Falsh
Private 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
Next
End Sub

''以下四个过程是只允许用户从下拉组合框中选择快捷键
Private Sub Lockcombobox()
Dim i As Integer
For i = 0 To 5
''锁住下拉组合框中的文本
cmbChooseKey(i).Locked = True
Next
End Sub

Private Sub unLockcombobox()
Dim i As Integer
For i = 0 To 5
''解开下拉组合框中的文本
cmbChooseKey(i).Locked = False
Next
End Sub

Private Sub cmbChooseKey_KeyDown(Index As Integer, KeyCode As Integer, Shift As Integer)
Lockcombobox
''锁定上、下方向键,禁示用户通过方向键来改变快捷键，从而避免设置相同的快捷键
If KeyCode = vbKeyUp Or KeyCode = vbKeyDown Then
KeyCode = 0
End