Visual Basic Programming Code Examples

Adding custom system menu items to forms The following code demonstrates how to add and handle the click even for a system menu item (i.e. the menu which appears when right click the application button on the task bar). CODE TO BE ADDED TO A STANDARD MODULE Option Explicit Private Declare Function GetSystemMenu Lib "user32" (ByVal hwnd As Long, ByVal bRevert As Long) As Long Private 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 Private Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long Private 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 Private Const GWL_WNDPROC = (-4) Private zsWinProcs As String 'Purpose : Handles the callbacks from the custom system menus added to forms using FormMenuAdd 'Inputs : Automatically generated via callback 'Outputs : N/A 'Notes : The lMenuID parameter is the same as that supplied to the FormMenuAdd Function. Add code ' to handle the clicking of any custom menu items inside the "Select Case lMenuID" Private Function zFormMenuHandler(ByVal hwnd As Long, ByVal iMsg As Long, ByVal lMenuID As Long, ByVal lParam As Long) As Long Const IDM_CUSTOM As Long = 1010, WM_SYSCOMMAND = &H112 If iMsg = WM_SYSCOMMAND Then Select Case lMenuID Case 1, 2, 3 'Add code here MsgBox "System Menu ID " & lMenuID & " was clicked...", vbInformation Exit Function End Select End If zFormMenuHandler = CallWindowProc(zFormProcAddress(hwnd), hwnd, iMsg, lMenuID, lParam) End Function 'Purpose : Adds a custom system menu item to a form 'Inputs : lFormHwnd The handle of the form to add the system menu item to ' sMenuCaption The caption of the form's menu item ' lMenuID The unique ID of the menu item which is be passed to the zFormMenuHandler function. ' [bAddSeperator] If True adds a seperator bar before the menu item. 'Outputs : Returns True on success 'Notes : MUST CALL FormMenuRestore FUNCTION WHEN UNLOADING A FORM WHICH HAS MENUS CREATED BY THIS FUNCTION. ' Call during Form_Load event. Function FormMenuAdd(lFormHwnd As Long, sMenuCaption As String, lMenuID As Long, Optional bAddSeperator As Boolean = False) As Boolean Dim lhSysMenu As Long, lRet As Long Const MF_SEPARATOR = &H800&, MF_STRING = &H0& lhSysMenu = GetSystemMenu(lFormHwnd, 0&) If bAddSeperator Then 'Add a seperator lRet = AppendMenu(lhSysMenu, MF_SEPARATOR, 0&, vbNullString) End If 'Add new menu item lRet = AppendMenu(lhSysMenu, MF_STRING, lMenuID, sMenuCaption) If InStr(1, zsWinProcs, lFormHwnd & ".") = 0 Then 'Sub class the form and store the form handle and the old win proc address lRet = SetWindowLong(lFormHwnd, GWL_WNDPROC, AddressOf zFormMenuHandler) zsWinProcs = zsWinProcs & "|" & lFormHwnd & "." & lRet & "|" End If FormMenuAdd = True Exit Function ErrFailed: Debug.Print "FormMenuAdd Failed: " & Err.Description FormMenuAdd = False End Function 'Purpose : Restore the window proc for a form which has had system menu items added to it using FormMenuAdd 'Inputs : lFormHwnd The handle of the form to restore 'Outputs : Returns True on success 'Notes : MUST CALL THIS ROUTINE WHEN UNLOADING A FORM WHICH HAS MENUS CREATED BY FormMenuAdd. ' Call during Form_Load event. Function FormMenuRestore(lFormHwnd As Long) As Boolean Dim lProcOld As Long lProcOld = zFormProcAddress(lFormHwnd) If lProcOld Then SetWindowLong lFormHwnd, GWL_WNDPROC, lProcOld FormMenuRestore = True End If End Function 'Purpose : Returns the windows proc address for a given form which has had a system menu item added to using FormMenuAdd 'Inputs : lFormHwnd The handle of the form to return the win proc address of. 'Outputs : Returns the forms win proc address on success, else returns zero 'Notes : Private Function zFormProcAddress(lHwnd As Long) As Long Dim lPosStart As Long, lLen As Long Dim lPosEnd As Long On Error Resume Next lPosStart = InStr(1, zsWinProcs, "|" & lHwnd & ".") + 2 lLen = Len(CStr(lHwnd)) lPosStart = lPosStart + lLen lPosEnd = InStr(lPosStart, zsWinProcs, "|") zFormProcAddress = CLng(Mid(zsWinProcs, lPosStart, lPosEnd - lPosStart)) On Error GoTo 0 End Function Example Form CODE Option Explicit Private Sub Form_Load() FormMenuAdd Me.hwnd, "Other 1", 1, True FormMenuAdd Me.hwnd, "Other 2", 2 End Sub Private Sub Form_Unload(Cancel As Integer) FormMenuRestore Me.hwnd End Sub