Option Explicit



Private Declare Function RegisterHotKey Lib "user32" (ByVal hwnd As Long, ByVal id As Long, ByVal fsModifiers As Long, ByVal vk As Long) As Long

Private Declare Function UnregisterHotKey Lib "user32" (ByVal hwnd As Long, ByVal id As Long) As Long

Private Declare Function GlobalAddAtom Lib "kernel32" Alias "GlobalAddAtomA" (ByVal lpString As String) As Integer

Private Declare Function GlobalDeleteAtom Lib "kernel32" (ByVal nAtom As Integer) As Integer

Private Const MOD_ALT = &H1

Private Const MOD_CONTROL = &H2

Private Const MOD_SHIFT = &H4



'□ＡＰＩ関数 

Public Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long

Public Declare Function CallWindowProc Lib "user32" Alias "CallWindowProcA" (ByVal lpPrevWndFunc As Long, ByVal hwnd As Long, ByVal Msg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long



'□SetWindowLongで使用 

Private Const GWL_WNDPROC = -4



'□メッセージ 

Private Const WM_CONTEXTMENU = &H7B '右クリック 

Private Const WM_HOTKEY = &H312



'□コレクション すべてウィンドウハンドルがキー 

Dim colDProc As Collection '現在サブクラス化されているコントロールの元のWindowsProcのアドレス 

Dim HotKeyID As Long



Dim m_BaseForm As Form



'■WindowProc 

'■機能：メッセージを横取りする。 

'■備考：この関数はコールバック関数なので定義を変えてはいけない！ 

Public Function HotKeyProc(ByVal hwnd As Long, ByVal uMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long



    Dim DefaultProc As Long



    Select Case uMsg

        Case WM_HOTKEY

            m_BaseForm.GotHotkey

    End Select



CONTINUE:

    '引当のWindowProcへメッセージを回す。 

    DefaultProc = colDProc(CStr(hwnd))

    HotKeyProc = CallWindowProc(DefaultProc, hwnd, uMsg, wParam, lParam)

End Function



'■BeginSubClass 

'■機能：サブクラス化を開始する。 

Private Sub BeginHotKeyWatch(oControl As Object)



    Static bAlready As Boolean

    Dim DefaultProc As Long



    If Not bAlready Then

        Set colDProc = New Collection

        bAlready = True

    End If



    'サブクラス化実行 

    DefaultProc = SetWindowLong(oControl.hwnd, GWL_WNDPROC, AddressOf HotKeyProc)



    '元のWindowProcのアドレスを保存 

    colDProc.Add DefaultProc, CStr(oControl.hwnd)



End Sub

'■EndSubClass 

'■機能：サブクラス化を終了します。 

Private Sub EndHotKeyWatch(oControl As Object)



    Dim ret As Long

    Dim DefaultProc As Long



    'WindowProcのアドレスを元に戻す。 

    DefaultProc = colDProc(CStr(oControl.hwnd))

    ret = SetWindowLong(oControl.hwnd, GWL_WNDPROC, DefaultProc)

    colDProc.Remove CStr(oControl.hwnd)



End Sub



Public Function CreateHotKey(BaseForm As Form, ByVal HotKeyName As String, ByVal Shift As Integer, ByVal lVKey As Long) As Long

    

    Dim nID     As Long

    Dim IsShift As Boolean

    Dim IsCtrl  As Boolean

    Dim IsAlt   As Boolean

    Dim fsModifiers As Long

    

    IsShift = Shift And vbShiftMask

    IsCtrl = Shift And vbCtrlMask

    IsAlt = Shift And vbAltMask

    

    fsModifiers = IIf(IsShift, MOD_SHIFT, 0) + IIf(IsCtrl, MOD_CONTROL, 0) + IIf(IsAlt, MOD_ALT, 0)

    

    HotKeyID = GlobalAddAtom(HotKeyName)

    Call RegisterHotKey(BaseForm.hwnd, nID, fsModifiers, lVKey)

    CreateHotKey = HotKeyID

    Set m_BaseForm = BaseForm

    

    Call BeginHotKeyWatch(BaseForm)

    

End Function



Public Sub DeleteHotKey(BaseForm As Form)



    Call EndHotKeyWatch(BaseForm)



    Call UnregisterHotKey(BaseForm.hwnd, HotKeyID)

    Call GlobalDeleteAtom(HotKeyID)

    

End Sub

Private Sub Form_Load()



    'Ctrl + N が押されたらGotHotKeyプロシージャを呼び出すように設定する 

    CreateHotKey Me, "MyHoykey", vbCtrlMask, vbKeyN



End Sub



Public Sub GotHotkey()



    Me.WindowState = vbNormal

    

End Sub



Private Sub Form_Unload(Cancel As Integer)



    DeleteHotKey Me



End Sub