首 页最新软件下载排行文章资讯投稿发布下载专题
维维下载站
您的位置:首页编程开发网络编程编程其它 → VB6.0实现竖向排列的多级下拉菜单例子代码

VB6.0实现竖向排列的多级下拉菜单例子代码

来源:维维整理 发布时间:2017-8-23 8:11:48 人气:

VB6.0实现竖向排列的多级下拉菜单例子代码是小编为大家整理放出的一个VB版的下拉菜单制作方法示例,在制作窗口菜单的时候,本代码可起到借鉴作用,运行后的菜单效果如下图所示,有兴趣的朋友别错过了,一块来详细了解下吧:

VB6.0实现竖向排列的多级下拉菜单例子代码

完整VB Frm文件代码:

VERSION 5.00
Begin VB.Form frmMenu
   Appearance      =   0  'Flat
   AutoRedraw      =   -1  'True
   Caption         =   "菜单的竖向分列"
   ClientHeight    =   2550
   ClientLeft      =   3135
   ClientTop       =   1965
   ClientWidth     =   4080
   ForeColor       =   &H80000008&
   LinkTopic       =   "Form1"
   PaletteMode     =   1  'UseZOrder
   ScaleHeight     =   170
   ScaleMode       =   3  'Pixel
   ScaleWidth      =   272
   Begin VB.Menu mnuTwo
      Caption         =   "二级菜单"
      Begin VB.Menu mnuList1
         Caption         =   "菜单项 1"
         Index           =   0
      End
      Begin VB.Menu mnuPopUp
         Caption         =   "更多的下级菜单"
         Begin VB.Menu mnuList4
            Caption         =   "菜单项  1"
            Index           =   0
         End
      End
   End
   Begin VB.Menu mnuThree
      Caption         =   "三级菜单"
      Begin VB.Menu mnuSub1
         Caption         =   "带有竖向分隔条"
         Begin VB.Menu mnuList2
            Caption         =   "菜单项1"
            Index           =   0
         End
      End
      Begin VB.Menu mnuSub2
         Caption         =   "不带有竖向分隔条"
         Begin VB.Menu mnuList3
            Caption         =   "菜单项1"
            Index           =   0
         End
      End
   End
End
Attribute VB_Name = "frmMenu"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
  Option Explicit
   Private Declare Function GetMenu& Lib "user32" (ByVal hwnd&)
  Private Declare Function GetSubMenu& Lib "user32" (ByVal hMenu&, ByVal nPos&)
  Private Declare Function GetMenuItemID& Lib "user32" (ByVal hMenu&, ByVal nPos&)
  Private Declare Function ModifyMenu& Lib "user32" Alias "ModifyMenuA" (ByVal hMenu&, _
                          ByVal nPosition&, ByVal wFlags&, ByVal wIDNewItem&, ByVal lpString$)
  Private Declare Function GetSystemMetrics& Lib "user32" (ByVal nIndex&)
