CodeItBetter Programming Another VB Programming Blog

'Forms - How to add New Menu item to the Form's Sytem Menu

'The system menu is the default pop up menu (with Restore, Move, Minimize, Maximize, etc.)
'that pops up when you right clicking on the title bar, or when you right clicking on the task bar.

'Note: to perform this task, the code below uses subclassing. If you won't close your program
'properly, it may cause your Visual Basic Environment to crash. You can close your program by
'pressing Alt +F4, clicking the form X button, or any other way, but don't close the program
'by pressing the Visual Basic Stop button.

Option Explicit
 
Public Declare Function AppendMenu Lib "user32" Alias "AppendMenuA" (ByVal hMenu As Long, _
    ByVal wFlags As Long, ByVal wIDNewItem As Long, ByVal lpNewItem As String) As Long
Public Declare Function GetSystemMenu Lib "user32" (ByVal hwnd As Long, ByVal bRevert As Long) As Long
Public Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hwnd As Long, _
    ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
Public 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
Public Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (pDest As Any, pSource As Any, _
    ByVal ByteLen As Long)
Public Declare Function GetWindowLong Lib "user32" Alias "GetWindowLongA" (ByVal hwnd As Long, _
    ByVal nIndex As Long) As Long
Public Declare Function EnableMenuItem Lib "user32" (ByVal hMenu As Long, ByVal wIDEnableItem As Long, _
    ByVal wEnable As Long) As Long
Public Const GWL_WNDPROC = (-4)
Public Const GWL_USERDATA = (-21)
Public Const SC_NEWMENU = 2
Public Const SC_MINIMIZE = &HF020
Public Const WM_SYSCOMMAND = &H112
Public Const WM_INITMENUPOPUP = &H117
Public Const BITMASK = &HFFFF0000
Public Const MF_STRING = &H0&
Public Const MF_SEPARATOR = &H800&
Public Const MF_GREYED = &H1&
 
Public Function FrmProc(ByVal hwnd As Long, ByVal Msg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
    'this allows each form to have its own window proc and hence to be able to
    'access its own properties in the Win Proc
    FrmProc = FrmFromHwnd(hwnd).WindowProc(hwnd, Msg, wParam, lParam)
End Function
 
Private Function FrmFromHwnd(hwnd As Long) As Object
    Dim oForm As Object
    Dim lPointer As Long
    lPointer = GetWindowLong(hwnd, GWL_USERDATA)
    CopyMemory oForm, lPointer, 4
    Set FrmFromHwnd = oForm
    CopyMemory oForm, 0&, 4
End Function
 
Private ml_OldWinProc As Long
 
Private Sub Form_Load()
    AddAboutMenu
    SubClass
End Sub
 
Private Sub Form_Unload(Cancel As Integer)
    UnSubClass
End Sub
 
Public Function WindowProc(ByVal hwnd As Long, ByVal Msg As Long, ByVal wParam As Long, _
    ByVal lParam As Long) As Long
    Dim lSysMenu As Long
    Select Case Msg
        Case WM_SYSCOMMAND
            'the user clicked on the new menu item
            If wParam = SC_NEWMENU Then
            'you can put here whatever you want to run when the menu is clicked
                MsgBox "You've clicked the new item"
            End If
        Case WM_INITMENUPOPUP
            'disable the menu option if the form is minimized. If you want
            'that it will be enabled, remove the lines below from "If lParam ..." till "End If"
            If lParam And BITMASK Then
                lSysMenu = GetSystemMenu(hwnd, 0)
                If wParam = lSysMenu Then
                    EnableMenuItem lSysMenu, SC_NEWMENU, ByVal IIf(WindowState = vbMinimized, MF_GREYED, 0)
                End If
            End If
    End Select
    WindowProc = CallWindowProc(ml_OldWinProc, hwnd, Msg, wParam, lParam)
End Function
 
Private Sub SubClass()
    'store object refernce so we can check its properties later
    SetWindowLong Me.hwnd, GWL_USERDATA, ObjPtr(Me)
    ml_OldWinProc = SetWindowLong(Me.hwnd, GWL_WNDPROC, AddressOf FrmProc)
End Sub
 
Private Sub UnSubClass()
    If ml_OldWinProc Then
        Call SetWindowLong(Me.hwnd, GWL_WNDPROC, ml_OldWinProc)
    End If
End Sub
 
Private Sub AddAboutMenu()
    Dim lOwnerWindowHandle As Long, lMenuHandle As Long
    lOwnerWindowHandle = Me.hwnd
    'Get system menu
    lMenuHandle = GetSystemMenu(lOwnerWindowHandle, False)
    'Add new menu item
    Call AppendMenu(lMenuHandle, MF_SEPARATOR, 0&, 0&)
    'replace the "New Item" below with the text you want to appear on the new menu item
    Call AppendMenu(lMenuHandle, MF_STRING, SC_NEWMENU, "&New Item")
End Sub