Visual Basic Subclassing Routines
WM_HOTKEY: System-Wide Keyboard Trapping
     
Posted:   Friday July 16, 1999
Updated:   Monday December 26, 2011
     
Applies to:   VB5, VB6
Developed with:   VB6, Windows NT4
OS restrictions:   None
Author:   VBnet - Randy Birch
     
 Prerequisites
VB5 or VB6.

registerhotkey.gif (6653 bytes)As VB development expands from its origins as a small-utilities tool into its now-mature role as the tool for large scale production applications, developers rightfully ask for more intrinsic functionality formerly only available in lower languages.

One of these requests has been for a method to define and trap specific system-wide keystrokes. Here we demo how to perform this feat using the RegisterHotKey API.

RegisterHotKey is explained in the MSDN with the following Remarks:

  • When a key is pressed, the system looks for a match against all hot keys. Upon finding a match, the system posts the WM_HOTKEY message to the message queue of the thread that registered the hot key. This message is posted to the beginning of the queue so it is removed by the next iteration of the message loop.
  • This function cannot associate a hot key with a window created by another thread.
  • RegisterHotKey fails if the keystrokes specified for the hot key have already been registered by another hot key.
  • If the window identified by the hWnd parameter already registered a hot key with the same identifier as that specified by the id parameter, the new values for the fsModifiers and vk parameters replace the previously specified values for these parameters.  .

As the above implies, RegisterHotKey is not limited to providing just system-wide keypress data. A registered hotkey can also used simply to perform a method solely within the application not available via menu accelerators. In this context however, it would be prudent for the developer to unhook the key when the application looses focus to another outside application, and restore it when focus returns. This can be easily achieved by implementing the code detailed in the page Subclassing Form Messages: WM_ACTIVATEAPP: Detect Application Activation State.

The basic code in this article was provided to me without indication of the author. If you know who should get credit, please let me know via the Comments option.

 Class Code
Add the following code to a Class module (CGlobalAtom).:

Option Explicit
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Copyright 1996-2011 VBnet/Randy Birch, All Rights Reserved.
' Some pages may also contain other copyrights by the author.
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Distribution: You can freely use this code in your own
'               applications, but you may not reproduce 
'               or publish this code on any web site,
'               online service, or distribute as source 
'               on any media without express permission.
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Private m_AtomID As Long


Private Sub Class_Initialize()
    
    m_AtomID = GlobalAddAtom(CStr(Now))
    
End Sub


Private Sub Class_Terminate()

    Call GlobalDeleteAtom(m_AtomID)

End Sub


Public Property Get Value() As Long

    Value = m_AtomID

End Property
 BAS Module Code
Place the following code into the general declarations area of a bas module:

Option Explicit
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Copyright 1996-2011 VBnet/Randy Birch, All Rights Reserved.
' Some pages may also contain other copyrights by the author.
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Distribution: You can freely use this code in your own
'               applications, but you may not reproduce 
'               or publish this code on any web site,
'               online service, or distribute as source 
'               on any media without express permission.
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'used by the RegisterHotKey method
Public Enum RegisterHotKeyModifiers
   MOD_ALT = &H1
   MOD_CONTROL = &H2
   MOD_SHIFT = &H4
End Enum

Public Declare Function RegisterHotKey Lib "user32" _
  (ByVal hWnd As Long, _
   ByVal id As Long, _
   ByVal fsModifiers As RegisterHotKeyModifiers, _
   ByVal vk As KeyCodeConstants) As Long
   
Public Declare Function UnregisterHotKey Lib "user32" _
  (ByVal hWnd As Long, _
   ByVal id As Long) As Long

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

Private 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
   
Private 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 As Long = (-4)
Public Const WM_HOTKEY As Long= &H312

Public lpPrevWndProc As Long

'used by the PrintScreen method
Public Declare Function BitBlt Lib "gdi32" _
  (ByVal hDCDest As Long, ByVal XDest As Long, _
   ByVal YDest As Long, ByVal nWidth As Long, _
   ByVal nHeight As Long, ByVal hDCSrc As Long, _
   ByVal XSrc As Long, ByVal YSrc As Long, _
   ByVal dwRop As Long) As Long

Public Declare Function GetDesktopWindow Lib "user32" () As Long

Public Declare Function GetWindowDC Lib "user32" _
   (ByVal hWnd As Long) As Long

Public Declare Function ReleaseDC Lib "user32" _
  (ByVal hWnd As Long, _
   ByVal hdc As Long) As Long
   
   
