VB打造超酷个性化菜单（三）



现在到了最关键，最精彩，也是最复杂的部分了。我们最关心的就是怎样“画”菜单，怎样处理菜单事件，在MenuWndProc这个处理消息的函数里，我们要处理如下消息：WM_COMMAND（单击菜单项），WM_MEASUREITEM（处理菜单高度和宽度），WM_MENUSELECT（选择菜单项），WM_DRAWITEM（绘制菜单项）。

打开上次建好的工程，添加一个标准模块，并将其名称设置为mMenu，代码如下：

'**************************************************************************************************************

'* 本模块配合 cMenu 菜单类模块

'*

'* 版权: LPP软件工作室

'* 作者: 卢培培(goodname008)

'* (******* 复制请保留以上信息 *******)

'**************************************************************************************************************



Option Explicit



' -=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=- API 函数声明 -=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-



Public Declare Function BitBlt Lib "gdi32" (ByVal hDestDC As Long, ByVal x As Long, ByVal y As Long, ByVal nWidth As Long, ByVal nHeight As Long, ByVal hSrcDC As Long, ByVal xSrc As Long, ByVal ySrc As Long, ByVal dwRop As Long) As Long

Public Declare Function CallWindowProc Lib "user32" Alias "CallWindowProcA" (ByVal lpPrevWndFunc As Long, ByVal hwnd As Long, ByVal Msg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long

Public Declare Function CreateCompatibleDC Lib "gdi32" (ByVal hdc As Long) As Long

Public Declare Function CreatePen Lib "gdi32" (ByVal nPenStyle As Long, ByVal nWidth As Long, ByVal crColor As Long) As Long

Public Declare Function CreatePopupMenu Lib "user32" () As Long

Public Declare Function CreateSolidBrush Lib "gdi32" (ByVal crColor As Long) As Long

Public Declare Function DeleteDC Lib "gdi32" (ByVal hdc As Long) As Long

Public Declare Function DeleteMenu Lib "user32" (ByVal hMenu As Long, ByVal nPosition As Long, ByVal wFlags As Long) As Long

Public Declare Function DeleteObject Lib "gdi32" (ByVal hObject As Long) As Long

Public Declare Function DestroyMenu Lib "user32" (ByVal hMenu As Long) As Long

Public Declare Function DrawEdge Lib "user32" (ByVal hdc As Long, qrc As RECT, ByVal edge As Long, ByVal grfFlags As Long) As Long

Public Declare Function DrawIconEx Lib "user32" (ByVal hdc As Long, ByVal xLeft As Long, ByVal yTop As Long, ByVal hIcon As Long, ByVal cxWidth As Long, ByVal cyWidth As Long, ByVal istepIfAniCur As Long, ByVal hbrFlickerFreeDraw As Long, ByVal diFlags As Long) As Long

Public Declare Function DrawState Lib "user32" Alias "DrawStateA" (ByVal hdc As Long, ByVal hBrush As Long, ByVal lpDrawStateProc As Long, ByVal lParam As Long, ByVal wParam As Long, ByVal n1 As Long, ByVal n2 As Long, ByVal n3 As Long, ByVal n4 As Long, ByVal un As Long) As Long

Public Declare Function DrawText Lib "user32" Alias "DrawTextA" (ByVal hdc As Long, ByVal lpStr As String, ByVal nCount As Long, lpRect As RECT, ByVal wFormat As Long) As Long

Public Declare Function FillRect Lib "user32" (ByVal hdc As Long, lpRect As RECT, ByVal hBrush As Long) As Long

Public Declare Function GetDC Lib "user32" (ByVal hwnd As Long) As Long

Public Declare Function GetMenuItemCount Lib "user32" (ByVal hMenu As Long) As Long

Public Declare Function GetMenuItemID Lib "user32" (ByVal hMenu As Long, ByVal nPos As Long) As Long

Public Declare Function GetMenuItemInfo Lib "user32" Alias "GetMenuItemInfoA" (ByVal hMenu As Long, ByVal un As Long, ByVal b As Long, lpMenuItemInfo As MENUITEMINFO) As Long

Public Declare Function GetSysColor Lib "user32" (ByVal nIndex As Long) As Long

Public Declare Function GetSystemMetrics Lib "user32" (ByVal nIndex As Long) As Long

Public Declare Function InflateRect Lib "user32" (lpRect As RECT, ByVal x As Long, ByVal y As Long) As Long

Public Declare Function InsertMenuItem Lib "user32" Alias "InsertMenuItemA" (ByVal hMenu As Long, ByVal un As Long, ByVal bool As Boolean, ByRef lpcMenuItemInfo As MENUITEMINFO) As Long

Public Declare Function LineTo Lib "gdi32" (ByVal hdc As Long, ByVal x As Long, ByVal y As Long) As Long

Public Declare Function lstrlen Lib "kernel32" Alias "lstrlenA" (ByVal lpString As String) As Long

Public Declare Function MoveToEx Lib "gdi32" (ByVal hdc As Long, ByVal x As Long, ByVal y As Long, lpPoint As Long) As Long

Public Declare Function Rectangle Lib "gdi32" (ByVal hdc As Long, ByVal X1 As Long, ByVal Y1 As Long, ByVal X2 As Long, ByVal Y2 As Long) As Long

Public Declare Function ReleaseDC Lib "user32" (ByVal hwnd As Long, ByVal hdc As Long) As Long

Public Declare Function SelectObject Lib "gdi32" (ByVal hdc As Long, ByVal hObject As Long) As Long

Public Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long

Public Declare Function SetBkMode Lib "gdi32" (ByVal hdc As Long, ByVal nBkMode As Long) As Long

Public Declare Function SetMenuItemInfo Lib "user32" Alias "SetMenuItemInfoA" (ByVal hMenu As Long, ByVal un As Long, ByVal bool As Boolean, lpcMenuItemInfo As MENUITEMINFO) As Long

Public Declare Function SetTextColor Lib "gdi32" (ByVal hdc As Long, ByVal crColor As Long) As Long

Public Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long



Public Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal Length As Long)





