Create a Hotkey for your Application

As with many operations in Visual Basic, we are going to
use the SendMessage API call. This time we will implement the WM_SETHOTKEY constant. Just
to remind you that the WM_ part stands for Windows Message. The SendMessage API call looks
like this:

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

• hwnd – The window handle of the object that you are sending the message to.
• wMsg – The message that you are sending, usually a constant.
• wParam – Additional info about the message.
• lParam – Additional info about the message.

We can use this message to send the
WM_SETHOTKEY constant and other info that will include the key(s) needed to provoke our
operation. The problem is that we can’t (using this code anyway) catch when the keys are
pressed. The default hotkey operation just activates the window referenced through its
window handle. We can employ a little workaround here by subclassing the form to catch the
windows activation. For this we need to use VB5’s AddressOf operator to reference the
address of our window handler. We can now track when our window receives the focus
and then fire up our own procedure for doing something. I won’t go through the subclassing
code, because it is pretty standard.

Anyway, that should be all you need to know for this “how to”. Just
to say that a call to your procedure (when the hotkey has been pressed) should be placed
in the WindowProc function.

Add a new form and draw on a command button
(cmdEnd). Copy the following code into the form:

Option Explicit

Private Declare Function SendMessage Lib_
  "user32" _
  Alias "SendMessageA"_
  (ByVal hwnd As Long, _
  ByVal wMsg As Long, ByVal wParam_
  As Long, lParam As Long) As Long

Private Const WM_SETHOTKEY = &H32
'// Shift + A
Private Const HK_SHIFTA = &H141
'// Shift * B
Private Const HK_SHIFTB = &H142
'// Control + A
Private Const HK_CONTROLA = &H241
Private Const HK_ALTZ = &H45A

Private Sub cmdEnd_Click()
Unload Me
End Sub

Private Sub Form_Load()
'// Start subclassing the form
Subclass Me.hwnd

'// Assign our hotkey
SendMessage Me.hwnd, WM_SETHOTKEY,_
  HK_ALTZ, 0
End Sub

Private Sub Form_Unload(Cancel As Integer)
'// End subclassing unless you want 
'// abnormal effects on the system
UnSubclass Me.hwnd
End Sub

Add a new module (modSubclass) and copy
the following code into it:

Option Explicit

Public Declare Function SetWindowLong_
  Lib "user32" _
  Alias "SetWindowLongA" _
 (ByVal hwnd As Long, _
  ByVal nIndex As Long, _
  ByVal wNewWord 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

Public Const GWL_WNDPROC As Long = (-4)
Public Const WM_ACTIVATE As Long = &H6
Public Const WM_ACTIVATEAPP As Long = &H1C
Public Const WA_INACTIVE As Long = 0
Public Const WA_ACTIVE As Long = 1
Public Const WA_CLICKACTIVE As Long = 2

'// This variable holds the previous window 
'// procedure's address so that we can pass 
'// messages back to it.
Public OldProc As Long

'// This flag tells us whether we are 
'// currently subclassing the form.
Public blnSubclassed As Boolean

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

'// This function handles messages sent
'// to our form

On Error Resume Next

Select Case uMsg

  Case WM_ACTIVATEAPP
    Select Case LoWord(wParam)
      '// Only message that we want to handle
      '// Tells us that the form has been activated
      Case WA_ACTIVE
        '// Carry out your function/procedure here
      Case Else
    End Select
  Case Else
End Select

'// Check if we are subclassing
If blnSubclassed = True Then
'// Pass any messages on to the old window procedure
 WndProc = CallWindowProc(OldProc, _
   hwnd, uMsg, wParam, ByVal lParam)
Else
 blnSubclassed = False
End If
 
End Function

Public Sub UnSubclass(hwnd As Long)
'// Check if we have actually implemented our
'// window procedure
If OldProc Then
  '// If so then pass control back
  SetWindowLong hwnd, GWL_WNDPROC, OldProc
  OldProc = 0
End If
End Sub

Public Sub Subclass(hwnd As Long)
On Error Resume Next

'// Get the address of our window procedure 
'// and make it the default for our form
OldProc = SetWindowLong(hwnd, GWL_WNDPROC,_
  AddressOf WndProc)
End Sub

'// Function by Randy Birch: 
'// http://www.mvps.org/vbnet
Public Function LoWord(dw As Long) As Integer
If dw And &H8000 Then
  LoWord = &H8000 Or (dw And &H7FFF&)
Else
  LoWord = dw And &HFFF&
End If
End Function