More Menu Help

[cjwares]

Is there any way to make it so when your mouse is hovered over an item in a menu, you could say... have it say something in a statusbar? like a brief description. please help

[Serge]

Sure!

Module Code

Type MENUITEMINFO
    cbSize As Long
    fMask As Long
    fType As Long
    fState As Long
    wID As Long
    hSubMenu As Long
    hbmpChecked As Long
    hbmpUnchecked As Long
    dwItemData As Long
    dwTypeData As String
    cch As Long
End Type

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
Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (hpvDest As Any, hpvSource As Any, ByVal cbCopy As Long)
Declare Function GetMenu Lib "user32" (ByVal hwnd As Long) As Long
Declare Function GetMenuItemInfo Lib "user32" Alias "GetMenuItemInfoA" (ByVal hMenu As Long, ByVal un As Long, ByVal b As Boolean, lpMenuItemInfo As MENUITEMINFO) As Long
Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
    
Public Const GWL_WNDPROC = (-4)
Public Const WM_MENUSELECT = &H11F
Public Const MF_SYSMENU = &H2000&
Public Const MIIM_TYPE = &H10
Public Const MIIM_DATA = &H20

Public glOrigWndProc As Long

Public Function AppWndProc(ByVal hwnd As Long, ByVal Msg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
    Dim iHi As Integer, iLo As Integer
    Dim m As MENUITEMINFO, aCap As String
    
    Select Case Msg
        Case WM_MENUSELECT
            Form1.StatusBar1.Panels(1).Text = ""
            CopyMemory iLo, wParam, 2
            CopyMemory iHi, ByVal VarPtr(wParam) + 2, 2
            If (iHi And MF_SYSMENU) = 0 Then
                m.dwTypeData = Space(64)
                m.cbSize = Len(m)
                m.cch = 64
                m.fMask = MIIM_DATA Or MIIM_TYPE
                If GetMenuItemInfo(lParam, CLng(iLo), False, m) Then
                    aCap = m.dwTypeData & vbNullChar
                    aCap = Left$(aCap, InStr(aCap, vbNullChar) - 1)
                    If GetMenu(hwnd) <> lParam Then
                        Select Case aCap
                            Case "&Open": Form1.StatusBar1.Panels(1).Text = "Open a file"
                            Case "&Save": Form1.StatusBar1.Panels(1).Text = "Save a file"
                            Case Else: Form1.StatusBar1.Panels(1).Text = aCap
                        End Select
                    Else
                        Form1.StatusBar1.Panels(1).Text = "Top level menu item - " & aCap
                    End If
                End If
            End If
    End Select
    AppWndProc = CallWindowProc(glOrigWndProc, hwnd, Msg, wParam, lParam)
End Function

Form Code

Private Sub Form_Load()
    glOrigWndProc = SetWindowLong(Me.hwnd, GWL_WNDPROC, AddressOf AppWndProc)
End Sub


Private Sub Form_Unload(Cancel As Integer)
    SetWindowLong hwnd, GWL_WNDPROC, glOrigWndProc
End Sub

Assuming that you have top menu called File and 2 sub menus called Open and Save.

------------------

Serge

Software Developer
[email protected]
[email protected]
ICQ#: 51055819