' -=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=- API 常量声明 -=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-



Public Const GWL_WNDPROC = (-4) ' SetWindowLong 设置窗口函数入口地址

Public Const SM_CYMENU = 15 ' GetSystemMetrics 获得系统菜单项高度



Public Const WM_COMMAND = &H111 ' 消息: 单击菜单项

Public Const WM_DRAWITEM = &H2B ' 消息: 绘制菜单项

Public Const WM_EXITMENULOOP = &H212 ' 消息: 退出菜单消息循环

Public Const WM_MEASUREITEM = &H2C ' 消息: 处理菜单高度和宽度

Public Const WM_MENUSELECT = &H11F ' 消息: 选择菜单项



' ODT

Public Const ODT_MENU = 1 ' 菜单

Public Const ODT_LISTBOX = 2 ' 列表框

Public Const ODT_COMBOBOX = 3 ' 组合框

Public Const ODT_BUTTON = 4 ' 按钮



' ODS

Public Const ODS_SELECTED = &H1 ' 菜单被选择

Public Const ODS_GRAYED = &H2 ' 灰色字

Public Const ODS_DISABLED = &H4 ' 禁用

Public Const ODS_CHECKED = &H8 ' 选中

Public Const ODS_FOCUS = &H10 ' 聚焦



' diFlags to DrawIconEx

Public Const DI_MASK = &H1 ' 绘图时使用图标的MASK部分 (如单独使用, 可获得图标的掩模)

Public Const DI_IMAGE = &H2 ' 绘图时使用图标的XOR部分 (即图标没有透明区域)

Public Const DI_NORMAL = DI_MASK Or DI_IMAGE ' 用常规方式绘图 (合并 DI_IMAGE 和 DI_MASK)



' nBkMode to SetBkMode

Public Const TRANSPARENT = 1 ' 透明处理, 即不作上述填充

Public Const OPAQUE = 2 ' 用当前的背景色填充虚线画笔、阴影刷子以及字符的空隙

Public Const NEWTRANSPARENT = 3 ' 在有颜色的菜单上画透明文字





' MF 菜单相关常数

Public Const MF_BYCOMMAND = &H0& ' 菜单条目由菜单的命令ID指定

Public Const MF_BYPOSITION = &H400& ' 菜单条目由条目在菜单中的位置决定 (零代表菜单中的第一个条目)



Public Const MF_CHECKED = &H8& ' 检查指定的菜单条目 (不能与VB的Checked属性兼容)

Public Const MF_DISABLED = &H2& ' 禁止指定的菜单条目 (不与VB的Enabled属性兼容)

Public Const MF_ENABLED = &H0& ' 允许指定的菜单条目 (不与VB的Enabled属性兼容)

Public Const MF_GRAYED = &H1& ' 禁止指定的菜单条目, 并用浅灰色描述它. (不与VB的Enabled属性兼容)

Public Const MF_HILITE = &H80&

Public Const MF_SEPARATOR = &H800& ' 在指定的条目处显示一条分隔线

