The following code Option Explicit in the module
Public Declare Function Appendmenu LIB "User32" Alias _ "Appendmenua" (Byval WFLAGS _AS long, BYVAL WIDNEWITEM AS long, BYVAL _LPNEWITEM AS STRING) AS long 'Add a menu item in the specified menu
Public Declare Function GetSystemMenu Lib "User32" _ (Byval HWnd As Long, Byval Brevert As long) Handle of Form System Menu
Public Declare Function SetWindowlong Lib "User32" _Alias "setwindowlonga" (BYVAL DWNDEX AS Long, Byval Dwnewlong As long) Set information for the specified window in the window structure
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 'message to the window function' constant declarations public Const WM_SYSCOMMAND = & H112Public Const MF_SEPARATOR = & H800 & public Const MF_STRING = & H0 & public Const GWL_WNDPROC = (-4) public Const MyAbout = 1 'there is a new command ID specified menu items, can set their own public lProcOld As Long' address of record of the original window procedure Constant
Public Function SysMenuHandler (ByVal hWnd _As Long, ByVal iMsg As Long, ByVal wParam _As Long, ByVal lParam As Long) As Long 'response to the click event function procedure If iMsg = WM_SYSCOMMAND ThenIf wParam = MyAbout ThenMsgBox "study hard and make progress every day." , Vbinformation, "VB Long live" exit functionend iFend IfsysmenuHandler = CallWindowProc (lprocold, _hWnd, IMSG, WPARAM, LPARAM) End Function
PUBLIC FUNCTION SUBCLASS (Formname As Form) 'Add new menu item sub-process DIM LHSYSMENU As longlhsysmenu = getSystemMenu (Formname.hwnd, 0 &)
Call appendmenu (lhsysmenu, mf_separator, 0, vbnullstring) 'mf_separator is the addition of the divider Call appendmenu (lhsysmenu, mf_string, myabout, "new menu")
lprocold = setwindowlong (formname.hwnd, gwl_wndproc, addressof sysmenuhandler) 'Record the address of the original program END FUNCTION The following code in the form Option Explicit
Private Sub Form_Load () CALL SUBCLASS (FORM1) 'SUBCLASS Subrigation End SubPrivate Sub Form_Unload (Cancel AS Integer) Setwindowlong Me.hwnd, GWL_WNDPROC, LPROCOLD' Exit The original address End Sub
