dynamenu.frm

菜单浏览系统 vb环境开发 界面做的非常好 是vb学习的绝佳素材 this vbsystem is very useful

VERSION 5.00
Begin VB.Form frmMain 
   BorderStyle     =   1  'Fixed Single
   Caption         =   "动态菜单示例"
   ClientHeight    =   2325
   ClientLeft      =   150
   ClientTop       =   435
   ClientWidth     =   2820
   LinkTopic       =   "Form1"
   MaxButton       =   0   'False
   MinButton       =   0   'False
   ScaleHeight     =   2325
   ScaleWidth      =   2820
   StartUpPosition =   2  '屏幕中心
   Begin VB.Menu mnuDyna 
      Caption         =   "动态菜单(&M)"
      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         =   "退出(&X)"
         Shortcut        =   ^X
      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
   str = InputBox("输入所要增加的菜单项的标题", "菜单标题", "MenuName")
   
   Dim i As Integer
   i = mnuDynaArray.UBound
   
   Load mnuDynaArray(i + 1)
   If str = "" Then str = "新增菜单项，索引号为" & mnuDynaArray(i + 1).Index
   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
   str = InputBox("输入所要删除的菜单项的标题")
   
   ''寻找所要删除的菜单项
   Dim item, curItem
   For Each item In mnuDynaArray
      If item.Caption = str Then
         Set curItem = item
         Exit For
      End If
   Next item
   
   If Not IsEmpty(curItem) Then
      ''如果找到了所要删除的菜单项，则删掉它
      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)
   ''菜单项的Click响应事件
   MsgBox "您所点击的菜单项的名称为：" & mnuDynaArray(Index).Caption
   
   ''对所点击的菜单项设置复选标记
   ''取消其他菜单项的复选标记
   Dim item
   For Each item In mnuDynaArray
      item.Checked = False
   Next item
   mnuDynaArray(Index).Checked = True
End Sub

Private Sub mnuDynaExit_Click()
   Unload Me
End Sub