Public Const MF_STRING = &H0& ' 在指定的条目处放置一个字串 (不与VB的Caption属性兼容)

Public Const MF_UNCHECKED = &H0& ' 检查指定的条目 (不能与VB的Checked属性兼容)

Public Const MF_UNHILITE = &H0&



Public Const MF_BITMAP = &H4& ' 菜单条目是一幅位图. 一旦设入菜单, 这幅位图就绝对不能删除, 所以不应该使用由VB的Image属性返回的值.

Public Const MF_OWNERDRAW = &H100& ' 创建一个物主绘图菜单 (由您设计的程序负责描绘每个菜单条目)

Public Const MF_USECHECKBITMAPS = &H200&



Public Const MF_MENUBARBREAK = &H20& ' 在弹出式菜单中, 将指定的条目放置于一个新列, 并用一条垂直线分隔不同的列.

Public Const MF_MENUBREAK = &H40& ' 在弹出式菜单中, 将指定的条目放置于一个新列. 在顶级菜单中, 将条目放置到一个新行.



Public Const MF_POPUP = &H10& ' 将一个弹出式菜单置于指定的条目, 可用于创建子菜单及弹出式菜单.

Public Const MF_HELP = &H4000&



Public Const MF_DEFAULT = &H1000

Public Const MF_RIGHTJUSTIFY = &H4000



' fMask To InsertMenuItem ' 指定 MENUITEMINFO 中哪些成员有效

Public Const MIIM_STATE = &H1

Public Const MIIM_ID = &H2

Public Const MIIM_SUBMENU = &H4

Public Const MIIM_CHECKMARKS = &H8

Public Const MIIM_TYPE = &H10

Public Const MIIM_DATA = &H20

Public Const MIIM_STRING = &H40

Public Const MIIM_BITMAP = &H80

Public Const MIIM_FTYPE = &H100



' fType To InsertMenuItem ' MENUITEMINFO 中菜单项类型

Public Const MFT_BITMAP = &H4&

Public Const MFT_MENUBARBREAK = &H20&

Public Const MFT_MENUBREAK = &H40&

Public Const MFT_OWNERDRAW = &H100&

Public Const MFT_SEPARATOR = &H800&

Public Const MFT_STRING = &H0&



' fState to InsertMenuItem ' MENUITEMINFO 中菜单项状态

Public Const MFS_CHECKED = &H8&

Public Const MFS_DISABLED = &H2&

Public Const MFS_ENABLED = &H0&

Public Const MFS_GRAYED = &H1&

Public Const MFS_HILITE = &H80&

Public Const MFS_UNCHECKED = &H0&

Public Const MFS_UNHILITE = &H0&



' nFormat to DrawText

Public Const DT_LEFT = &H0 ' 水平左对齐

Public Const DT_CENTER = &H1 ' 水平居中对齐

Public Const DT_RIGHT = &H2 ' 水平右对齐



Public Const DT_SINGLELINE = &H20 ' 单行



Public Const DT_TOP = &H0 ' 垂直上对齐 (仅单行时有效)

Public Const DT_VCENTER = &H4 ' 垂直居中对齐 (仅单行时有效)

Public Const DT_BOTTOM = &H8 ' 垂直下对齐 (仅单行时有效)



Public Const DT_CALCRECT = &H400 ' 多行绘图时矩形的底边根据需要进行延展, 以便容下所有文字; 单行绘图时, 延展矩形的右侧, 不描绘文字, 由lpRect参数指定的矩形会载入计算出来的值.

Public Const DT_WORDBREAK = &H10 ' 进行自动换行. 如用SetTextAlign函数设置了TA_UPDATECP标志, 这里的设置则无效.



Public Const DT_NOCLIP = &H100 ' 描绘文字时不剪切到指定的矩形

Public Const DT_NOPREFIX = &H800 ' 通常, 函数认为 & 字符表示应为下一个字符加上下划线, 该标志禁止这种行为.



Public Const DT_EXPANDTABS = &H40 ' 描绘文字的时候, 对制表站进行扩展. 默认的制表站间距是8个字符. 但是, 可用DT_TABSTOP标志改变这项设定.

Public Const DT_TABSTOP = &H80 ' 指定新的制表站间距, 采用这个整数的高 8 位.

Public Const DT_EXTERNALLEADING = &H200 ' 计算文本行高度的时候, 使用当前字体的外部间距属性.



' nIndex to GetSysColor 标准: 0--20

Public Const COLOR_ACTIVEBORDER = 10 ' 活动窗口的边框

Public Const COLOR_ACTIVECAPTION = 2 ' 活动窗口的标题

