【VB开源代码栏目提醒】:网学会员在VB开源代码频道为大家收集整理了DynaMenu.frm提供大家参考,希望对大家有所帮助!
VERSION 5.00
Begin VB.Form frmMain
BorderStyle = 1 'Fixed Single
Caption = "动态菜单示例"
ClientHeight = 4170
ClientLeft = 150
ClientTop = 435
ClientWidth = 5145
LinkTopic = "Form1"
MaxButton = 0 'False
MinButton = 0 'False
ScaleHeight = 4170
ScaleWidth = 5145
StartUpPosition = 2 '屏幕中心
Begin VB.Menu mnuDyna
Caption = "动态菜单"
Begin VB.Menu mnuDynaAdd
Caption = "增加一个菜单(&A)..."
Shortcut = ^A
End
Begin VB.Menu mnuDynaDel
Caption = "删除一个菜单(&D)..."
Shortcut = ^D
End
Begin VB.Menu mnuDynaDelLast
Caption = "删除最末菜单(&L)"
Shortcut = {DEL}
End
Begin
VB.Menu mnuMenuBar
Caption = "-"
End
Begin VB.Menu mnuDynaExit
Caption = "退出(&E)"
Shortcut = ^E
End
Begin VB.Menu mnuDynaArray
Caption = "-"
Index = 0
Visible = 0 'False
End
End
End
Attribute VB_Name = "frmMain"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Private Sub Form_Load()
mnuDynaDel.Enabled = False '使得删除一个菜单按钮不响应用户产生的事件
mnuDynaDelLast.Enabled = False '使得删除最末菜单按钮不响应用户产生的事件
End Sub
'添加菜单的事件
Private Sub mnuDynaAdd_Click()
Dim str As String '定义字符串变量
Dim i As Integer '定义整型变量
str = InputBox("输入所要增加的菜单项的标题", "菜单标题", "MenuName") '增加一个指定标题的菜单
i = mnuDynaArray.UBound '获得动态菜单数组的边界值
Load mnuDynaArray(i + 1) '加载一个菜单
If Len(str) = 0 Then
str = "新增菜单项,索引号为" & mnuDynaArray(i + 1).Index '获得加载菜单的索引号
End If
mnuDynaArray(i + 1).Caption = str '设置加载菜单的标题
mnuDynaArray(i + 1).Visible = True '设置加载菜单可见
mnuDynaArray(0).Visible = True '设置第一个菜单可见
mnuDynaDel.Enabled = True '使得删除一个菜单按钮响应用户产生的事件
mnuDynaDelLast.Enabled = True '使得删除最末菜单按钮响应用户产生的事件
End Sub
'删除一个菜单的事件
Private Sub mnuDynaDel_Click()
Dim str As String '定义字符串变量
Dim item, curItem As Variant '定义可变型变量
str = InputBox("输入所要删除的菜单项的标题") '取得所要删除的菜单标题
'寻找所要删除的菜单项
For Each item In mnuDynaArray
If item.Caption = str Then
Set curItem = item
Exit For '退出For循环语句
End If
Next item
If Not IsEmpty(curItem) Then 'IsEmpty返回 Boolean 值,指出变量是否已经初始化
Unload curItem '如果找到了所要删除的菜单项,则删掉它
If mnuDynaArray.Count <= 1 Then
mnuDynaDel.Enabled = False '使得删除一个菜单按钮不响应用户产生的事件
mnuDynaDelLast.Enabled = False '使得删除最末菜单按钮不响应用户产生的事件
mnuDynaArray(0).Visible = False '设置第一个菜单不可见
End If
Else
MsgBox "没有找到您所要删除的菜单项!", vbCritical '如果没有找到所要删除的菜单项,则提示报错
End If
End Sub
'删除最末菜单的事件
Private Sub mnuDynaDelLast_Click()
Dim i As Integer '定义整型变量
i = mnuDynaArray.UBound '获得动态菜单数组的边界值
Unload mnuDynaArray(i) '删除末尾的一个菜单项
i = mnuDynaArray.UBound '重新获得动态菜单数组的边界值
If i = 0 Then
mnuDynaDel.Enabled = False '使得删除一个菜单按钮不响应用户产生的事件
mnuDynaDelLast.Enabled = False '使得删除最末菜单按钮不响应用户产生的事件
mnuDynaArray(0).Visible = False '设置第一个菜单不可见
End If
End Sub
'动态菜单数组的点击事件
Private Sub mnuDynaArray_Click(Index As Integer)
Dim item As Variant '定义可变型变量
MsgBox "您所点击的菜单项的名称为:" & mnuDynaArray(Index).Caption '菜单项的Click响应事件
For Each item In mnuDynaArray
item.Checked = False '取消其他菜单项的复选标记
Next item
mnuDynaArray(Index).Checked = True '对所点击的菜单项设置复选标记
End Sub
'退出事件
Private Sub mnuDynaExit_Click()
Unload Me '卸载窗体
End Sub