Visual Basic Tips

ホットキーの実装(API)

ＩＤの取得にはGlobalAddAtom関数を使用してアトムを求めています。直接”１”とかＩＤを指定しても動作しました。ただヘルプをみるとGlobalAddAtom関数を使用して取得しろ！と書いてあるので他のアプリケーションとの競合を避けるためにも、その方がいいんでしょうね。
サンプルではControl+Shift+F1,Control+Shift+F2でメッセージボックスを出力しています。

Private Sub Form_Load()
　　'アトムの取得
　　gintAtom1 = GlobalAddAtom("HOTKEY1")
　　gintAtom2 = GlobalAddAtom("HOTKEY2")

　　'一つ目のホットキーを登録
　　Call RegisterHotKey(Me.hwnd, gintAtom1, MOD_CONTROL Or MOD_SHIFT, VK_F1)
　　'二つ目のホットキーを登録
　　Call RegisterHotKey(Me.hwnd, gintAtom2, MOD_CONTROL Or MOD_SHIFT, VK_F2)

　　Call Hook(Me.hwnd)
End Sub

Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer)
　　'一つ目のホットキーを削除
　　Call UnregisterHotKey(Me.hwnd, gintAtom1)
　　'二つ目のホットキーを削除
　　Call UnregisterHotKey(Me.hwnd, gintAtom2)

　　'アトムの破棄
　　Call GlobalDeleteAtom(gintAtom1)
　　Call GlobalDeleteAtom(gintAtom2)

　　Call UnHook(Me.hwnd)
End Sub

'-------------------------------------------------------
' Module
'-------------------------------------------------------
Public Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
Public Const GWL_WNDPROC = (-4)

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

Public Declare Function GlobalAddAtom Lib "kernel32" Alias "GlobalAddAtomA" (ByVal lpString As String) As Integer
Public Declare Function GlobalDeleteAtom Lib "kernel32" (ByVal nAtom As Integer) As Integer

Public Declare Function RegisterHotKey Lib "user32" (ByVal hwnd As Long, ByVal id As Long, ByVal fsModifiers As Long, ByVal vk As Long) As Long
Public Declare Function UnregisterHotKey Lib "user32" (ByVal hwnd As Long, ByVal id As Long) As Long
Public Const WM_HOTKEY = &H312

Public Const VK_F1 = &H70
Public Const VK_F2 = &H71
Public Const VK_F3 = &H72
Public Const VK_F4 = &H73
Public Const VK_F5 = &H74
Public Const VK_F6 = &H75
Public Const VK_F7 = &H76
Public Const VK_F8 = &H77
Public Const VK_F9 = &H78
Public Const VK_F10 = &H79
Public Const VK_F11 = &H7A
Public Const VK_F12 = &H7B
Public Const VK_F13 = &H7C
Public Const VK_F14 = &H7D
Public Const VK_F15 = &H7E
Public Const VK_F16 = &H7F
Public Const VK_F17 = &H80
Public Const VK_F18 = &H81
Public Const VK_F19 = &H82
Public Const VK_F20 = &H83
Public Const VK_F21 = &H84
Public Const VK_F22 = &H85
Public Const VK_F23 = &H86
Public Const VK_F24 = &H87

Public Const MOD_ALT = &H1
Public Const MOD_CONTROL = &H2
Public Const MOD_SHIFT = &H4

Public gintAtom1 As Integer
Public gintAtom2 As Integer

Public ghWnd As Long
'-------------------------------------------------------
'
'-------------------------------------------------------
Public Function WndProc(ByVal hwnd As Long, ByVal uMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
　　Static bolWndProcCheck As Boolean

　　If Not bolWndProcCheck Then
　　　　bolWndProcCheck = True
　　　　Select Case uMsg
　　　　　　Case WM_HOTKEY
　　　　　　　　Select Case wParam
　　　　　　　　　　　Case gintAtom1: MsgBox "一つ目のホットキーが押下されました！"
　　　　　　　　　　　Case gintAtom2: MsgBox "二つ目のホットキーが押下されました！"
　　　　　　　　End Select
　　　　End Select
　　　　bolWndProcCheck = False
　　End If
　　WndProc = CallWindowProc(ghWnd, hwnd, uMsg, wParam, lParam)
End Function

Public Sub Hook(hwnd As Long)
　　ghWnd = SetWindowLong(hwnd, GWL_WNDPROC, AddressOf WndProc)
End Sub

Public Sub UnHook(hwnd As Long)
　　Dim lngret As Long
　　If ghWnd <> 0 Then
　　　　lngret = SetWindowLong(hwnd, GWL_WNDPROC, ghWnd)
　　End If
End Sub



DownLoad vbtips092.lzh 3KB (VB6.0)