Frmmain:
Option Explicit
Private Sub Form_Load()
Dim hSysMenu As Long
'Get Handle Of System Menu
hSysMenu = GetSystemMenu(hwnd, 0&)
'Append separator and menu item with ID IDM_ABOUT
Call 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 procedure
procOld = SetWindowLong(hwnd, GWL_WNDPROC, AddressOf SysMenuProc)
End Sub
MSysMenu:
Option Explicit
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
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
Public Const MF_STRING = &H0&
Public Const MF_SEPARATOR = &H800&
Public Const GWL_WNDPROC = (-4)
Public Const WM_SYSCOMMAND = &H112
Public procOld As Long
'User's menu
Public Const IDM_ABOUT = &H2000
Public Const IDM_EXIT = &H2001
Public Function SysMenuProc(ByVal hwnd As Long, ByVal iMsg As Long, _
ByVal wParam As Long, ByVal lParam As Long) As Long
' Ignore everything but system commands
If iMsg = WM_SYSCOMMAND Then
' Check for one special menu item
Select Case wParam
Case IDM_ABOUT
MsgBox "Hi"
Exit Function
Case IDM_EXIT
Unload FrmMain
Exit Function
End Select
End If
' Let old window procedure handle other messages
SysMenuProc = CallWindowProc(procOld, hwnd, iMsg, wParam, lParam)
End Function
文章来源于领测软件测试网 https://www.ltesting.net/
