时间: 2021-07-31 作者:daque
建一个project,包括一个form(frmmain)和一个module(msysmenu)frmmain:option explicit private sub form_load()dim hsysmenu as long'get handle of system menuhsysmenu = getsystemmenu(hwnd, 0&)'append separator and menu item with id idm_aboutcall appendmenu(hsysmenu, mf_separator, 0&, 0&)call appendmenu(hsysmenu, mf_string, idm_about, "about...")call appendmenu(hsysmenu, mf_string, idm_exit, "exit")show' install system menu window procedureprocold = setwindowlong(hwnd, gwl_wndproc, addressof sysmenuproc)end sub msysmenu:option explicitdeclare 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 longdeclare function appendmenu lib "user32" alias "appendmenua" (byval hmenu as long, byval wflags as long, byval widnewitem as long, byval lpnewitem as string) as longdeclare function getsystemmenu lib "user32" (byval hwnd as long, byval brevert as long) as longdeclare function setwindowlong lib "user32" alias "setwindowlonga" (byval hwnd as long, byval nindex as long, byval dwnewlong as long) as longpublic const mf_string = &h0&public const mf_separator = &h800&public const gwl_wndproc = (-4)public const wm_syscommand = &h112public procold as long'user's menupublic const idm_about = &h2000public const idm_exit = &h2001public function sysmenuproc(byval hwnd as long, byval imsg as long, _byval wparam as long, byval lparam as long) as long' ignore everything but system commandsif imsg = wm_syscommand then' check for one special menu itemselect case wparamcase idm_aboutmsgbox "hi"exit functioncase idm_exitunload frmmainexit functionend selectend if' let old window procedure handle other messagessysmenuproc = callwindowproc(procold, hwnd, imsg, wparam, lparam)end function