Public Sub Hook(ByVal gHW As Long)

  'Establish a hook
   lpPrevWndProc = SetWindowLong(gHW, GWL_WNDPROC, AddressOf WindowProc)

End Sub


Public Sub Unhook(ByVal gHW As Long)

  'Reset the message handler
   Call SetWindowLong(gHW, GWL_WNDPROC, lpPrevWndProc)
   
End Sub


Function WindowProc(ByVal hWnd As Long, ByVal uMsg As Long, _
                    ByVal wParam As Long, ByVal lParam As Long) As Long

   Select Case hWnd
   
      Case frmMain.hWnd
   
         If uMsg = WM_HOTKEY Then
         
           'add code to process the Hotkey
            frmMain.Caption = "Hotkey Pressed
            PrintScreen
         
         End If
         
      Case Else
      
   End Select
   
   
  'Pass message to the original window message handler
   WindowProc = CallWindowProc(lpPrevWndProc, hWnd, uMsg, wParam, lParam)
   
End Function


Private Sub PrintScreen()

  Dim hWndDesk As Long
  Dim hDCDesk As Long

  Dim LeftDesk As Long
  Dim TopDesk As Long
  Dim WidthDesk As Long
  Dim HeightDesk As Long
   
 'define the screen coordinates (upper
 'corner (0,0) and lower corner (Width, Height)
  LeftDesk = 0
  TopDesk = 0
  WidthDesk = Screen.Width \ Screen.TwipsPerPixelX
  HeightDesk = Screen.Height \ Screen.TwipsPerPixelY
   
 'get the desktop handle and display context
  hWndDesk = GetDesktopWindow()
  hDCDesk = GetWindowDC(hWndDesk)
   
 'copy the desktop to the picture box
  Call BitBlt(frmMain.Picture1.hdc, 0, 0, _
             WidthDesk, HeightDesk, hDCDesk, _
             LeftDesk, TopDesk, vbSrcCopy)

  Call ReleaseDC(hWndDesk, hDCDesk)

End Sub
 Form Code
To a form, add a three-button control array (Command1(0) - Command1(2)) and a picture box (Picture1). Add the following code:

Option Explicit

Private GlobalAtom As CGlobalAtom
Private IsTrapping As Boolean

'command button index consts
Private Const nTrap = 0
Private Const nStop = 1
Private Const nClear = 2

Private Sub Form_Load()

   UpdateInfo
   
End Sub


Private Sub Form_Unload(Cancel As Integer)

   If IsTrapping Then
      Command1(nStop).Value = True
   End If
   
End Sub


Private Sub UpdateInfo()

   Caption = IIf(IsTrapping, "Trapping Print Screen", "Trapping Off")
   
   Command1(0).Enabled = IsTrapping = False
   Command1(1).Enabled = IsTrapping = True
   
End Sub


Private Sub Command1_Click(index As Integer)

   Select Case index
      Case nTrap 'begin trapping
      
         Set GlobalAtom = New CGlobalAtom
         
        'Call procedure to begin capturing messages
         Call Hook(Me.hWnd)
         
        'Trap Print Screen (vbKeySnapshot).
        'API returns 1 if successful, so
        'evaluating to 1 renders true.
         IsTrapping = RegisterHotKey(Me.hWnd, GlobalAtom.Value, 0, vbKeySnapshot) = 1
      
      Case nStop 'end trapping
      
        'API returns 1 if successful, so
        'evaluating to 0 renders False.
         IsTrapping = UnregisterHotKey(Me.hWnd, GlobalAtom.Value) = 0
         
         Call Unhook(Me.hWnd)
         
      Case nClear  'clear the pix and clipboard
      
         Clipboard.Clear
         Picture1.Cls
      
   End Select
   
   UpdateInfo
   
End Sub
 Comments
Remember this is a subclassed project, so be sure to save before running, and always "Start with Full Compile" to catch any errors.

Once running, pressing the Trap button will register the vbKeySnapshot key with your application.  Pressing the Print Screen key will fill the picture box with the screen shot. The clear button clears both the clipboard and the pixbox.  Other PrintScreen API methods can be found on the VBnet Bitmap pages.

Feel free to change the print screen vbKeySnapshot to any other key constant - ie vbKeyF6 in the Command1_Click event.


 
 

PayPal Link
Make payments with PayPal - it's fast, free and secure!

 
 
 
 

Copyright 1996-2011 VBnet and Randy Birch. All Rights Reserved.
Terms of Use  |  Your Privacy

 

Hit Counter