October 21, 2018
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.

By submitting your information, you agree that developer.com may send you developer offers via email, phone and text message, as well as email offers about other products and services that developer believes may be of interest to you. developer will process your information in accordance with the Quinstreet Privacy Policy.


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