菜单的竖向分列VB源码程序 - vb源码程序

下载频道> 资源分类> 编程语言> VB源码> 菜单的竖向分列VB源码程序

标题：菜单的竖向分列VB源码程序
分享到：

所属分类: VB源码资源类型：文件大小: 3.74 KB 上传时间: 2016-01-20 23:21:38 下载次数: 6 资源积分：1分提供者: vb源码代做菜单的竖向分列VB源码程序

内容：
菜单的竖向分列VB源码程序，程序员在编程的过程中可以参考学习使用，希望对IT程序员有用，此源码程序简单易懂、方便阅读，有很好的学习价值！

部分代码如下：

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

Begin VB.Menu mnuThree

Caption = "三级菜单"

Begin VB.Menu mnuSub1

Caption = "带有竖向分隔条"

Begin VB.Menu mnuList2

Caption = "菜单项1"

Index = 0

End

Begin VB.Menu mnuSub2

Caption = "不带有竖向分隔条"

Begin VB.Menu mnuList3

Caption = "菜单项1"

Index = 0

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()

' It seems that there is a limit to the number of menus that may be added

' in any VB application. I discovered this by setting the number of menus

' in each menu array ever higher until I received an 'Out of Memory' error.

' The error occurred at 337 items between all three menu arrays. This does

' not take into account the other higher level menus in the application.

' position the form

Move (Screen.Width \ 2) - (Width \ 2), 0

Const MF_BYPOSITION As Long = &H400& '<--** tells modifymenu to act on the menu at the specified position

Const MF_MENUBARBREAK As Long = &H20& '<--** tells modifymenu to add another column with a vertical separator

Const MF_MENUBREAK As Long = &H40& '<--** tells modifymenu to add another column without a vertical separator

Const SM_CYFULLSCREEN As Long = 17& '<--** height of client area of a maximized window

Const SM_CYMENU As Long = 15& '<--** height of menu

Dim menuheight&, breakpoint&, menuhWnd&, submenuhWnd&, nextsubmenuhWnd&

Dim i&, loopnum&, loopstr$, msg$

' get the client area height and divide it by the height of a menu

' to get the point where we need to *wrap* the menu to a new column

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 we've reached the breakpoint then add a new column with

If i Mod breakpoint = 0 Then ' a vertical bar 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

' get the handle of the popup menu that is in the position

submenuhWnd = GetSubMenu(submenuhWnd, i) ' at AFTER the menus we just loaded

For i = 1 To 30 ' load the popup sub menu array of the first menu array (rember, zero is already loaded)

On Error GoTo TooManyMenus

Load mnuList4(i)

On Error GoTo 0

mnuList4(i).Caption = "菜单项" & CStr(i + 1)

' if we've reached the breakpoint then add a new column with a vertical bar

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

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 ' load the second menu array (rember, zero is already loaded)

On Error GoTo TooManyMenus

Load mnuList2(i)

On Error GoTo 0

mnuList2(i).Caption = "菜单项" & CStr(i + 1)

' if we've reached the breakpoint then add a new column with a vertical bar

If i Mod breakpoint = 0 Then ' the proper ID must be specified

Call ModifyMenu(nextsubmenuhWnd, i, MF_BYPOSITION Or MF_MENUBARBREAK, _

GetMenuItemID(nextsubmenuhWnd, i), "Menu Item " & CStr(i + 1))

End If

nextsubmenuhWnd = GetSubMenu(submenuhWnd, 1) ' get the second sub menu of the sub menu

loopnum = 2 ' set variable for trapped errors

For i = 1 To 30 ' load the third menu array (rember, zero is already loaded)

On Error GoTo TooManyMenus

Load mnuList3(i)

On Error GoTo 0

mnuList3(i).Caption = "菜单项" & CStr(i + 1)

' if we've reached the breakpoint then add a new column without a vertical bar

If i Mod breakpoint = 0 Then ' the proper ID must be specified

Call ModifyMenu(nextsubmenuhWnd, i, MF_BYPOSITION Or MF_MENUBREAK, _

GetMenuItemID(nextsubmenuhWnd, i), "Menu Item " & CStr(i + 1))

End If

Exit Sub

TooManyMenus:

' display message telling where the error occurred

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源码程序/
菜单的竖向分列VB源码程序/MSSCCPRJ.SCC
菜单的竖向分列VB源码程序/Project1.vbw
菜单的竖向分列VB源码程序/frmMenu.frm
菜单的竖向分列VB源码程序/menudemo.vbp
菜单的竖向分列VB源码程序/menudemo.vbw

关键词：源码 菜单 程序

编程语言下载排行

回到顶部

友情链接

matlab源码网站源码编程语言网络编程手机通讯编程 KUNAG 官网 KUNAG 电商更多

: 联系方式| 版权声明| 招聘信息| 广告服务| 银行汇款| 法律顾问| 兼职技术| 付款方式| 关于我们|; 网站客服程序员兼职招聘 411241577@qq.com; 沪ICP备19040327号-3; 公安备案号：沪公网安备 31011802003874号; 库纳格流体控制系统（上海）有限公司版权所有; Copyright © 1999-2014, GUSUCODE.COM, All Rights Reserved

关键词： 源码 菜单 程序

相关推荐

编程语言下载排行

友情链接

关键词：源码菜单程序