|
 | 作者: hongliubo1 [hongliubo1]
 论坛用户 |
登录 |
| Private Sub Form_Load() Dim mSysMenu As Long Dim mMenu As Long Dim mSubMenu As Long mSysMenu = GetSystemMenu(Me.hwnd, False) AppendMenu1 mSysMenu, MF_SEPARATOR, 0, "-" '因为本工程名字也是AppendMenu,所以只好改函数名了 AppendMenu1 mSysMenu, MF_STRING, mAddItemId, "VB广场" mMenu = GetMenu(Me.hwnd) mSubMenu = GetSubMenu(mMenu, 0) AppendMenu1 mSubMenu, MF_SEPARATOR, 0, "-" AppendMenu1 mSubMenu, MF_STRING, mFileId, "文件" AppendMenu1 mSubMenu, MF_STRING + MF_GRAYED + MF_CHECKED, mSaveId, "保存" OldWinProc = SetWindowLong(hwnd, GWL_WNDPROC, AddressOf NewWindowProc) End Sub Private Sub Open_Click() MsgBox "打开" End Sub Public mAddItemId As Long Public mFileId As Long Public mSaveId As Long Public OldWinProc As Long Public Const MF_STRING = &H0& Public Const MF_DISABLED = &H2& Public Const MF_SEPARATOR = &H800& Public Const MF_CHECKED = &H8& Public Const MF_GRAYED = &H1& Public Const GWL_WNDPROC = (-4) Public Const WM_COMMAND = &H111 Public Const WM_SYSCOMMAND = &H112 Public Declare Function GetSystemMenu Lib "user32" (ByVal hwnd As Long, ByVal bRevert As Long) As Long Public Declare Function AppendMenu1 Lib "user32" Alias "AppendMenuA" (ByVal hMenu As Long, ByVal wFlags As Long, ByVal wIDNewItem As Long, ByVal lpNewItem As String) As Long Public Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long 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 Public Declare Function GetMenu Lib "user32" (ByVal hwnd As Long) As Long Public Declare Function GetSubMenu Lib "user32" (ByVal hMenu As Long, ByVal nPos As Long) As Long Private Declare Function ShellExecute Lib "shell32.dll" Alias "ShellExecuteA" (ByVal hwnd As Long, ByVal lpOperation As String, ByVal lpFile As String, ByVal lpParameters As String, ByVal lpDirectory As String, ByVal nShowCmd As Long) As Long Public Function NewWindowProc(ByVal inHWND As Long, ByVal Msg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long If Msg = WM_COMMAND Then If wParam = mFileId Then MsgBox "文件" Exit Function End If ElseIf Msg = WM_SYSCOMMAND Then If wParam = mAddItemId Then ShellExecute 0, "open", "http://majifeng.topcool.net", vbNullString, vbNullString, vbNormalFocus Exit Function End If End If NewWindowProc = CallWindowProc(OldWinProc, inHWND, Msg, wParam, lParam) End Function Private Sub Form_Load() Dim mSysMenu As Long Dim mMenu As Long Dim mSubMenu As Long mSysMenu = GetSystemMenu(Me.hwnd, False) AppendMenu1 mSysMenu, MF_SEPARATOR, 0, "-" '因为本工程名字也是AppendMenu,所以只好改函数名了 AppendMenu1 mSysMenu, MF_STRING, mAddItemId, "VB广场" mMenu = GetMenu(Me.hwnd) mSubMenu = GetSubMenu(mMenu, 0) AppendMenu1 mSubMenu, MF_SEPARATOR, 0, "-" AppendMenu1 mSubMenu, MF_STRING, mFileId, "文件" AppendMenu1 mSubMenu, MF_STRING + MF_GRAYED + MF_CHECKED, mSaveId, "保存" OldWinProc = SetWindowLong(hwnd, GWL_WNDPROC, AddressOf NewWindowProc) End Sub Private Sub Open_Click() MsgBox "打开" End Sub Public mAddItemId As Long Public mFileId As Long Public mSaveId As Long Public OldWinProc As Long Public Const MF_STRING = &H0& Public Const MF_DISABLED = &H2& Public Const MF_SEPARATOR = &H800& Public Const MF_CHECKED = &H8& Public Const MF_GRAYED = &H1& Public Const GWL_WNDPROC = (-4) Public Const WM_COMMAND = &H111 Public Const WM_SYSCOMMAND = &H112 Public Declare Function GetSystemMenu Lib "user32" (ByVal hwnd As Long, ByVal bRevert As Long) As Long Public Declare Function AppendMenu1 Lib "user32" Alias "AppendMenuA" (ByVal hMenu As Long, ByVal wFlags As Long, ByVal wIDNewItem As Long, ByVal lpNewItem As String) As Long Public Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long 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 Public Declare Function GetMenu Lib "user32" (ByVal hwnd As Long) As Long Public Declare Function GetSubMenu Lib "user32" (ByVal hMenu As Long, ByVal nPos As Long) As Long Private Declare Function ShellExecute Lib "shell32.dll" Alias "ShellExecuteA" (ByVal hwnd As Long, ByVal lpOperation As String, ByVal lpFile As String, ByVal lpParameters As String, ByVal lpDirectory As String, ByVal nShowCmd As Long) As Long Public Function NewWindowProc(ByVal inHWND As Long, ByVal Msg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long If Msg = WM_COMMAND Then If wParam = mFileId Then MsgBox "文件" Exit Function End If ElseIf Msg = WM_SYSCOMMAND Then If wParam = mAddItemId Then ShellExecute 0, "open", "http://majifeng.topcool.net", vbNullString, vbNullString, vbNormalFocus Exit Function End If End If NewWindowProc = CallWindowProc(OldWinProc, inHWND, Msg, wParam, lParam) End Function |
| 地主 发表时间: 05-01-14 21:29 |
|
20CN网络安全小组版权所有
Copyright © 2000-2010 20CN Security Group. All Rights Reserved.
论坛程序编写：NetDemon
粤ICP备05087286号
论坛: 编程破解
标题: VB使用appendMenu添加菜单并且相应Click时间