Public Const COLOR_APPWORKSPACE = 12 ' MDI桌面的背景

Public Const COLOR_BACKGROUND = 1 ' Windows 桌面

Public Const COLOR_BTNFACE = 15 ' 按钮

Public Const COLOR_BTNHIGHLIGHT = 20 ' 按钮的3D加亮区

Public Const COLOR_BTNSHADOW = 16 ' 按钮的3D阴影

Public Const COLOR_BTNTEXT = 18 ' 按钮文字

Public Const COLOR_CAPTIONTEXT = 9 ' 窗口标题中的文字

Public Const COLOR_GRAYTEXT = 17 ' 灰色文字; 如使用了抖动技术则为零

Public Const COLOR_HIGHLIGHT = 13 ' 选定的项目背景

Public Const COLOR_HIGHLIGHTTEXT = 14 ' 选定的项目文字

Public Const COLOR_INACTIVEBORDER = 11 ' 不活动窗口的边框

Public Const COLOR_INACTIVECAPTION = 3 ' 不活动窗口的标题

Public Const COLOR_INACTIVECAPTIONTEXT = 19 ' 不活动窗口的文字

Public Const COLOR_MENU = 4 ' 菜单

Public Const COLOR_MENUTEXT = 7 ' 菜单文字

Public Const COLOR_SCROLLBAR = 0 ' 滚动条

Public Const COLOR_WINDOW = 5 ' 窗口背景

Public Const COLOR_WINDOWFRAME = 6 ' 窗框

Public Const COLOR_WINDOWTEXT = 8 ' 窗口文字



' un to DrawState

Public Const DST_COMPLEX = &H0 ' 绘图在由lpDrawStateProc参数指定的回调函数期间执行, lParam和wParam会传递给回调事件.

Public Const DST_TEXT = &H1 ' lParam代表文字的地址(可使用一个字串别名),wParam代表字串的长度.

Public Const DST_PREFIXTEXT = &H2 ' 与DST_TEXT类似, 只是 & 字符指出为下各字符加上下划线.

Public Const DST_ICON = &H3 ' lParam包括图标的句柄

Public Const DST_BITMAP = &H4 ' lParam包括位图的句柄

Public Const DSS_NORMAL = &H0 ' 普通图像

Public Const DSS_UNION = &H10 ' 图像进行抖动处理

Public Const DSS_DISABLED = &H20 ' 图象具有浮雕效果

Public Const DSS_MONO = &H80 ' 用hBrush描绘图像

Public Const DSS_RIGHT = &H8000 ' 无任何作用



' edge to DrawEdge

Public Const BDR_RAISEDOUTER = &H1 ' 外层凸

Public Const BDR_SUNKENOUTER = &H2 ' 外层凹

Public Const BDR_RAISEDINNER = &H4 ' 内层凸

Public Const BDR_SUNKENINNER = &H8 ' 内层凹

Public Const BDR_OUTER = &H3

Public Const BDR_RAISED = &H5

Public Const BDR_SUNKEN = &HA

Public Const BDR_INNER = &HC

Public Const EDGE_BUMP = (BDR_RAISEDOUTER Or BDR_SUNKENINNER)

Public Const EDGE_ETCHED = (BDR_SUNKENOUTER Or BDR_RAISEDINNER)

Public Const EDGE_RAISED = (BDR_RAISEDOUTER Or BDR_RAISEDINNER)

Public Const EDGE_SUNKEN = (BDR_SUNKENOUTER Or BDR_SUNKENINNER)



' grfFlags to DrawEdge

Public Const BF_LEFT = &H1 ' 左边缘

Public Const BF_TOP = &H2 ' 上边缘

Public Const BF_RIGHT = &H4 ' 右边缘

Public Const BF_BOTTOM = &H8 ' 下边缘

Public Const BF_DIAGONAL = &H10 ' 对角线

Public Const BF_MIDDLE = &H800 ' 填充矩形内部

Public Const BF_SOFT = &H1000 ' MSDN: Soft buttons instead of tiles.

Public Const BF_ADJUST = &H2000 ' 调整矩形, 预留客户区

Public Const BF_FLAT = &H4000 ' 平面边缘

Public Const BF_MONO = &H8000 ' 一维边缘



Public Const BF_RECT = (BF_LEFT Or BF_TOP Or BF_RIGHT Or BF_BOTTOM)

Public Const BF_TOPLEFT = (BF_TOP Or BF_LEFT)

Public Const BF_TOPRIGHT = (BF_TOP Or BF_RIGHT)

Public Const BF_BOTTOMLEFT = (BF_BOTTOM Or BF_LEFT)

