众所周知MS Office 2003推出已经有段时间了但我们依然不会忘记Office XP刚刚推出时其令人耳目新菜单给我们留下深刻印象突起悬浮式图标区别寻常菜单项填充方式不仅让办公族们赞不绝口更让广大员和编程爱好者对这种风格菜单制作产生了浓厚兴趣所以在这篇文章里我们就来好好地研究研究用VB如何制作这种风格菜单在文章最后我将给出源代码下载地址事实上在了解其原理以后不论是用VB、VC还是Delphi都能够制作出XP风格菜单不仅如此我们还可以制作出更加充满个性另类风格菜单比如3D立体风格、渐变风格、多彩风格等等只有想不到没有做不到Follow me！

　　现在我想有必要说说我们现在要做事情事实上我们只要做个菜单类就行了但谁都会明白只做个菜单类是不够我们需要个或者更详细说是个窗体来测试我们菜单类在我个人开发过程中我是先写菜单类后写测试窗体但为了让大家先领略下写好菜单类在应用时是多么方便所以让我们先来看看测试窗体:

　　(1)打开VB新建“标准EXE”工程

　　(2)--下面是窗体Control控件:

　　 组件名称 属性 值
Form Name frmMain
Caption 菜单例子
Frame Name fraStyle
Caption 菜单风格
Label Name lblHelp
Caption 在窗体空白处单击鼠标右键
OptionButton Name opnStyle
Caption Window 标准
Index 0
OptionButton Name opnStyle
Caption XP 风格
Index 1
OptionButton Name opnStyle
Caption 3D 立体风格
Index 2
OptionButton Name opnStyle
Caption 渐变风格
Index 3
OptionButton Name opnStyle
Caption 多彩风格
Index 4



　　其实就是在窗体上添加了个Frame然后在Frame里添加OptionButtonControl控件用来设置菜单风格还有个Label上面只显示行提示文字非常简单

　　(3)窗体代码:

　　Option Explicit
Private Declare Function GetCursorPos Lib "user32.dll" (lpPo As POINTAPI) As Long
Private Type POINTAPI
　X As Long
　Y As Long
End Type
Dim menu As cMenu
Private Sub Form_Load
　' 化菜单并添加菜单项
　Set menu = New cMenu
　menu.CreateMenu
　menu.AddItem "open", LoadPicture("images\open.ico"), "打开", MIT_STRING
　menu.AddItem "save", LoadPicture("images\save.ico"), "保存", MIT_STRING
　menu.AddItem "pr", LoadPicture("images\pr.ico"), "打印", MIT_STRING
　menu.AddItem "find", LoadPicture("images\find.ico"), "查找", MIT_STRING
　menu.AddItem "sep1", LoadPicture, "", MIT_SEPARATOR
　menu.AddItem "undo", LoadPicture("images\undo.ico"), "撤消", MIT_STRING
　menu.AddItem "redo", LoadPicture("images\redo.ico"), "重复", MIT_STRING
　menu.AddItem "sep2", LoadPicture, "", MIT_SEPARATOR
　menu.AddItem "cut", LoadPicture("images\cut.ico"), "剪切", MIT_STRING
　menu.AddItem "copy", LoadPicture("images\copy.ico"), "复制", MIT_STRING
　menu.AddItem "paste", LoadPicture("images\paste.ico"), "粘贴", MIT_STRING
　menu.AddItem "sep3", LoadPicture, "", MIT_SEPARATOR
　menu.AddItem "check", LoadPicture("images\check.ico"), "个 CheckBox", MIT_CHECKBOX
　menu.AddItem "exit", LoadPicture("images\exit.ico"), "退出", MIT_STRING
End Sub
Private Sub Form_MouseDown(Button As Integer, Sht As Integer, X As Single, Y As Single)
　' 单击鼠标右建弹出菜单
　If Button = vbRightButton Then
　　Dim pos As POINTAPI
　　GetCursorPos pos
　　menu.PopupMenu pos.X, pos.Y, POPUP_LEFTALIGN Or POPUP_TOPALIGN
　End If
End Sub
Private Sub Form_Unload(Cancel As Integer)
　' 释放资源, 卸载窗体
　Set menu = Nothing
　Dim frm As Form
　For Each frm In Forms
　　Unload frm
　Next
End Sub
Private Sub opnStyle_Click(Index As Integer)
　' 设置菜单风格
　Select Case Index
　　Case 0 ' Windows 标准
　　　menu.Style = STYLE_WINDOWS
　　Case 1 ' XP 风格
　　　menu.Style = STYLE_XP
　　Case 2 ' 3D 立体风格
　　　menu.Style = STYLE_3D
　　Case 3 ' 渐变风格
　　　menu.Style = STYLE_SHADE
　　Case 4 ' 多彩风格
　　　menu.Style = STYLE_COLORFUL
　End Select
End Sub

