[RESOLVED] Modify right-click context menu in standard controls

[LaVolpe]

Ok, here's a working example. Important notes follow the code

1. In a new project, add: 2 command buttons, 1 textbox, 1 module. Leave all controls their default names
2. In the module, paste this:

Option Explicit
Private Declare Function SetWindowsHookEx Lib "user32.dll" Alias "SetWindowsHookExA" (ByVal idHook As Long, ByVal lpfn As Long, ByVal hmod As Long, ByVal dwThreadId As Long) As Long
Private Declare Function UnhookWindowsHookEx Lib "user32.dll" (ByVal hHook As Long) As Long
Public Declare Function CallNextHookEx Lib "user32.dll" (ByVal hHook As Long, ByVal nCode As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
Public Declare Function CallWindowProc Lib "user32.dll" 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 Declare Function SetWindowLong Lib "user32.dll" Alias "SetWindowLongA" (ByVal hWnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
Private Const GWL_WNDPROC = (-4)
Private Const WM_DESTROY As Long = &H2
Private Const WH_CALLWNDPROC As Long = 4

Private m_HookProc As Long
Private m_WndProc As Long
Private m_SubclassedHwnd As Long

Public Function SetSubclass(hWnd As Long) As Boolean
    ' pass zero to stop subclassing
    If hWnd = 0& Then
        If m_SubclassedHwnd <> 0& Then
            If SetWindowLong(m_SubclassedHwnd, GWL_WNDPROC, m_WndProc) <> 0& Then
                m_WndProc = 0&
                SetSubclass = True
            End If
        End If
    Else
        If m_WndProc <> 0& Then Call SetSubclass(0&)
        m_WndProc = SetWindowLong(hWnd, GWL_WNDPROC, AddressOf pvWNDProc)
        If m_WndProc <> 0& Then
            m_SubclassedHwnd = hWnd
            SetSubclass = True
        End If
    End If
End Function

Public Function SetHook(Initiate As Boolean) As Boolean
    ' pass Initiate as False to stop hook
    If Initiate Then
        If m_HookProc = 0& Then
            m_HookProc = SetWindowsHookEx(WH_CALLWNDPROC, AddressOf pvCBTProc, App.hInstance, App.ThreadID)
            SetHook = (m_HookProc <> 0)
        End If
    ElseIf m_HookProc <> 0 Then
        SetHook = (UnhookWindowsHookEx(m_HookProc) <> 0)
        m_HookProc = 0
    End If
End Function

Private Function pvWNDProc(ByVal hWnd As Long, ByVal wMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
    ' subclassing procedure
    If wMsg = WM_DESTROY Then
        m_SubclassedHwnd = 0&
        Call SetWindowLong(hWnd, GWL_WNDPROC, m_WndProc)
        pvWNDProc = CallWindowProc(m_WndProc, hWnd, wMsg, wParam, lParam)
    
    ElseIf m_SubclassedHwnd <> 0& Then
        Dim bSupress As Boolean
        pvWNDProc = Form1.HandleWindowMessage(hWnd, wMsg, wParam, lParam, m_WndProc Or 0&, bSupress)
        If Not bSupress Then pvWNDProc = CallWindowProc(m_WndProc, hWnd, wMsg, wParam, lParam)
    End If
End Function

Private Function pvCBTProc(ByVal nCode As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
    ' hooking procedure
    If nCode < 0& Then
        pvCBTProc = CallNextHookEx(m_HookProc, nCode, wParam, lParam)
    Else
        Dim bSupress As Boolean
        pvCBTProc = Form1.HandleHookMessage(WH_CALLWNDPROC, nCode, wParam, lParam, m_HookProc Or 0&, bSupress)
        If Not bSupress Then pvCBTProc = CallNextHookEx(m_HookProc, nCode, wParam, lParam)
    End If
End Function

3. In the form, paste this:

Option Explicit

Private Declare Sub CopyMemory Lib "kernel32.dll" Alias "RtlMoveMemory" (ByRef Destination As Any, ByRef Source As Any, ByVal Length As Long)
Private Declare Function SendMessage Lib "user32.dll" Alias "SendMessageA" (ByVal hWnd As Long, ByVal wMsg As Long, ByVal wParam As Long, ByRef lParam As Any) As Long
Private Declare Function AppendMenu Lib "user32.dll" Alias "AppendMenuA" (ByVal hMenu As Long, ByVal wFlags As Long, ByVal wIDNewItem As Long, ByVal lpNewItem As Any) As Long
Private Declare Function CreatePopupMenu Lib "user32.dll" () As Long
Private Declare Function DestroyMenu Lib "user32.dll" (ByVal hMenu As Long) As Long
Private Type CWPSTRUCT
    lParam As Long
    wParam As Long
    message As Long
    hWnd As Long
End Type
Private Type CREATESTRUCT
    lpCreateParams As Long
    hInstance As Long
    hMenu As Long
    hWndParent As Long
    cy As Long
    cx As Long
    y As Long
    x As Long
    style As Long
    lpszName As Long
    lpszClass As Long
    ExStyle As Long
End Type
Private Const WM_APP As Long = &H8000&
Private Const MN_GETHMENU As Long = &H1E1
Private Const WM_CONTEXTMENU As Long = &H7B
Private Const WM_CREATE As Long = &H1
Private Const MF_STRING As Long = &H0&
Private Const MF_SEPARATOR As Long = &H800&
Private Const MF_CHECKED As Long = &H8&
Private Const MF_GRAYED As Long = &H1&
Private Const MF_DISABLED As Long = &H2& Or MF_GRAYED
Private Const MF_POPUP As Long = &H10&

Public Function HandleHookMessage(HookType As Long, nCode As Long, wParam As Long, lParam As Long, HookProc As Long, Supress As Boolean) As Long
    ' called from the module for each hook message
    Static hMenuOwner As Long
    
    If nCode = 0& Then                      ' must handle
        Dim CWP As CWPSTRUCT
        CopyMemory CWP, ByVal lParam, 16&   ' get structure
        Select Case CWP.message             ' test a couple messages
        Case WM_CREATE
            Dim CS As CREATESTRUCT          ' window being created
            CopyMemory CS, ByVal CWP.lParam, Len(CS)
            If CS.lpszClass = 32768 Then    ' is it #32768 (32768 is Atom)
                hMenuOwner = CWP.hWnd       ' cache window handle
            End If
        Case MN_GETHMENU                    ' we are sending this; ignore it
        Case Else
            If CWP.hWnd = hMenuOwner Then   ' message for #32768?
                If hMenuOwner <> 0 Then     ' got a menu handle yet?
                    Dim hMenu As Long, puMenu As Long
                    hMenu = SendMessage(hMenuOwner, MN_GETHMENU, 0&, ByVal 0&)
                    If hMenu <> 0 Then      ' if so, add our menu(s)
                        AppendMenu hMenu, MF_SEPARATOR Or MF_DISABLED, 0&, ByVal 0&
                        AppendMenu hMenu, MF_STRING, WM_APP Or 110, "&LaVolpe Added Menu Item"
                        puMenu = CreatePopupMenu
                        AppendMenu hMenu, MF_STRING Or MF_POPUP, puMenu, "LaVolpe Added Menu Item w/Submenus"
                        AppendMenu puMenu, MF_STRING, WM_APP Or 111, "Submenu A"
                        AppendMenu puMenu, MF_STRING, WM_APP Or 112, "Submenu B"
                        hMenuOwner = 0&
                        SetHook False       ' terminate hooking; done here
                    End If
                End If
            End If
        End Select
    End If
End Function

Public Function HandleWindowMessage(hWnd As Long, wMsg As Long, wParam As Long, lParam As Long, WndProc As Long, Supress As Boolean) As Long
    ' called from the module for each window message
    If wMsg = WM_CONTEXTMENU Then
        SetHook True
        HandleWindowMessage = CallWindowProc(WndProc, hWnd, wMsg, wParam, lParam)
        SetHook False
        Supress = True
    ElseIf (wMsg And WM_APP) = WM_APP Then
        MsgBox "Selected custom add-on menu ID (" & (wMsg Xor WM_APP) & ")", vbOKOnly
        Supress = True
    End If
End Function

Private Sub Command1_Click()
    SetSubclass Text1.hWnd
End Sub

Private Sub Command2_Click()
    SetSubclass 0&
End Sub

Private Sub Form_Load()
    Command1.Caption = "Start Subclassing"
    Command2.Caption = "Stop Subclassing"
End Sub

Private Sub Form_Unload(Cancel As Integer)
    SetHook False           ' in case didn't do it before closing
    SetSubclass 0&
End Sub

Notes...

1. IMPORTANT IMPORTANT IMPORTANT
The context menu item IDs used for textboxes are actual windows messages. So the ID for the Paste menu item will be WM_Paste. When menu item is chosen, that ID is sent to the parent as a windows message. So, you need to ensure you NEVER use actual window messages as menu item IDs for any items you append to the context menu. For example. Using a menu item ID of 16 is the value for WM_Close & if selected, good bye parent (textbox).

Wouldn't bet this is the case for all control-types. If not, you'll probably receive a WM_Command message once an item is selected. Probably should presume that and add a line of code in the textbox window procedure, something like:

ElseIf wMsg = WM_Command Then
    If (wParam and &HFFFF0000) = 0 Then 
          ' menu item ID selected is ((wParam And &HFFFF&) Xor WM_App)
    End If
ElseIf wMsg = WM_MENUCOMMAND Then
    ' wParam = zero-based index of menu item selected
    ' lParam = handle to the menu

2. I think you will be able to follow the code pretty well. Just some points & you can play

a. Menu item IDs: Use WM_APP Or [ID value > 0]. Example: WM_APP Or 100, WM_APP Or 125

b. Do not let the hook run longer than needed. Even if you are subclassing multiple textboxes, you only need one hook. It can be called when WM_ContextMenu received & released inside the hook procedure or after WM_ContextMenu has been processed

c. If creating a menu item with submenus, you would use CreatePopupMenu as in the above code sample. Per MSDN, that popup menu must be destroyed using DestroyMenu unless the menu is assigned to a window. You'll want to research this to verify. But I believe the menu is assigned to that #32678 window. If not, you'll want to cache the popup menus you create so they can be destroyed once you get a WM_MenuSelect with a wParam containing this mask: &HFFFF0000 indicating menu closed.

Edited: Tested on XP only, will try it later tonite with Vista, but not expecting any issues
Follow up: Worked well on Vista but, Vista seems to have stolen some of the WM_APP range for its use. Per MSDN, WM_APP thru &HBFFF would not conflict with system messages. But when used values closer to WM_APP, Vista took some action. I raised the IDs from < 20 to > 100 & that works well