May 26, 2019
Hot Topics:

Create a Hotkey for your Application

  • November 20, 2002
  • 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

Comment and Contribute


(Maximum characters: 1200). You have characters left.



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