Projects

Winpopup Plus

November 23, 2002 by Java

Browsing MenuHelpMod.bas (3.92 KB)

Attribute VB_Name = "MenuHelpMod"
Option Explicit

Private Const GWL_WNDPROC As Long = (-4)
Private Const WM_GETMINMAXINFO As Long = &H24
Private Const WM_MENUSELECT As Long = &H11F

Private Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
Private Declare Function CallWindowProc Lib "user32" Alias "CallWindowProcA" (ByVal lpPrevWndFunc As Long, ByVal hwnd As Long, ByVal uMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long

Public 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

Private SubClassObject As Long
Private OldWindowProc As Long



Public Sub EndMenuHelp()
UnSubClass SubClassObject, OldWindowProc
End Sub

Private Sub ShowMenuInfo(ByVal MenuInfo As String)
Dim Panel As Object
    For Each Panel In PopupForm.StatusBar1.Panels()
        If Panel.Index > 1 Then
            If MenuInfo = "" Then
                Panel.Visible = True
            Else
                Panel.Visible = False
            End If
        Else
            If MenuInfo = "" Then
                Panel.Bevel = 1
            Else
                Panel.Bevel = 0
            End If
        End If
    Next Panel
    If MenuInfo = "" Then MenuInfo = "Current message: " & CurrentMsg
    PopupForm.StatusBar1.Panels(1).Text = MenuInfo
End Sub

Public Sub StartMenuHelp(ByVal hwnd As Long)
SubClassObject = hwnd
SubClass SubClassObject
End Sub


Private Sub SubClass(hwnd As Long)
On Error Resume Next
OldWindowProc = SetWindowLong(hwnd, GWL_WNDPROC, AddressOf WindowProc)
End Sub




Private Sub UnSubClass(hwnd As Long, PrevDefProc As Long)
SetWindowLong hwnd, GWL_WNDPROC, PrevDefProc
End Sub


Private Function WindowProc(ByVal hwnd As Long, ByVal uMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
    On Error Resume Next
    If SubClassObject = hwnd Then
        Select Case uMsg
            Case WM_MENUSELECT
                Dim MenuCaption As String
                Dim MenuCaptionLen As Long
                MenuCaption = Space(256)
                MenuCaptionLen = GetMenuString(lParam, wParam And &HFFFF&, MenuCaption, Len(MenuCaption), 0&)
                MenuCaption = Left(MenuCaption, MenuCaptionLen)
                If InStr(MenuCaption, vbTab) > 0 Then MenuCaption = Left(MenuCaption, InStr(MenuCaption, vbTab) - 1)
                Select Case MenuCaption
                    ' PopupForm Menu Items
                    Case PopupForm.SendMenu.Caption: ShowMenuInfo "Sends a message."
                    Case PopupForm.DiscardMenu.Caption: ShowMenuInfo "Deletes the current message."
                    Case PopupForm.PreviousMenu.Caption: ShowMenuInfo "Displays the previous message."
                    Case PopupForm.NextMenu.Caption: ShowMenuInfo "Displays the next message."
                    Case PopupForm.ClearAllMenu.Caption: ShowMenuInfo "Deletes all messages."
                    Case PopupForm.OptionsMenu.Caption: ShowMenuInfo "Contains commands for customizing WinPopup Plus."
                    Case PopupForm.AutoAliasSetupMenu.Caption: ShowMenuInfo "Edit your AutoAlias entries."
                    Case PopupForm.ExitMenu.Caption: ShowMenuInfo "Quits WinPopup Plus."
                    Case PopupForm.EnterUCMenu.Caption: ShowMenuInfo "Enter the unlock code to use all of WinPopup Plus' features."
                    Case PopupForm.AboutMenu.Caption: ShowMenuInfo "Displays program information, version number, and copyright."
                    Case Else: ShowMenuInfo ""
                End Select
            Case WM_GETMINMAXINFO
                WindowProc = 0
                Exit Function
        End Select
        WindowProc = CallWindowProc(OldWindowProc, hwnd, uMsg, wParam, lParam)
    End If
End Function

Download MenuHelpMod.bas

Back to file list

---

Back to project page