Subclassing in Visual Basic is the processing of intercepting Windows messages that a Visual Basic program normally wouldn’t receive. Here is how we can subclass a form with VB6.
Module
'==============inside a MODULE
Option Explicit
'************************************************************
'API
'************************************************************
Private Declare Function CallWindowProc Lib "user32.dll" 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.dll" Alias "SetWindowLongA" ( _
ByVal hWnd As Long, _
ByVal nIndex As Long, _
ByVal dwNewLong As Long) As Long
'************************************************************
'Constants
'************************************************************
Private Const GWL_WNDPROC = -4
Private Const WM_MOUSEMOVE = &H200
'************************************************************
'Variables
'************************************************************
Private hControl As Long
Private lPrevWndProc As Long
'*************************************************************
'WindowProc
'*************************************************************
Private Function WindowProc(ByVal lWnd As Long, ByVal lMsg As Long, _
ByVal wParam As Long, ByVal lParam As Long) As Long
'Selects which messages you want to detect
Select Case lMsg
'Example:
Case WM_MOUSEMOVE
Form1.Label1.Caption = "MouseMove(" & lMsg & ") Buttons=" & wParam & _
" Y=" & (lParam Mod 65536) & " X=" & (lParam \ 65535)
End Select
'Sends message to previous procedure
'This is VERY IMPORTANT!!!
WindowProc = CallWindowProc(lPrevWndProc, lWnd, lMsg, wParam, lParam)
End Function
'*************************************************************
'Hook
'*************************************************************
Public Sub Hook(ByVal hControl_ As Long)
hControl = hControl_
lPrevWndProc = SetWindowLong(hControl, GWL_WNDPROC, AddressOf WindowProc)
End Sub
'*************************************************************
'Unhook
'*************************************************************
Public Sub Unhook()
Call SetWindowLong(hControl, GWL_WNDPROC, lPrevWndProc)
End Sub
Usage
'Create a Form with a label
Option Explicit
'===========inside a form
'*************************
'USAGE
'*************************
Private Sub Form_Load()
Hook Form1.hWnd
End Sub
Private Sub Form_Unload(Cancel As Integer)
Unhook
End Sub