Solved

How to Add / Edit Windows Menu

Posted on 2016-11-24
4
29 Views
Last Modified: 2016-11-26
I would like to add a menu item to Windows normal text box when the r-button is pressed this menu item would need  3 sub menu item.  Of course I would need to know when each sub-menu item has been selected.  I believe I did this several years ago using API calls but I do not remember how.  A sample project would be appreciated.




Windows Default Text Box Menu
0
Comment
Question by:PhilChapmanJr
  • 2
  • 2
4 Comments
 
LVL 32

Expert Comment

by:ste5an
ID: 41901302
Do you mean GetMenu() and InsertMenuItem()?

Declare Function GetMenu Lib "user32.dll" ( 
                 ByVal hwnd As Long) As Long
Declare Function InsertMenuItem Lib "user32.dll" _
                 Alias "InsertMenuItemA" ( _
                 ByVal hMenu As Long, _
                 ByVal un As Long, _
                 ByVal bool As Boolean, _
                 lpcMenuItemInfo As MENUITEMINFO) As Long

Open in new window

0
 
LVL 2

Author Comment

by:PhilChapmanJr
ID: 41901789
Can you create an vb6 example of adding a Windows System menu item and retrieving the selected item.
0
 
LVL 32

Accepted Solution

by:
ste5an earned 500 total points
ID: 41902399
After some fiddling, its quite complicated and requires some sub-classing:

Your form code:
Option Explicit

Public Function HandleHookMessage(HookType As Long, nCode As Long, wParam As Long, lParam As Long, HookProc As Long, Supress As Boolean) As Long
    Static hMenuOwner As Long
    Dim CWP As CWPSTRUCT
    Dim CS As CREATESTRUCT
    Dim hMenu As Long
    Dim puMenu As Long
    
    If nCode = 0& Then
        CopyMemory CWP, ByVal lParam, 16&
        Select Case CWP.message
            Case WM_CREATE
                CopyMemory CS, ByVal CWP.lParam, Len(CS)
                If CS.lpszClass = 32768 Then
                    hMenuOwner = CWP.hWnd
                End If
            Case MN_GETHMENU
            Case Else
                If CWP.hWnd = hMenuOwner Then
                    If hMenuOwner <> 0 Then
                        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, "Added Menu Item"
                            puMenu = CreatePopupMenu
                            AppendMenu hMenu, MF_STRING Or MF_POPUP, puMenu, "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
                        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
    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 Form_Load()
    SetSubclass Text1.hWnd, Me
End Sub

Private Sub Form_Unload(Cancel As Integer)
    SetHook False
    SetSubclass 0&
End Sub

Open in new window


And the sub-classing in a separate module:
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 Declare Sub CopyMemory Lib "kernel32.dll" Alias "RtlMoveMemory" (ByRef Destination As Any, ByRef Source As Any, ByVal Length As Long)
Public 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
Public 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
Public Declare Function CreatePopupMenu Lib "user32.dll" () As Long
Public Type CWPSTRUCT
    lParam As Long
    wParam As Long
    message As Long
    hWnd As Long
End Type
Public 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
Public Const WM_APP As Long = &H8000&
Public Const MN_GETHMENU As Long = &H1E1
Public Const WM_CONTEXTMENU As Long = &H7B
Public Const WM_CREATE As Long = &H1
Public Const MF_STRING As Long = &H0&
Public Const MF_SEPARATOR As Long = &H800&
Public Const MF_CHECKED As Long = &H8&
Public Const MF_GRAYED As Long = &H1&
Public Const MF_DISABLED As Long = &H2& Or MF_GRAYED
Public Const MF_POPUP As Long = &H10&

Private m_Form As Form

Public Function SetSubclass(hWnd As Long, Optional AForm As Form = Nothing) As Boolean
    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
        Set m_Form = AForm
        If m_WndProc <> 0& Then Call SetSubclass(0&)
        m_WndProc = SetWindowLong(hWnd, GWL_WNDPROC, AddressOf WindowProc)
        If m_WndProc <> 0& Then
            m_SubclassedHwnd = hWnd
            SetSubclass = True
        End If
    End If
End Function

Public Function SetHook(Initiate As Boolean) As Boolean
    If Initiate Then
        If m_HookProc = 0& Then
            m_HookProc = SetWindowsHookEx(WH_CALLWNDPROC, AddressOf HookProc, 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 WindowProc(ByVal hWnd As Long, ByVal wMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
    If wMsg = WM_DESTROY Then
        m_SubclassedHwnd = 0&
        Call SetWindowLong(hWnd, GWL_WNDPROC, m_WndProc)
        WindowProc = CallWindowProc(m_WndProc, hWnd, wMsg, wParam, lParam)
    ElseIf m_SubclassedHwnd <> 0& Then
        Dim bSupress As Boolean
        WindowProc = m_Form.HandleWindowMessage(hWnd, wMsg, wParam, lParam, m_WndProc Or 0&, bSupress)
        If Not bSupress Then WindowProc = CallWindowProc(m_WndProc, hWnd, wMsg, wParam, lParam)
    End If
End Function

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

Open in new window


As it uses sub-classing, save your code before running it. Cause when it's done wrongly, you need to kill the VB-IDE.
0
 
LVL 2

Author Closing Comment

by:PhilChapmanJr
ID: 41902754
Thanks for the help
0

Featured Post

Find Ransomware Secrets With All-Source Analysis

Ransomware has become a major concern for organizations; its prevalence has grown due to past successes achieved by threat actors. While each ransomware variant is different, we’ve seen some common tactics and trends used among the authors of the malware.

Join & Write a Comment

Have you ever wanted to restrict the users input in a textbox to numbers, and while doing that make sure that they can't 'cheat' by pasting in non-numeric text? Of course you can do that with code you write yourself but it's tedious and error-prone …
Background What I'm presenting in this article is the result of 2 conditions in my work area: We have a SQL Server production environment but no development or test environment; andWe have an MS Access front end using tables in SQL Server but we a…
Get people started with the process of using Access VBA to control Excel using automation, Microsoft Access can control other applications. An example is the ability to programmatically talk to Excel. Using automation, an Access application can laun…
This lesson covers basic error handling code in Microsoft Excel using VBA. This is the first lesson in a 3-part series that uses code to loop through an Excel spreadsheet in VBA and then fix errors, taking advantage of error handling code. This l…

744 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question

Need Help in Real-Time?

Connect with top rated Experts

11 Experts available now in Live!

Get 1:1 Help Now