VB 定义热键模块(SET_WIN_hotkey.bas)

//SET_WIN_hotkey.bas
Option Explicit
Private Type SAFEARRAY1D
        cDims As Integer
        fFeatures As Integer
        cbElements As Long
        cLocks As Long
        pvData As Long
        cElements As Long
        lLBound As Long
End Type
Private Declare Function RegisterHotKey Lib "user32.dll" (ByVal hwnd As Long, ByVal id As Long, ByVal fsModifiers As Long, ByVal vk As Long) As Long
Private Declare Function UnregisterHotKey Lib "user32.dll" (ByVal hwnd As Long, ByVal id As Long) As Long
Private Declare Function SetWindowLong Lib "user32.dll" Alias "SetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
Private Declare Sub CopyMemory Lib "kernel32.dll" Alias "RtlMoveMemory" (ByRef Destination As Any, ByRef Source As Any, ByVal Length As Long)
Private Declare Sub ZeroMemory Lib "kernel32.dll" Alias "RtlZeroMemory" (ByRef Destination As Any, ByVal Length As Long)
Private Declare Function ShowWindow Lib "user32.dll" (ByVal hwnd As Long, ByVal nCmdShow As Long) As Long
Private Declare Function IsWindowVisible Lib "user32.dll" (ByVal hwnd As Long) As Long
Private Declare Function KeyValArrayPtr Lib "MSVBVM60" Alias "VarPtr" (Ptr() As Any) As Long
Private Declare Function CallWindowProc Lib "user32.dll" Alias "CallWindowProcA" (ByVal lpPrevWndFunc As Long, ByVal hwnd As Long, ByVal msg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
Private Const VK_F10 As Long = &H79
Private Const MOD_CONTROL As Long = &H2
Private Const FADF_AUTO As Long = &H1
Private Const GWL_WNDPROC As Long = -4
Private Const SW_SHOW As Long = 5
Private Const SW_HIDE As Long = 0
Private Const WM_HOTKEY As Long = &H312
Private lpOldWndFunc As Long
Private wKeyVal() As Integer
Private dwKeyValue As Long
Private lpSafeArray As SAFEARRAY1D
//--------------------------------------------------------------------------------------
//函 数 名: WindowProcedure
//描    述: 窗口消息处理函数
//--------------------------------------------------------------------------------------
Private Function WindowProcedure(ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
        Select Case wMsg
               Case WM_HOTKEY
                    dwKeyValue = lParam
                    If wKeyVal(0) = MOD_CONTROL And wKeyVal(1) = VK_F10 Then
                       Call ShowWindow(hwnd, IIf(IsWindowVisible(hwnd), SW_HIDE, SW_SHOW))
                    End If
               Case Else
                    WindowProcedure = CallWindowProc(lpOldWndFunc, hwnd, wMsg, wParam, _
                    lParam)                                                             //调用原窗口消息处理
        End Select
End Function
//--------------------------------------------------------------------------------------
//函 数 名: SubClass
//描    述: 子类化
//--------------------------------------------------------------------------------------
Public Sub SubClass(ByVal hwnd As Long)
       With lpSafeArray
            .cDims = 1                                                                  //数组维数
            .cElements = 2                                                             //数组元素
            .fFeatures = FADF_AUTO                                                      //数组属性
            .pvData = VarPtr(dwKeyValue)
       End With
       Call CopyMemory(ByVal KeyValArrayPtr(wKeyVal), VarPtr(lpSafeArray), 4)
       Call RegisterHotKey(hwnd, 1000, MOD_CONTROL, VK_F10)                             //注册热键(Ctrl + F10)
       lpOldWndFunc = SetWindowLong(hwnd, GWL_WNDPROC, AddressOf WindowProcedure)     //新窗口消息处理
End Sub
//--------------------------------------------------------------------------------------
//函 数 名: UnSubClass
//描    述: 取消子类化
//--------------------------------------------------------------------------------------
Public Sub UnSubClass(ByVal hwnd As Long)
       Call ZeroMemory(ByVal KeyValArrayPtr(wKeyVal), 4)
       Call UnregisterHotKey(hwnd, 1000)
       Call SetWindowLong(hwnd, GWL_WNDPROC, lpOldWndFunc)                            //  恢复为原窗口消息处理
End Sub

//调用格式

Private Sub Form_Load()
        Call SubClass(Me.hwnd)
End SUB

来源：oschina

链接：https://my.oschina.net/u/4329429/blog/4696851

标签

hotkey