February 26, 2021
Hot Topics:

Create a Hotkey for your Application

  • By Sam Huggill
  • Send Email »
  • More Articles »

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

    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)
 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&)
  LoWord = dw And &HFFF&
End If
End Function

Page 3 of 3

This article was originally published on November 20, 2002

Enterprise Development Update

Don't miss an article. Subscribe to our newsletter below.

Thanks for your registration, follow us on our social networks to keep up-to-date