Public Const BF_BOTTOMRIGHT = (BF_BOTTOM Or BF_RIGHT)

Public Const BF_DIAGONAL_ENDTOPLEFT = (BF_DIAGONAL Or BF_TOP Or BF_LEFT)

Public Const BF_DIAGONAL_ENDTOPRIGHT = (BF_DIAGONAL Or BF_TOP Or BF_RIGHT)

Public Const BF_DIAGONAL_ENDBOTTOMLEFT = (BF_DIAGONAL Or BF_BOTTOM Or BF_LEFT)

Public Const BF_DIAGONAL_ENDBOTTOMRIGHT = (BF_DIAGONAL Or BF_BOTTOM Or BF_RIGHT)



' nPenStyle to CreatePen

Public Const PS_DASH = 1 ' 画笔类型:虚线 (nWidth必须是1) -------

Public Const PS_DASHDOT = 3 ' 画笔类型:点划线 (nWidth必须是1) _._._._

Public Const PS_DASHDOTDOT = 4 ' 画笔类型:点-点-划线 (nWidth必须是1) _.._.._

Public Const PS_DOT = 2 ' 画笔类型:点线 (nWidth必须是1) .......

Public Const PS_SOLID = 0 ' 画笔类型:实线 _______





' -=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=- API 类型声明 -=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-



Public Type RECT

Left As Long

Top As Long

Right As Long

Bottom As Long

End Type



Public Type DRAWITEMSTRUCT

CtlType As Long

CtlID As Long

itemID As Long

itemAction As Long

itemState As Long

hwndItem As Long

hdc As Long

rcItem As RECT

itemData As Long

End Type



Public Type MENUITEMINFO

cbSize As Long

fMask As Long

fType As Long

fState As Long

wID As Long

hSubMenu As Long

hbmpChecked As Long

hbmpUnchecked As Long

dwItemData As Long

dwTypeData As String

cch As Long

End Type



Public Type MEASUREITEMSTRUCT

CtlType As Long

CtlID As Long

itemID As Long

itemWidth As Long

itemHeight As Long

itemData As Long

End Type



Public Type Size

cx As Long

cy As Long

End Type





' 自定义菜单项数据结构

Public Type MyMenuItemInfo

itemIcon As StdPicture

itemAlias As String

itemText As String

itemType As MenuItemType

itemState As MenuItemState

End Type



' 菜单相关结构

Private MeasureInfo As MEASUREITEMSTRUCT

Private DrawInfo As DRAWITEMSTRUCT



Public hMenu As Long

Public preMenuWndProc As Long

Public MyItemInfo() As MyMenuItemInfo



' 菜单类属性

Public BarWidth As Long ' 菜单附加条宽度

Public BarStyle As MenuLeftBarStyle ' 菜单附加条风格

Public BarImage As StdPicture ' 菜单附加条图像

Public BarStartColor As Long ' 菜单附加条过渡色起始颜色

Public BarEndColor As Long ' 菜单附加条过渡色终止颜色

Public SelectScope As MenuItemSelectScope ' 菜单项高亮条的范围

Public TextEnabledColor As Long ' 菜单项可用时文字颜色

Public TextDisabledColor As Long ' 菜单项不可用时文字颜色

Public TextSelectColor As Long ' 菜单项选中时文字颜色

Public IconStyle As MenuItemIconStyle ' 菜单项图标风格

Public EdgeStyle As MenuItemSelectEdgeStyle ' 菜单项边框风格

Public EdgeColor As Long ' 菜单项边框颜色

Public FillStyle As MenuItemSelectFillStyle ' 菜单项背景填充风格

Public FillStartColor As Long ' 菜单项过渡色起始颜色

Public FillEndColor As Long ' 菜单项过渡色终止颜色

Public BkColor As Long ' 菜单背景颜色

Public SepStyle As MenuSeparatorStyle ' 菜单分隔条风格

Public SepColor As Long ' 菜单分隔条颜色

Public MenuStyle As MenuUserStyle ' 菜单总体风格



' 拦截菜单消息 (frmMenu 窗口入口函数)

