上一篇：vb打造超酷个性化菜单(1)
其实，漂亮的界面都是“画”出来的，菜单当然也不例外。既然是“画”出来的，就需要有窗体来接收“画”菜单这个消息，后面我们会看到，实际上不仅仅是“画”这个消息，一切关于这个菜单的消息都要有一个窗体来接收。 如果你对消息不太了解，可以看看网上其它一些关于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 frmmenu.hwnd, gwl_wndproc, premenuwndproc
erase myiteminfo
destroymenu hmenu
end sub
' 创建弹出式菜单
public sub createmenu()
premenuwndproc = setwindowlong(frmmenu.hwnd, gwl_wndproc, addressof menuwndproc)
hmenu = createpopupmenu()
me.style = 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
err.raise 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, frmmenu.hwnd, 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
Java Asp PHP .Net XML C/C++ CGI VB Jsp J2ee J2se J2me EJB Servlet Tomcat Resin Struts Weblogic Eclipse ANT GUI JMS Web servise IDEA Webphere Hibernate Spring Jboss Applet Swing Socket Javamail Perl Ajax P2P 安全 模式 框架 测试 开源 游戏
Windows XP Windows 2000 Windows 2003 Windows Me Windows 9.x Linux UNIX 注册表 操作系统 服务器 应用服务器
