Using messages - MENU STATUS

Another example is giving status messages when the mouse cursor is over a menu item. This time, windows sends a WM_MENUSELECT message. Make sure your Form is named Form1 and you have a label called lblSel before starting.

'// extra constants and windows api
Public Const MF_BYCOMMAND = &H0&
Public Const MF_BYPOSITION = &H400&
Public Const MF_POPUP = &H10&
Public Const WM_MENUSELECT = &H11F

Declare Function GetMenuString Lib "user32" Alias "GetMenuStringA" (ByVal hMenu As Long, ByVal wIDItem As Long, ByVal lpString As String, ByVal nMaxCount As Long, ByVal wFlag As Long) As Long

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
        '// This occurs when the menu is being closed
        If lParam = 0 Then Exit Function
        '// variables
        Dim MenuItemStr As String * 128
        Dim MenuHandle As Integer
        '// Get the low word from wParam: this contains the command ID or position of the menu entry
        MenuHandle = GetLowWord(wParam)
        '//If the highlighted menu is the top of a poup menu, pass menu item by position
        If (GetHighWord(wParam) And MF_POPUP) = MF_POPUP Then
            '//Get the caption of the menu item
            If GetMenuString(lParam, MenuHandle, MenuItemStr, 127, MF_BYPOSITION) = 0 Then Exit Function
        Else '// Otherwise pass it by command ID
            '//Get the caption of the menu item
            If GetMenuString(lParam, MenuHandle, MenuItemStr, 127, MF_BYCOMMAND) = 0 Then Exit Function
        End If
        '// return item to label to remove any nulls
        Form1.lblSelItem = MenuItemStr
        '// display a message in a label
        Select Case Form1.lblSelItem
        Case "Item 1"
            Form1.lblSelItem = "Adds a Font"
        Case Else
             Form1.lblSelItem = "Item Unknown: " & Form1.lblSelItem
        End Select
    Case Else
        '// pass all messages on to VB and then return the value to windows
        WindowProc = CallWindowProc(procOld, hWnd, iMsg, wParam, lParam)
    End Select
End Function

Public Function GetLowWord(Word As Long)
   GetLowWord = CInt("&H" & Right$(Hex$(Word), 4))
End Function

Public Function GetHighWord(Word As Long)
    GetHighWord = CInt("&H" & Left$(Hex$(Word), 4))
End Function

You might also like...


About the author

James Crowley

James Crowley United Kingdom

James first started this website when learning Visual Basic back in 1999 whilst studying his GCSEs. The site grew steadily over the years while being run as a hobby - to a regular monthly audien...

Interested in writing for us? Find out more.


Why not write for us? Or you could submit an event or a user group in your area. Alternatively just tell us what you think!

Our tools

We've got automatic conversion tools to convert C# to VB.NET, VB.NET to C#. Also you can compress javascript and compress css and generate sql connection strings.

“Brevity is the soul of wit” - Shakespeare