What's New
Q & A
Tip Jar
C# Helper...
Follow VBHelper on Twitter
MSDN Visual Basic Community
TitleList distinct messages received by a form in Visual Basic 6
DescriptionThis example shows how to list distinct messages received by a form in Visual Basic 6.
KeywordsWndProc, messages, list messages, WindowProc, subclass, VB6
CategoriesAPI, Miscellany, Tips and Tricks
In Visual Basic 6 it's not too hard to subclass to see what messages an object receives. Unfortunately many objects such as forms receive hundreds or thousands of messages so it's hard to find what you're interested in the flood.

This example overcomes this problem by making a static collection and keeping track of the distinct kinds of messages it has seen. When it encounters a message that it has not seen before, it adds the message to its collection and displays information about the message in the Immediate window.

Subroutine LoadMsgNames loads a bunch of message names into a collection. Function MsgName looks up a message's name.

The new WindowProc determines whether the message is a new one. If the message is new, the code adds it to its collection and then uses these routines to display information about the message.

Public MsgNames As New Collection

Public Sub LoadMsgNames()
Static done_before As Boolean

    If done_before Then Exit Sub
    done_before = True
    MsgNames.Add "WM_NULL", "0"
    MsgNames.Add "WM_CREATE", "1"
    MsgNames.Add "WM_DESTROY", "2"
    ' LOTS of code omitted...

End Sub

Public Function MsgName(ByVal num As Long) As String
    On Error Resume Next
    MsgName = MsgNames(Hex$(num))
    If Err.Number = 0 Then Exit Function

    If num >= 0 And num < WM_USER Then
        MsgName = "Range 1 message reserved for Windows"
    ElseIf num >= WM_USER And num <= &H7FFF Then
        MsgName = "Reserved for private window classes"
    ElseIf num >= &H8000 And num <= &HBFFF Then
        MsgName = "Range 3 message reserved for Windows"
    ElseIf num >= &H8000 And num <= &HBFFF Then
        MsgName = "String message for use by applications"
        MsgName = "Unknown message" & Str$(num)
    End If
End Function

' Display message names.
Public Function NewWindowProc(ByVal hwnd As Long, ByVal msg _
    As Long, ByVal wParam As Long, ByVal lParam As Long) As _
Static messages As New Collection

    ' Load the message names.

    ' See if we've seen this message before.
    On Error Resume Next
    Dim old_msg As Long
    old_msg = messages(Format$(msg))
    If Err.Number <> 0 Then
        ' This is a new one.
        ' Save it for next time.
        messages.Add msg, Format$(msg)

        ' Display the message's name.
        Debug.Print Hex$(msg) & ": " & MsgName(msg)
    End If
    On Error Resume Next

    ' If we're being destroyed,
    ' restore the original WindowProc.
    If msg = WM_NCDESTROY Then
        SetWindowLong _
            hwnd, GWL_WNDPROC, _
    End If

    NewWindowProc = CallWindowProc( _
        OldWindowProc, hwnd, msg, wParam, _
End Function
Copyright © 1997-2006 Rocky Mountain Computer Consulting, Inc.   All rights reserved.