VB打造超酷个性化菜单.docx
- 文档编号:10482265
- 上传时间:2023-02-13
- 格式:DOCX
- 页数:58
- 大小:127.33KB
VB打造超酷个性化菜单.docx
《VB打造超酷个性化菜单.docx》由会员分享,可在线阅读,更多相关《VB打造超酷个性化菜单.docx(58页珍藏版)》请在冰豆网上搜索。
VB打造超酷个性化菜单
VB打造超酷个性化菜单
众所周知,MSOffice2003推出已经有一段时间了,但我们依然不会忘记OfficeXP刚刚推出时其令人耳目一新的菜单给我们留下的深刻印象。
突起的悬浮式图标,不同寻常的菜单项填充方式,不仅让办公一族们赞不绝口,更让广大的程序员和编程爱好者对这种风格的菜单的制作产生了浓厚的兴趣。
所以,在这篇文章里,我们就来好好地研究研究用VB怎么制作这种风格的菜单,在文章的最后,我将给出源代码的下载地址。
事实上,在了解其原理以后,不论是用VB、VC还是Delphi,都能够制作出XP风格的菜单。
不仅如此,我们还可以制作出更加充满个性的另类风格的菜单,比如3D立体风格、渐变风格、多彩风格等等。
只有想不到的,没有做不到的。
Followme!
现在,我想有必要说一说我们现在要做的事情。
事实上,我们只要做一个菜单类就行了。
但谁都会明白,只做一个菜单类是不够的,我们需要一个程序,或者更详细的说,是一个窗体,来测试我们的菜单类。
在我个人的开发过程中,我是先写的菜单类,后写的测试窗体,但为了让大家先领略一下写好的菜单类在应用时是多么的方便,所以让我们先来看看测试窗体:
(1)打开VB,新建“标准EXE”工程。
(2)下面是窗体的控件:
组件名称
属性
值
Form
Name
Caption
frmMain
菜单例子
Frame
Name
Caption
fraStyle
菜单风格
Label
Name
Caption
lblHelp
在窗体空白处单击鼠标右键
OptionButton
Name
Caption
Index
opnStyle
Window标准
0
OptionButton
Name
Caption
Index
opnStyle
XP风格
1
OptionButton
Name
Caption
Index
opnStyle
3D立体风格
2
OptionButton
Name
Caption
Index
opnStyle
渐变风格
3
OptionButton
Name
Caption
Index
opnStyle
多彩风格
4
其实就是在窗体上添加了一个Frame,然后在Frame里添加OptionButton控件数组,用来设置菜单风格,还有一个Label,上面只显示一行提示文字,非常简单。
(3)窗体代码:
OptionExplicit
PrivateDeclareFunctionGetCursorPosLib""(lpPointAsPOINTAPI)AsLong
PrivateTypePOINTAPI
XAsLong
YAsLong
EndType
DimmenuAscMenu
PrivateSubForm_Load()
'初始化菜单并添加菜单项
Setmenu=NewcMenu
"open",LoadPicture("images\"),"打开",MIT_STRING
"save",LoadPicture("images\"),"保存",MIT_STRING
"print",LoadPicture("images\"),"打印",MIT_STRING
"find",LoadPicture("images\"),"查找",MIT_STRING
"sep1",LoadPicture(),"",MIT_SEPARATOR
"undo",LoadPicture("images\"),"撤消",MIT_STRING
"redo",LoadPicture("images\"),"重复",MIT_STRING
"sep2",LoadPicture(),"",MIT_SEPARATOR
"cut",LoadPicture("images\"),"剪切",MIT_STRING
"copy",LoadPicture("images\"),"复制",MIT_STRING
"paste",LoadPicture("images\"),"粘贴",MIT_STRING
"sep3",LoadPicture(),"",MIT_SEPARATOR
"check",LoadPicture("images\"),"一个CheckBox",MIT_CHECKBOX
"exit",LoadPicture("images\"),"退出",MIT_STRING
EndSub
PrivateSubForm_MouseDown(ButtonAsInteger,ShiftAsInteger,XAsSingle,YAsSingle)
'单击鼠标右建弹出菜单
IfButton=vbRightButtonThen
DimposAsPOINTAPI
GetCursorPospos
,,POPUP_LEFTALIGNOrPOPUP_TOPALIGN
EndIf
EndSub
PrivateSubForm_Unload(CancelAsInteger)
'释放资源,卸载窗体
Setmenu=Nothing
DimfrmAsForm
ForEachfrmInForms
Unloadfrm
Next
EndSub
PrivateSubopnStyle_Click(IndexAsInteger)
'设置菜单风格
SelectCaseIndex
Case0 'Windows标准
=STYLE_WINDOWS
Case1 'XP风格
=STYLE_XP
Case2 '3D立体风格
=STYLE_3D
Case3 '渐变风格
=STYLE_SHADE
Case4 '多彩风格
=STYLE_COLORFUL
EndSelect
EndSub
代码中创建了一个cMenu类的对象,我们的编程重点将会放在cMenu类上,上面的代码只是简单地调用cMenu。
在后面的文章中,我们会看到其实cMenu有多达30个方法和属性供我们调用,它的Style属性只提供了5种内置风格,在实际应用中,我们可以利用cMenu类提供的方法和属性制作出各种各样风格的菜单,为自己的程序锦上添花。
(4)运行结果:
图1
图2
图3
图4
图5
这篇文章只是抛砖引玉,让大家先睹为快,提前体验一下这个菜单类的魅力。
在下一篇中,我们将继续讨论个性化菜单的制作,不一样的是,我们的重点将是那个cMenu类。
:
)
未完待续…
其实,漂亮的界面都是“画”出来的,菜单当然也不例外。
既然是“画”出来的,就需要有窗体来接收“画”菜单这个消息,后面我们会看到,实际上不仅仅是“画”这个消息,一切关于这个菜单的消息都要有一个窗体来接收。
如果你对消息不太了解,可以看看网上其它一些关于Windows消息机制的文章。
不了解也没有关系,只要会使用就可以了,后面的文章给出了完整的源代码,而且文章的最后还给出了源代码的下载地址。
下面我们来创建接收消息的窗体:
打开上次建好的工程,添加一个窗体,并将其名称设置为frmMenu(注意:
这一步是必须的)。
还记得上篇文章的最后一幅图吗?
菜单左边那个黑底色的附加条,为了方便,将frmMenu的Picture属性设置成那幅图。
到此,这个窗体就算OK了!
对了,就这样,因为这个窗体仅仅是为了处理消息和存储那个黑底色的风格条,我们将会对它进行子类处理,处理消息的代码全部都放在了将在下一篇中详细介绍的标准模块中。
接下来添加一个类模块,并将其名称设置为cMenu,代码如下:
'*************************************************************
'* 本类模块是一个菜单类, 提供了各种样式的菜单的制作方案
'*
'* 版权:
LPP软件工作室
'* 作者:
卢培培(goodname008)
'* (******* 复制请保留以上信息 *******)
'*************************************************************
Option Explicit
Private Declare Function TrackPopupMenu Lib "user32" (ByVal hMenu As Long,
ByVal wFlags As Long, ByVal x As Long, ByVal y As Long, ByVal nReserved As Long,
ByVal hwnd As Long, lprc As Any) As Long
Public Enum MenuUserStyle ' 菜单总体风格
STYLE_WINDOWS
STYLE_XP
STYLE_SHADE
STYLE_3D
STYLE_COLORFUL
End Enum
Public Enum MenuSeparatorStyle ' 菜单分隔条风格
MSS_SOLID
MSS_DASH
MSS_DOT
MSS_DASDOT
MSS_DASHDOTDOT
MSS_NONE
MSS_DEFAULT
End Enum
Public Enum MenuItemSelectFillStyle ' 菜单项背景填充风格
ISFS_NONE
ISFS_SOLIDCOLOR
ISFS_HORIZONTALCOLOR
ISFS_VERTICALCOLOR
End Enum
Public Enum MenuItemSelectEdgeStyle ' 菜单项边框风格
ISES_SOLID
ISES_DASH
ISES_DOT
ISES_DASDOT
ISES_DASHDOTDOT
ISES_NONE
ISES_SUNKEN
ISES_RAISED
End Enum
Public Enum MenuItemIconStyle ' 菜单项图标风格
IIS_NONE
IIS_SUNKEN
IIS_RAISED
IIS_SHADOW
End Enum
Public Enum MenuItemSelectScope ' 菜单项高亮条的范围
ISS_TEXT = &H1
ISS_ICON_TEXT = &H2
ISS_LEFTBAR_ICON_TEXT = &H4
End Enum
Public Enum MenuLeftBarStyle ' 菜单附加条风格
LBS_NONE
LBS_SOLIDCOLOR
LBS_HORIZONTALCOLOR
LBS_VERTICALCOLOR
LBS_IMAGE
End Enum
Public Enum MenuItemType ' 菜单项类型
MIT_STRING = &H0
MIT_CHECKBOX = &H200
MIT_SEPARATOR = &H800
End Enum
Public Enum MenuItemState ' 菜单项状态
MIS_ENABLED = &H0
MIS_DISABLED = &H2
MIS_CHECKED = &H8
MIS_UNCHECKED = &H0
End Enum
Public Enum PopupAlign ' 菜单弹出对齐方式
POPUP_LEFTALIGN = &H0& ' 水平左对齐
POPUP_CENTERALIGN = &H4& ' 水平居中对齐
POPUP_RIGHTALIGN = &H8& ' 水平右对齐
POPUP_TOPALIGN = &H0& ' 垂直上对齐
POPUP_VCENTERALIGN = &H10& ' 垂直居中对齐
POPUP_BOTTOMALIGN = &H20& ' 垂直下对齐
End Enum
' 释放类
Private Sub Class_Terminate()
SetWindowLong , GWL_WNDPROC, preMenuWndProc
Erase MyItemInfo
DestroyMenu hMenu
End Sub
' 创建弹出式菜单
Public Sub CreateMenu()
preMenuWndProc = SetWindowLong, GWL_WNDPROC, AddressOf MenuWndProc)
hMenu = CreatePopupMenu()
= STYLE_WINDOWS
End Sub
' 插入菜单项并保存自定义菜单项数组, 设置Owner_Draw自绘菜单
Public Sub AddItem(ByVal itemAlias As String, ByVal itemIcon As StdPicture,
ByVal itemText As String, ByVal itemType As MenuItemType,
Optional ByVal itemState As MenuItemState)
Static ID As Long, i As Long
Dim ItemInfo As MENUITEMINFO
' 插入菜单项
With ItemInfo
.cbSize = LenB(ItemInfo)
.fMask = MIIM_STRING Or MIIM_FTYPE Or MIIM_STATE Or
MIIM_SUBMENU Or MIIM_ID Or MIIM_DATA
.fType = itemType
.fState = itemState
.wID = ID
.dwItemData = True
.cch = lstrlen(itemText)
.dwTypeData = itemText
End With
InsertMenuItem hMenu, ID, False, ItemInfo
' 将菜单项数据存入动态数组
ReDim Preserve MyItemInfo(ID) As MyMenuItemInfo
For i = 0 To UBound(MyItemInfo)
If MyItemInfo(i).itemAlias = itemAlias Then
Class_Terminate
vbObjectError + 513, "cMenu", "菜单项别名相同."
End If
Next i
With MyItemInfo(ID)
Set .itemIcon = itemIcon
.itemText = itemText
.itemType = itemType
.itemState = itemState
.itemAlias = itemAlias
End With
' 获得菜单项数据
With ItemInfo
.cbSize = LenB(ItemInfo)
.fMask = MIIM_DATA Or MIIM_ID Or MIIM_TYPE
End With
GetMenuItemInfo hMenu, ID, False, ItemInfo
' 设置菜单项数据
With ItemInfo
.fMask = .fMask Or MIIM_TYPE
.fType = MFT_OWNERDRAW
End With
SetMenuItemInfo hMenu, ID, False, ItemInfo
' 菜单项ID累加
ID = ID + 1
End Sub
' 删除菜单项
Public Sub DeleteItem(ByVal itemAlias As String)
Dim i As Long
For i = 0 To UBound(MyItemInfo)
If MyItemInfo(i).itemAlias = itemAlias Then
DeleteMenu hMenu, i, 0
Exit For
End If
Next i
End Sub
' 弹出菜单
Public Sub PopupMenu(ByVal x As Long, ByVal y As Long, ByVal Align As PopupAlign)
TrackPopupMenu hMenu, Align, x, y, 0, , ByVal 0
End Sub
' 设置菜单项图标
Public Sub SetItemIcon(ByVal itemAlias As String, ByVal itemIcon As StdPicture)
Dim i As Long
For i = 0 To UBound(MyItemInfo)
If MyItemInfo(i).itemAlias = itemAlias Then
Set MyItemInfo(i).itemIcon = itemIcon
Exit For
End If
Next i
End Sub
' 获得菜单项图标
Public Function GetItemIcon(ByVal itemAlias As String) As StdPicture
Dim i As Long
For i = 0 To UBound(MyItemInfo)
If MyItemInfo(i).itemAlias = itemAlias Then
Set GetItemIcon = MyItemInfo(i).itemIcon
Exit For
End If
Next i
End Function
' 设置菜单项文字
Public Sub SetItemText(ByVal itemAlias As String, ByVal itemText As String)
Dim i As Long
For i = 0 To UBound(MyItemInfo)
If MyItemInfo(i).itemAlias = itemAlias Then
MyItemInfo(i).itemText = itemText
Exit For
End If
Next i
End Sub
' 获得菜单项文字
Public Function GetItemText(ByVal itemAlias As String) As String
Dim i As Long
For i = 0 To UBound(MyItemInfo)
If MyItemInfo(i).itemAlias = itemAlias Then
GetItemText = MyItemInfo(i).itemText
Exit For
End If
Next i
End Function
' 设置菜单项状态
Public Sub SetItemState(ByVal itemAlias As String, ByVal itemState As MenuItemState)
Dim i As Long
For i = 0 To UBound(MyItemInfo)
If MyItemInfo(i).itemAlias = item
- 配套讲稿:
如PPT文件的首页显示word图标,表示该PPT已包含配套word讲稿。双击word图标可打开word文档。
- 特殊限制:
部分文档作品中含有的国旗、国徽等图片,仅作为作品整体效果示例展示,禁止商用。设计者仅对作品中独创性部分享有著作权。
- 关 键 词:
- VB 打造 个性化 菜单