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