Private Sub Form_Load()
  Move (Screen.Width \ 2) - (Width \ 2), 0
  Const MF_BYPOSITION As Long = &H400&   
  Const MF_MENUBARBREAK As Long = &H20&  
  Const MF_MENUBREAK As Long = &H40&     
  Const SM_CYFULLSCREEN As Long = 17&
  Const SM_CYMENU  As Long = 15&
  Dim menuheight&, breakpoint&, menuhWnd&, submenuhWnd&, nextsubmenuhWnd&
  Dim i&, loopnum&, loopstr$, msg$
  menuheight = GetSystemMetrics(SM_CYMENU)
  breakpoint = (GetSystemMetrics(SM_CYFULLSCREEN) - menuheight) \ menuheight
  menuhWnd = GetMenu(hwnd) ' get the handle of the menu for *this* form
  submenuhWnd = GetSubMenu(menuhWnd, 0) ' get the handle of the first sub menu
  For i = 1 To 30  ' load the first menu array (rember, zero is already loaded)
    On Error GoTo TooManyMenus
    Load mnuList1(i)
    On Error GoTo 0
    mnuList1(i).Caption = "菜单项" & CStr(i + 1)
    If i Mod breakpoint = 0 Then 
      Call ModifyMenu(submenuhWnd, i, MF_BYPOSITION Or MF_MENUBARBREAK, _
                              GetMenuItemID(submenuhWnd, i), "Menu Item " & CStr(i + 1))
    End If
  Next
  submenuhWnd = GetSubMenu(submenuhWnd, i) ' at AFTER the menus we just loaded
  For i = 1 To 30 
    On Error GoTo TooManyMenus
    Load mnuList4(i)
    On Error GoTo 0
    mnuList4(i).Caption = "菜单项" & CStr(i + 1)
    If i Mod 5 = 0 Then                          ' the proper ID must be specified
      Call ModifyMenu(submenuhWnd, i, MF_BYPOSITION Or MF_MENUBARBREAK, _
                                GetMenuItemID(submenuhWnd, i), "Menu Item " & CStr(i + 1))
    End If
  Next
  submenuhWnd = GetSubMenu(menuhWnd, 1) ' get the sub menu of the second top level menu (position 1)
  nextsubmenuhWnd = GetSubMenu(submenuhWnd, False) ' get the first sub menu of the sub menu
  loopnum = 1 ' set variable for trapped errors
  For i = 1 To 30 
    On Error GoTo TooManyMenus
    Load mnuList2(i)
    On Error GoTo 0
    mnuList2(i).Caption = "菜单项" & CStr(i + 1)
    If i Mod breakpoint = 0 Then 
      Call ModifyMenu(nextsubmenuhWnd, i, MF_BYPOSITION Or MF_MENUBARBREAK, _
                               GetMenuItemID(nextsubmenuhWnd, i), "Menu Item " & CStr(i + 1))
    End If
  Next
  nextsubmenuhWnd = GetSubMenu(submenuhWnd, 1) 
  loopnum = 2
  For i = 1 To 30  
    On Error GoTo TooManyMenus
    Load mnuList3(i)
    On Error GoTo 0
    mnuList3(i).Caption = "菜单项" & CStr(i + 1)
    If i Mod breakpoint = 0 Then  
      Call ModifyMenu(nextsubmenuhWnd, i, MF_BYPOSITION Or MF_MENUBREAK, _
                                GetMenuItemID(nextsubmenuhWnd, i), "Menu Item " & CStr(i + 1))
    End If
  Next
Exit Sub
TooManyMenus:
  Select Case loopnum
    Case 0
      loopstr$ = "first"
    Case 1
      loopstr$ = "second"
    Case 2
      loopstr$ = "third"
  End Select
  msg$ = "Ran out of menu space while loading sub menu number " & CStr(i) & " in the " & loopstr$ & " loop."
  MsgBox msg$, 48, "ERROR!"
  On Error GoTo 0
  Exit Sub
End Sub
Private Sub mnuList1_Click(index As Integer)
  ' report the menu that was chosen
  Dim msg$
  msg$ = "You chose item number " & CStr(index + 1) & " from the Two Level Menu"
  MsgBox msg$, 64, "Menu Columns Demo"
End Sub
Private Sub mnuList2_Click(index As Integer)
  ' report the menu that was chosen
  Dim msg$
  msg$ = "You chose item number " & CStr(index + 1) & " from the first sub menu of the Three Level Menu"
  MsgBox msg$, 64, "Menu Columns Demo"
End Sub
Private Sub mnuList3_Click(index As Integer)
  ' report the menu that was chosen
  Dim msg$
  msg$ = "You chose item number " & CStr(index + 1) & " from the second sub menu of the Three Level Menu"
  MsgBox msg$, 64, "Menu Columns Demo"
End Sub
Private Sub mnuList4_Click(index As Integer)
  ' report the menu that was chosen
  Dim msg$
  msg$ = "You chose item number " & CStr(index + 1) & " from the popup sub menu of the Two Level Menu"
  MsgBox msg$, 64, "Menu Columns Demo"
End Sub

 这是根据一个国外的VB菜单制作源码修改而来,添加工程文件之后,新建窗体文件,可以在VB6.0下编译此源码。

相关下载
栏目导航
本类热门阅览