　　代码中创建了个cMenu类对象我们编程重点将会放在cMenu类上上面代码只是简单地cMenu在后面文章中我们会看到其实cMenu有多达30个思路方法和属性供我们它Style属性只提供了5种内置风格在实际应用中我们可以利用cMenu类提供思路方法和属性制作出各种各样风格菜单为自己锦上添花

　　(4)运行结果:

　　　FillRect .hdc, itemRect, hBrush
　　　DeleteObject hBrush
　　　' 画菜单项文字
　　　SetTextColor .hdc, TextEnabledColor
　　　DrawText .hdc, MyItemInfo(.itemID).itemText, -1, textRect, DT_SINGLELINE Or DT_LEFT Or DT_VCENTER
　　　' 画菜单项图标
　　　If MyItemInfo(.itemID).itemType <> MIT_CHECKBOX Then
　　　　DrawIconEx .hdc, iconRect.Left + 2, iconRect.Top + (iconRect.Bottom - iconRect.Top + 1 - 16) / 2, MyItemInfo(.itemID).itemIcon, 16, 16, 0, 0, DI_NORMAL
　　　Else
　　　　If MyItemInfo(.itemID).itemState And MIS_CHECKED Then
　　　　　DrawIconEx .hdc, iconRect.Left + 2, iconRect.Top + (iconRect.Bottom - iconRect.Top + 1 - 16) / 2, MyItemInfo(.itemID).itemIcon, 16, 16, 0, 0, DI_NORMAL
　　　End If
　　End If
　End If
　Else ' 当菜单项不可用时
　　' 画菜单项文字
　　SetTextColor .hdc, TextDisabledColor
　　DrawText .hdc, MyItemInfo(.itemID).itemText, -1, textRect, DT_SINGLELINE Or DT_LEFT Or DT_VCENTER
　　' 画菜单项图标
　　If MyItemInfo(.itemID).itemType <> MIT_CHECKBOX Then
　　　DrawState .hdc, 0, 0, MyItemInfo(.itemID).itemIcon, 0, iconRect.Left + 2, iconRect.Top + (iconRect.Bottom - iconRect.Top + 1 - 16) / 2, 0, 0, DST_ICON Or DSS_DISABLED
　　Else
　　　If MyItemInfo(.itemID).itemState And MIS_CHECKED Then
　　　　DrawState .hdc, 0, 0, MyItemInfo(.itemID).itemIcon, 0, iconRect.Left + 2, iconRect.Top + (iconRect.Bottom - iconRect.Top + 1 - 16) / 2, 0, 0, DST_ICON Or DSS_DISABLED
　　End If
　End If
　End If
End If
End With
End If
End Sub
' 菜单项事件响应(单击菜单项)
Private Sub MenuItemSelected(ByVal itemID As Long)
Debug.Pr "鼠标单击了:" & MyItemInfo(itemID).itemText
Select Case MyItemInfo(itemID).itemAlias
Case "exit"
Dim frm As Form
For Each frm In Forms
Unload frm
Next
End Select
End Sub
' 菜单项事件响应(选择菜单项)
Private Sub MenuItemSelecting(ByVal itemID As Long)
Debug.Pr "鼠标移动到:" & MyItemInfo(itemID).itemText
End Sub

　　到此为止我们就完成了菜单类编写且还包括个测试窗体现在完整工程里应该包括两个窗体:frmMain和frmMenu；个标准模块:mMenu；个类模块:cMenu按F5编译运行下在窗体空白处单击鼠标右键如何样出现弹出式菜单了吗？换个风格再试试

　　看完这篇文章后我想你应该已经对采用物主绘图技术自绘菜单有了定了解再看看MS Office 2003菜单其实也没什么难嘛

　　本文在Windows XP、VB6下调试通过