Add custom item on system menu

At some stage in your programming career, you might find you want to add another item to the standard system menu (which is displayed when you click a windows icon, or right click on its title bar). To do this in VB, you need to use the AppendWindow API function to add an item, and then subclass the WM_SYSCOMMAND message to detect when the item is clicked. The code below shows you how. Please note that as this uses subclassing, you must not press the stop button on the VB toolbar.

Option Explicit
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
Declare Function GetSystemMenu Lib "user32" (ByVal hWnd As Long, ByVal bRevert As Long) As Long
Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hWnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
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 Const WM_SYSCOMMAND = &H112
Public Const MF_SEPARATOR = &H800&
Public Const MF_STRING = &H0&
Public Const GWL_WNDPROC = (-4)
Public Const IDM_CUSTOM As Long = 1010
Public lProcOld As Long

Public Function SysMenuHandler(ByVal hWnd As Long, ByVal iMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
    If iMsg = WM_SYSCOMMAND Then
        If wParam = IDM_CUSTOM Then
            MsgBox "VB Web About...", vbInformation, "About"
            Exit Function
        End If
    End If
    SysMenuHandler = CallWindowProc(lProcOld, hWnd, iMsg, wParam, lParam)
End Function

Public Function SubClass(FormName As Form, sMenu As String)
    Dim lhSysMenu As Long, lRet As Long
    lhSysMenu = GetSystemMenu(FormName.hWnd, 0&)
    'Add seperator
    lRet = AppendMenu(lhSysMenu, MF_SEPARATOR, 0&, vbNullString)
    'Add new menu item
    lRet = AppendMenu(lhSysMenu, MF_STRING, IDM_CUSTOM, sMenu)
    lProcOld = SetWindowLong(FormName.hWnd, GWL_WNDPROC, AddressOf SysMenuHandler)
End Function


'Form Code
Option Explicit

Private Sub Form_Load()
    SubClass Me, "About..."
End Sub

Private Sub Form_Unload(Cancel As Integer)
    SetWindowLong Me.hWnd, GWL_WNDPROC, lProcOld
End Sub