Function MenuWndProc(ByVal hwnd As Long, ByVal Msg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long

Select Case Msg

Case WM_COMMAND ' 单击菜单项

If MyItemInfo(wParam).itemType = MIT_CHECKBOX Then

If MyItemInfo(wParam).itemState = MIS_CHECKED Then

MyItemInfo(wParam).itemState = MIS_UNCHECKED

Else

MyItemInfo(wParam).itemState = MIS_CHECKED

End If

End If

MenuItemSelected wParam

Case WM_EXITMENULOOP ' 退出菜单消息循环(保留)



Case WM_MEASUREITEM ' 处理菜单项高度和宽度

MeasureItem hwnd, lParam

Case WM_MENUSELECT ' 选择菜单项

Dim itemID As Long

itemID = GetMenuItemID(lParam, wParam And &HFF)

If itemID <> -1 Then

MenuItemSelecting itemID

End If

Case WM_DRAWITEM ' 绘制菜单项

DrawItem lParam

End Select

MenuWndProc = CallWindowProc(preMenuWndProc, hwnd, Msg, wParam, lParam)

End Function



' 处理菜单高度和宽度

Private Sub MeasureItem(ByVal hwnd As Long, ByVal lParam As Long)

Dim TextSize As Size, hdc As Long

hdc = GetDC(hwnd)

CopyMemory MeasureInfo, ByVal lParam, Len(MeasureInfo)

If MeasureInfo.CtlType And ODT_MENU Then

MeasureInfo.itemWidth = lstrlen(MyItemInfo(MeasureInfo.itemID).itemText) * (GetSystemMetrics(SM_CYMENU) / 2.5) + BarWidth

If MyItemInfo(MeasureInfo.itemID).itemType <> MIT_SEPARATOR Then

MeasureInfo.itemHeight = GetSystemMetrics(SM_CYMENU)

Else

MeasureInfo.itemHeight = 6

End If

End If

CopyMemory ByVal lParam, MeasureInfo, Len(MeasureInfo)

ReleaseDC hwnd, hdc

End Sub



' 绘制菜单项

Private Sub DrawItem(ByVal lParam As Long)

Dim hPen As Long, hBrush As Long

Dim itemRect As RECT, barRect As RECT, iconRect As RECT, textRect As RECT

Dim i As Long

CopyMemory DrawInfo, ByVal lParam, Len(DrawInfo)

If DrawInfo.CtlType = ODT_MENU Then

SetBkMode DrawInfo.hdc, TRANSPARENT



' 初始化菜单项矩形, 图标矩形, 文字矩形

itemRect = DrawInfo.rcItem

iconRect = DrawInfo.rcItem

textRect = DrawInfo.rcItem



' 设置菜单附加条矩形

With barRect

.Left = 0

.Top = 0

.Right = BarWidth - 1

For i = 0 To GetMenuItemCount(hMenu) - 1

If MyItemInfo(i).itemType = MIT_SEPARATOR Then

.Bottom = .Bottom + 6

Else

.Bottom = .Bottom + MeasureInfo.itemHeight

End If

Next i

.Bottom = .Bottom - 1

End With



' 设置图标矩形, 文字矩形

If BarStyle <> LBS_NONE Then iconRect.Left = barRect.Right + 2

iconRect.Right = iconRect.Left + 20

textRect.Left = iconRect.Right + 3



With DrawInfo



' 画菜单背景

itemRect.Left = barRect.Right

hBrush = CreateSolidBrush(BkColor)

FillRect .hdc, itemRect, hBrush

DeleteObject hBrush





' 画菜单左边的附加条

Dim RedArea As Long, GreenArea As Long, BlueArea As Long

Dim red As Long, green As Long, blue As Long

Select Case BarStyle

Case LBS_NONE ' 无附加条



Case LBS_SOLIDCOLOR ' 实色填充



hBrush = CreateSolidBrush(BarStartColor)

FillRect .hdc, barRect, hBrush

DeleteObject hBrush



Case LBS_HORIZONTALCOLOR ' 水平过渡色



BlueArea = Int(BarEndColor / &H10000) - Int(BarStartColor / &H10000)

GreenArea = (Int(BarEndColor / &H100) And &HFF) - (Int(BarStartColor / &H100) And &HFF)

RedArea = (BarEndColor And &HFF) - (BarStartColor And &HFF)



For i = 0 To BarWidth - 1

red = Int(BarStartColor And &HFF) + Int(i / BarWidth * RedArea)

green = (Int(BarStartColor / &H100) And &HFF) + Int(i / BarWidth * GreenArea)

blue = Int(BarStartColor / &H10000) + Int(i / BarWidth * BlueArea)

hPen = CreatePen(PS_SOLID, 1, RGB(red, green, blue))

Call SelectObject(.hdc, hPen)

Call MoveToEx(.hdc, i, 0, 0)

Call LineTo(.hdc, i, barRect.Bottom)

Call DeleteObject(hPen)

Next i



Case LBS_VERTICALCOLOR ' 垂直过渡色



BlueArea = Int(BarEndColor / &H10000) - Int(BarStartColor / &H10000)

GreenArea = (Int(BarEndColor / &H100) And &HFF) - (Int(BarStartColor / &H100) And &HFF)

RedArea = (BarEndColor And &HFF) - (BarStartColor And &HFF)



For i = 0 To barRect.Bottom

red = Int(BarStartColor And &HFF) + Int(i / (barRect.Bottom + 1) * RedArea)

green = (Int(BarStartColor / &H100) And &HFF) + Int(i / (barRect.Bottom + 1) * GreenArea)

blue = Int(BarStartColor / &H10000) + Int(i / (barRect.Bottom + 1) * BlueArea)

hPen = CreatePen(PS_SOLID, 1, RGB(red, green, blue))

Call SelectObject(.hdc, hPen)

Call MoveToEx(.hdc, 0, i, 0)

Call LineTo(.hdc, barRect.Right, i)

Call DeleteObject(hPen)

Next i



Case LBS_IMAGE ' 图像



If BarImage.Handle <> 0 Then

Dim barhDC As Long

barhDC = CreateCompatibleDC(GetDC(0))

SelectObject barhDC, BarImage.Handle

BitBlt .hdc, 0, 0, BarWidth, barRect.Bottom - barRect.Top + 1, barhDC, 0, 0, vbSrcCopy

DeleteDC barhDC

End If



End Select





' 画菜单项

If MyItemInfo(.itemID).itemType = MIT_SEPARATOR Then

' 画菜单分隔条(MIT_SEPARATOR)

If MyItemInfo(.itemID).itemType = MIT_SEPARATOR Then

itemRect.Top = itemRect.Top + 2

itemRect.Bottom = itemRect.Top + 1

itemRect.Left = barRect.Right + 5

Select Case SepStyle

Case MSS_NONE ' 无分隔条



Case MSS_DEFAULT ' 默认样式

DrawEdge .hdc, itemRect, EDGE_ETCHED, BF_TOP

Case Else ' 其它

hPen = CreatePen(SepStyle, 0, SepColor)

hBrush = CreateSolidBrush(BkColor)

SelectObject .hdc, hPen

SelectObject .hdc, hBrush

Rectangle .hdc, itemRect.Left, itemRect.Top, itemRect.Right, itemRect.Bottom

DeleteObject hPen

DeleteObject hBrush

End Select

End If

Else

If Not CBool(MyItemInfo(.itemID).itemState And MIS_DISABLED) Then ' 当菜单项可用时

If .itemState And ODS_SELECTED Then ' 当鼠标移动到菜单项时



' 设置菜单项高亮范围

If SelectScope And ISS_ICON_TEXT Then

itemRect.Left = iconRect.Left

ElseIf SelectScope And ISS_TEXT Then

itemRect.Left = textRect.Left - 2

Else

itemRect.Left = .rcItem.Left

End If





' 处理菜单项无图标或为CHECKBOX时的情况

If (MyItemInfo(.itemID).itemType = MIT_CHECKBOX Or MyItemInfo(.itemID).itemIcon = 0) And SelectScope <> ISS_LEFTBAR_ICON_TEXT Then

itemRect.Left = iconRect.Left

End If





' 画菜单项边框

Select Case EdgeStyle

Case ISES_NONE ' 无边框



Case ISES_SUNKEN ' 凹进

DrawEdge .hdc, itemRect, BDR_SUNKENOUTER, BF_RECT

Case ISES_RAISED ' 凸起

DrawEdge .hdc, itemRect, BDR_RAISEDINNER, BF_RECT

Case Else ' 其它

hPen = CreatePen(EdgeStyle, 0, EdgeColor)

hBrush = CreateSolidBrush(BkColor)

SelectObject .hdc, hPen

SelectObject .hdc, hBrush

Rectangle .hdc, itemRect.Left, itemRect.Top, itemRect.Right, itemRect.Bottom

DeleteObject hPen

DeleteObject hBrush

End Select





' 画菜单项背景

InflateRect itemRect, -1, -1

Select Case FillStyle

Case ISFS_NONE ' 无背景



Case ISFS_HORIZONTALCOLOR ' 水平渐变色



BlueArea = Int(FillEndColor / &H10000) - Int(FillStartColor / &H10000)

GreenArea = (Int(FillEndColor / &H100) And &HFF) - (Int(FillStartColor / &H100) And &HFF)

RedArea = (FillEndColor And &HFF) - (FillStartColor And &HFF)



For i = itemRect.Left To itemRect.Right - 1

red = Int(FillStartColor And &HFF) + Int((i - itemRect.Left) / (itemRect.Right - itemRect.Left + 1) * RedArea)

green = (Int(FillStartColor / &H100) And &HFF) + Int((i - itemRect.Left) / (itemRect.Right - itemRect.Left + 1) * GreenArea)

blue = Int(FillStartColor / &H10000) + Int((i - itemRect.Left) / (itemRect.Right - itemRect.Left + 1) * BlueArea)

hPen = CreatePen(PS_SOLID, 1, RGB(red, green, blue))

Call SelectObject(.hdc, hPen)

Call MoveToEx(.hdc, i, itemRect.Top, 0)

Call LineTo(.hdc, i, itemRect.Bottom)

Call DeleteObject(hPen)

Next i



Case ISFS_VERTICALCOLOR ' 垂直渐变色



BlueArea = Int(FillEndColor / &H10000) - Int(FillStartColor / &H10000)

GreenArea = (Int(FillEndColor / &H100) And &HFF) - (Int(FillStartColor / &H100) And &HFF)

RedArea = (FillEndColor And &HFF) - (FillStartColor And &HFF)



For i = itemRect.Top To itemRect.Bottom - 1

red = Int(FillStartColor And &HFF) + Int((i - itemRect.Top) / (itemRect.Bottom - itemRect.Top + 1) * RedArea)

green = (Int(FillStartColor / &H100) And &HFF) + Int((i - itemRect.Top) / (itemRect.Bottom - itemRect.Top + 1) * GreenArea)

blue = Int(FillStartColor / &H10000) + Int((i - itemRect.Top) / (itemRect.Bottom - itemRect.Top + 1) * BlueArea)

hPen = CreatePen(PS_SOLID, 1, RGB(red, green, blue))

Call SelectObject(.hdc, hPen)

Call MoveToEx(.hdc, itemRect.Left, i, 0)

Call LineTo(.hdc, itemRect.Right, i)

Call DeleteObject(hPen)

Next i



Case ISFS_SOLIDCOLOR ' 实色填充



hPen = CreatePen(PS_SOLID, 0, FillStartColor)

hBrush = CreateSolidBrush(FillStartColor)

SelectObject .hdc, hPen

SelectObject .hdc, hBrush

Rectangle .hdc, itemRect.Left, itemRect.Top, itemRect.Right, itemRect.Bottom

DeleteObject hPen

DeleteObject hBrush



End Select





' 画菜单项文字

SetTextColor .hdc, TextSelectColor

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

Select Case IconStyle

Case IIS_NONE ' 无效果



Case IIS_SUNKEN ' 凹进

If MyItemInfo(.itemID).itemIcon <> 0 Then

DrawEdge .hdc, iconRect, BDR_SUNKENOUTER, BF_RECT

End If

Case IIS_RAISED ' 凸起

If MyItemInfo(.itemID).itemIcon <> 0 Then

DrawEdge .hdc, iconRect, BDR_RAISEDINNER, BF_RECT

End If

Case IIS_SHADOW ' 阴影

hBrush = CreateSolidBrush(RGB(128, 128, 128))

DrawState .hdc, hBrush, 0, MyItemInfo(.itemID).itemIcon, 0, iconRect.Left + 3, iconRect.Top + (iconRect.Bottom - iconRect.Top + 1 - 16) / 2 + 1, 0, 0, DST_ICON Or DSS_MONO

DeleteObject hBrush

DrawIconEx .hdc, iconRect.Left + 1, iconRect.Top + (iconRect.Bottom - iconRect.Top + 1 - 16) / 2 - 1, MyItemInfo(.itemID).itemIcon, 16, 16, 0, 0, DI_NORMAL

End Select

Else

' CHECKBOX型菜单项图标效果

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



Else ' 当鼠标移开菜单项时



' 画菜单项边框和背景(清除)

If BarStyle <> LBS_NONE Then

itemRect.Left = barRect.Right + 1

Else

itemRect.Left = 0

End If

hBrush = CreateSolidBrush(BkColor)

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.Print "鼠标单击了：" & 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.Print "鼠标移动到：" & MyItemInfo(itemID).itemText

End Sub



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

在看完这个系列的文章后，我想你应该已经对采用物主绘图技术的自绘菜单有一定的了解了，回过头来再看看MS Office 2003的菜单，其实也没什么难的嘛。以后，我们就可以在自己的任何程序中调用这个写好的菜单类，为自己的程序添光加彩了。 :)

该程序在Windows XP、VB6下调试通过。

源代码下载地址：http://y365.com/ses518/soft/samplecsdn.zip