We need you!

We're working hard on the next version of Developer Fusion. Let us know what you think we should be up to!

Members

Technology Zones

Articles

Hosted By

MaximumASP

Info

Rated
Read 17,302 times

Related Categories

Subclassing Example

A basic subclassing example - be warned, do NOT press Stop, or debug the WindowProc procedure when running this example!

First, add a textbox called txtStatus, a label called lblPopup, and a menu containing at least one item called mnuTest. Next, add the code below

Option Explicit
'// form_load event. Catch all those messages!
Private Sub Form_Load()
    Dim lhSysMenu As Long, lRet As Long
    On Error Resume Next
    '// saves the previous window message handler. Always restore this value
    '// AddressOf command sends the address of the WindowProc procedure
    '// to windows
    ProcOld = SetWindowLong(hWnd, GWL_WNDPROC, AddressOf WindowProc)
    Show
End Sub

'// form_queryunload event. Return control to windows/vb
Private Sub Form_Unload(Cancel As Integer)
    '// give message processing control back to VB
    '// if you don'//t do this you WILL crash!!!
    Call SetWindowLong(hWnd, GWL_WNDPROC, ProcOld)
End Sub

Private Sub lblPopup_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
    If Button = vbRightButton Then
        PopupMenu mnuTest
    End If
End Sub

Finally, add this code to a module, run your project, and try clicking, activating the app, and right clicking on the label.

Option Explicit
'// windows api constants
'// variable that stores the previous message handler
Public ProcOld As Long
Const WM_NCRBUTTONDOWN = &HA4
Const WM_NCLBUTTONDBLCLK = &HA3

Const WM_NCPAINT = &H85
Const WM_NCACTIVATE = &H86

Const WM_INITMENU = &H116
Const WM_INITMENUPOPUP = &H117
Const WM_MENUSELECT = &H11F

Const WM_ENTERIDLE = &H121

Public Const WM_EXITSIZEMOVE = &H232
Public Const GWL_WNDPROC = (-4)
'// Windows API Call for catching messages
Public Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hWnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
'// Windows API call for calling window procedures
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
Private Sub SetText(strText As String)
    frmExample.txtStatus.Text = frmExample.txtStatus.Text & vbCrLf & strText
    frmExample.txtStatus.SelStart = Len(frmExample.txtStatus.Text)
End Sub
Public Function WindowProc(ByVal hWnd As Long, ByVal iMsg As Long, _
ByVal wParam As Long, ByVal lParam As Long) As Long
    '// ----WARNING----
    '// do not attempt to debug this procedure!!
    '// ----WARNING----

    '// this is our implementation of the message handling routine
    '// determine which message was recieved
    Select Case iMsg
    Case WM_NCACTIVATE
        SetText "NCACTIVATE"

    Case WM_NCPAINT
        SetText "NCPAINT"
       
    Case WM_INITMENU
        '// title bar double clicked
        SetText "INITMENU"
    Case WM_INITMENUPOPUP
        SetText "INITMENUPOPUP"
    Case WM_MENUSELECT
        SetText "MENUSELECT"
   
    Case WM_ENTERIDLE
        'SetText "ENTERIDLE" '// too many occurances
   
    Case WM_NCLBUTTONDBLCLK
        '// title bar double clicked
        SetText "NCLBUTTONDBLCLK"
    Case WM_NCRBUTTONDOWN
        '// title bar right clicked
        SetText "NCRBUTTONDOWN"

    Case WM_EXITSIZEMOVE
        '// window moved
        SetText "EXITSIZEMOVE"
    End Select
    '// pass all messages on to VB and then return the value to windows
    WindowProc = CallWindowProc(ProcOld, hWnd, iMsg, wParam, lParam)
End Function

James first started writing tutorials on Visual Basic in 1999 whilst starting this website (then known as VB Web). Since then, the site has grown rapidly, and James has written numerous tutorials, articles and reviews on VB, PHP, ASP and C#. In October 2003, James formed the company Developer Fusion Ltd, which owns this website, and also offers various development services. In his spare time, he's a 3rd year undergraduate studying Computer Science in the UK. He's also a Visual Basic MVP.

Comments