Binaryworld - How to add your own menu item in System menu ? ... [ VB -> Menu ]

This sample code will show you

- How to add a new menuitem in the system menu using InsertMenuItem API
- How to respond to the events generated by new menuitem with the subclassing technique
- How to get/set item state using GetMenuState and SetMenuItemInfo APIs
- How to remove menuitem from menu using DeleteMenu

Step-By-Step Example

- Create a standard exe project
- Add one module
- Add 4 commandbuttons and one timer control on the form1
- Add the following code in form1

Click here to copy the following block

Private Sub Command1_Click()
  '// add new menu item to system menu
  Dim mInfo As MENUITEMINFO, mCaption As String

  With mInfo
    .cbSize = Len(mInfo)
    .fMask = MIIM_ID Or MIIM_TYPE
    .fType = MFT_SEPARATOR
    .wID = IDM_MYSAP
  End With

  '//Insert item at 5th position
  InsertMenuItem lhSysMenu, 5, True, mInfo

  mCaption = "Caption Clock (Stopped)" & Chr(0)
  With mInfo
    .cbSize = Len(mInfo) ' 44
    .fType = MF_STRING
    .cch = Len(mCaption)
    .fState = MF_UNCHECKED
    .fMask = MIIM_STATE Or MIIM_ID Or MIIM_DATA Or MIIM_TYPE Or MIIM_SUBMENU  ' &H36&
    .dwTypeData = mCaption
    .wID = IDM_MYMENUITEM
  End With

  '//Insert item at 6th position
  InsertMenuItem lhSysMenu, 6, True, mInfo
  Debug.Print Err.LastDllError

End Sub

Private Sub Command2_Click()
  'Control Box to prevent close box command from being executed.
  success = DeleteMenu(lhSysMenu, SC_CLOSE, MF_BYCOMMAND)
End Sub

Private Sub Command3_Click()
  Unload Me
End Sub

Private Sub Command4_Click()
  success = DeleteMenu(lhSysMenu, IDM_MYMENUITEM, MF_BYCOMMAND)
  success = DeleteMenu(lhSysMenu, IDM_MYSAP, MF_BYCOMMAND)
End Sub

'// form_load event. Catch all those messages!
Private Sub Form_Load()
  Dim lRet As Long
  On Error Resume Next

  Command1.Caption = "Add to System Menu"
  Command2.Caption = "Disable System Menu Close Button"
  Command3.Caption = "Close Me"
  Command4.Caption = "Remove from system menu"

  lhSysMenu = GetSystemMenu(hWnd, 0&)

  '// saves the previous window message handler. Always restore this value
  '// AddressOf command sends the address of the WindowProc procedure
  '// to windows
  ProcOld = SetWindowLong(hWnd, GWL_WNDPROC, AddressOf WindowProc)
End Sub

'// form_queryunload event. Return control to windows/vb
Private Sub Form_Unload(Cancel As Integer)
  '// give message processing control back to VB
  '// if you don't do this you WILL crash!!!
  Call SetWindowLong(hWnd, GWL_WNDPROC, ProcOld)
End Sub

Private Sub Timer1_Timer()
  Me.Caption = "Time is >> " & Now
End Sub

- Add the folloing code in module1

Click here to copy the following block

'// variable that stores the previous message handler
Public ProcOld As Long

'// Windows API Call for catching messages
Public Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hWnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long

'// Windows API call for calling window procedures
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

'// menu windows api
Declare Function InsertMenuItem Lib "user32.dll" Alias "InsertMenuItemA" ( _
    ByVal hMenu As Long, _
    ByVal uItem As Long, _
    ByVal fByPosition As Long, _
    lpmii As MENUITEMINFO) As Long

Declare Function SetMenuItemInfo Lib "user32.dll" Alias "SetMenuItemInfoA" ( _
    ByVal hMenu As Long, _
    ByVal uItem As Long, _
    ByVal fByPosition As Long, _
    lpmii As MENUITEMINFO) As Long

