如何在VB运行中动态添加菜单项目？

Posted 2023-03-15

参考技术A 方法1：使用菜单数组
在文件菜单里增加一个菜单项,标题任意,现在假设菜单项的Name属性是mnuDynamic
更改菜单项mnuDynamic的可见属性,使mnuDynamic.Visible=
False
更改菜单项mnuDynamic的下标(索引)属性,使mnuDynamic.Index=0
在程序中控制菜单项mnuDynamic的动态装入。
Load
mnuDynamic(1)
mnuDynamic(1).Caption
=
"动态菜单1"
mnuDynamic(1).Visible
=
True
方法2：使用用API函数
新建一个模块，复制以下代码。
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
Const
MF_STRING
=
&H0&
Public
Const
MF_BYCOMMAND
=
&H0&
Public
Const
GWL_WNDPROC
=
(-4)
Public
Const
WM_COMMAND
=
&H111
Public
OldWinProc
As
Long
Public
Function
OnMenu(ByVal
hwnd
As
Long,
ByVal
wMsg
As
Long,
ByVal
wParam
As
Long,
ByVal
lParam
As
Long)
As
Long
'响应菜单事件
If
wMsg
=
WM_COMMAND
Then
If
wParam
=
1000
Then
MsgBox
"Dynamic"
End
If
OnMenu
=
CallWindowProc(OldWinProc,
hwnd,
wMsg,
wParam,
lParam)
End
Function
窗体代码：
Private
Sub
Form_Load()
Dim
hMenu
As
Long,
hSubMenu
As
Long
hMenu
=
GetMenu(Me.hwnd)
hSubMenu
=
GetSubMenu(hMenu,
0)
InsertMenu
hSubMenu,
0,
MF_BYCOMMAND
Or
MF_STRING,
1000,
"Dynamic"
OldWinProc
=
SetWindowLong(Me.hwnd,
GWL_WNDPROC,
AddressOf
OnMenu)
End
Sub