Declare Function GetSystemMenu Lib "user32" ( _
    ByVal hWnd As Long, _
    ByVal bRevert As Long) As Long

Declare Function DeleteMenu Lib "user32.dll" ( _
    ByVal hMenu As Long, _
    ByVal nPosition As Long, _
    ByVal wFlags As Long) As Long

Declare Function GetMenuState Lib "user32.dll" ( _
    ByVal hMenu As Long, _
    ByVal wID As Long, _
    ByVal wFlags As Long) As Long

Public 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

'// windows api constants
Public Const WM_SYSCOMMAND = &H112

Public Const MF_SEPARATOR = &H800&
Public Const MF_STRING = &H0&
Public Const MF_OWNERDRAW = &H100&
Public Const MF_CHECKED = &H8&
Public Const MF_UNCHECKED = &H0&
Public Const MF_BYCOMMAND = &H0&

Public Const MFS_DEFAULT = &H1000

Public Const MIIM_ID = &H2
Public Const MIIM_SUBMENU = &H4
Public Const MIIM_TYPE = &H10
Public Const MIIM_DATA = &H20 '//data
Public Const MIIM_STATE = &H1 '//state

Public Const GWL_WNDPROC = (-4)

Public Const IDM_MYMENUITEM As Long = 1010
Public Const IDM_MYSAP As Long = 1020

'//ID different menu items in system menu
Public Const SC_CLOSE = &HF060
Public Const SC_MOVE = &HF010
Public Const SC_MINIMIZE = &HF020
Public Const SC_MAXIMIZE = &HF030
Public Const SC_SIZE = &HF000
Public Const SC_RESTORE = &HF120

Public lhSysMenu As Long   '//Handle of the system menu

Public Function WindowProc(ByVal hWnd As Long, ByVal iMsg As Long, _
ByVal wParam As Long, ByVal lParam As Long) As Long
  '// ----WARNING----
  '// do not attempt to debug this procedure!!
  '// ----WARNING----

  '// this is our implementation of the message handling routine
  '// determine which message was recieved
  Select Case iMsg
    Case WM_SYSCOMMAND
      If wParam = IDM_MYMENUITEM Then
        Dim mState As Long
        Dim mCaption As String
        Dim mInfo As MENUITEMINFO

        MsgBox "Demo of insert menu item by Binaryworld", vbInformation, "About"

        mState = GetMenuState(lhSysMenu, IDM_MYMENUITEM, MF_BYCOMMAND)

        If (mState And MF_CHECKED) = MF_CHECKED Then
          mState = MF_UNCHECKED
          mCaption = "Caption Clock (Stopped)" & Chr(0)
          Form1.Timer1.Enabled = False
        ElseIf (mState And MF_UNCHECKED) = MF_UNCHECKED Then
          mState = MF_CHECKED
          mCaption = "Caption Clock (Running)" & Chr(0)
          Form1.Timer1.Interval = 1000
          Form1.Timer1.Enabled = True
        End If

        If mState = MF_CHECKED Or mState = MF_UNCHECKED Then
          With mInfo
            .cbSize = Len(mInfo)  ' 44
            .fType = MF_STRING
            .cch = Len(mCaption)
            .fState = mState
            .fMask = MIIM_STATE Or MIIM_ID Or MIIM_DATA Or MIIM_TYPE Or MIIM_SUBMENU  ' &H36&
            .dwTypeData = mCaption
            .wID = IDM_MYMENUITEM
          End With
          Call SetMenuItemInfo(lhSysMenu, IDM_MYMENUITEM, False, mInfo)
          Debug.Print Err.LastDllError
        End If

        Exit Function
      End If
  End Select
  '// pass all messages on to VB and then return the value to windows
  WindowProc = CallWindowProc(ProcOld, hWnd, iMsg, wParam, lParam)
End Function