VB打造超酷个性化菜单

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

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

　　（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）窗体代码：

Option Explicit

Private Declare Function GetCursorPos Lib "user32.dll" (lpPoint 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 "print", LoadPicture("images\print.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, Shift 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）运行结果：

图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 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

' 设置菜单项状态
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 = itemAlias Then
            MyItemInfo(i).itemState = itemState
            Dim ItemInfo As MENUITEMINFO
            With ItemInfo
                .cbSize = Len(ItemInfo)
                .fMask = MIIM_STRING Or MIIM_FTYPE Or MIIM_STATE Or 
MIIM_SUBMENU Or MIIM_ID Or MIIM_DATA
            End With
            GetMenuItemInfo hMenu, i, False, ItemInfo
            With ItemInfo
                .fState = .fState Or itemState
            End With
            SetMenuItemInfo hMenu, i, False, ItemInfo
            Exit For
        End If
    Next i
End Sub
' 获得菜单项状态
Public Function GetItemState(ByVal itemAlias As String) As MenuItemState
    Dim i As Long
    For i = 0 To UBound(MyItemInfo)
        If MyItemInfo(i).itemAlias = itemAlias Then
            GetItemState = MyItemInfo(i).itemState
            Exit For
        End If
    Next i
End Function
' 属性: 菜单句柄
Public Property Get hwnd() As Long
    hwnd = hMenu
End Property
Public Property Let hwnd(ByVal nValue As Long)
End Property
' 属性: 菜单附加条宽度
Public Property Get LeftBarWidth() As Long
    LeftBarWidth = BarWidth
End Property
Public Property Let LeftBarWidth(ByVal nBarWidth As Long)
    If nBarWidth >= 0 Then
        BarWidth = nBarWidth
    End If
End Property
' 属性: 菜单附加条风格
Public Property Get LeftBarStyle() As MenuLeftBarStyle
    LeftBarStyle = BarStyle
End Property
Public Property Let LeftBarStyle(ByVal nBarStyle As MenuLeftBarStyle)
    If nBarStyle >= 0 And nBarStyle >= 4 Then
        BarStyle = nBarStyle
    End If
End Property
' 属性: 菜单附加条图像(只有当 LeftBarStyle 设置为 LBS_IMAGE 时才有效)
Public Property Get LeftBarImage() As StdPicture
    Set LeftBarImage = BarImage
End Property
Public Property Let LeftBarImage(ByVal nBarImage As StdPicture)
    Set BarImage = nBarImage
End Property
' 属性: 菜单附加条过渡色起始颜色(只有当 LeftBarStyle 设置为 LBS_HORIZONTALCOLOR 或 LBS_VERTICALCOLOR 时才有效)
'       当 LeftBarStyle 设置为 LBS_SOLIDCOLOR (实色填充)时以 LeftBarStartColor 颜色为准
Public Property Get LeftBarStartColor() As Long
    LeftBarStartColor = BarStartColor
End Property
Public Property Let LeftBarStartColor(ByVal nBarStartColor As Long)
    BarStartColor = nBarStartColor
End Property
' 属性: 菜单附加条过渡色终止颜色(只有当 LeftBarStyle 设置为 LBS_HORIZONTALCOLOR 或 LBS_VERTICALCOLOR 时才有效)
'       当 LeftBarStyle 设置为 LBS_SOLIDCOLOR (实色填充)时以 LeftBarStartColor 颜色为准
Public Property Get LeftBarEndColor() As Long
    LeftBarEndColor = BarEndColor
End Property
Public Property Let LeftBarEndColor(ByVal nBarEndColor As Long)
    BarEndColor = nBarEndColor
End Property
' 属性: 菜单项高亮条的范围
Public Property Get ItemSelectScope() As MenuItemSelectScope
    ItemSelectScope = SelectScope
End Property
Public Property Let ItemSelectScope(ByVal nSelectScope As MenuItemSelectScope)
    SelectScope = nSelectScope
End Property
' 属性: 菜单项可用时文字颜色
Public Property Get ItemTextEnabledColor() As Long
    ItemTextEnabledColor = TextEnabledColor
End Property
Public Property Let ItemTextEnabledColor(ByVal nTextEnabledColor As Long)
    TextEnabledColor = nTextEnabledColor
End Property
' 属性: 菜单项不可用时文字颜色
Public Property Get ItemTextDisabledColor() As Long
    ItemTextDisabledColor = TextDisabledColor
End Property
Public Property Let ItemTextDisabledColor(ByVal nTextDisabledColor As Long)
    TextDisabledColor = nTextDisabledColor
End Property
' 属性: 菜单项选中时文字颜色
Public Property Get ItemTextSelectColor() As Long
    ItemTextSelectColor = TextSelectColor
End Property
Public Property Let ItemTextSelectColor(ByVal nTextSelectColor As Long)
    TextSelectColor = nTextSelectColor
End Property
' 属性: 菜单项图标风格
Public Property Get ItemIconStyle() As MenuItemIconStyle
    ItemIconStyle = IconStyle
End Property
Public Property Let ItemIconStyle(ByVal nIconStyle As MenuItemIconStyle)
    IconStyle = nIconStyle
End Property
' 属性: 菜单项边框风格
Public Property Get ItemSelectEdgeStyle() As MenuItemSelectEdgeStyle
    ItemSelectEdgeStyle = EdgeStyle
End Property
Public Property Let ItemSelectEdgeStyle(ByVal nEdgeStyle As MenuItemSelectEdgeStyle)
    EdgeStyle = nEdgeStyle
End Property
' 属性: 菜单项边框颜色
Public Property Get ItemSelectEdgeColor() As Long
    ItemSelectEdgeColor = EdgeColor
End Property
Public Property Let ItemSelectEdgeColor(ByVal nEdgeColor As Long)
    EdgeColor = nEdgeColor
End Property
' 属性: 菜单项背景填充风格
Public Property Get ItemSelectFillStyle() As MenuItemSelectFillStyle
    ItemSelectFillStyle = FillStyle
End Property
Public Property Let ItemSelectFillStyle(ByVal nFillStyle As MenuItemSelectFillStyle)
    FillStyle = nFillStyle
End Property
' 属性: 菜单项过渡色起始颜色(只有当 ItemSelectFillStyle 设置为 ISFS_HORIZONTALCOLOR 或 ISFS_VERTICALCOLOR 时才有效)
'       当 ItemSelectFillStyle 设置为 ISFS_SOLIDCOLOR (实色填充)时以 ItemSelectFillStartColor 颜色为准
Public Property Get ItemSelectFillStartColor() As Long
    ItemSelectFillStartColor = FillStartColor
End Property
Public Property Let ItemSelectFillStartColor(ByVal nFillStartColor As Long)
    FillStartColor = nFillStartColor
End Property
' 属性: 菜单项过渡色终止颜色(只有当 ItemSelectFillStyle 设置为 ISFS_HORIZONTALCOLOR 或 ISFS_VERTICALCOLOR 时才有效)
'       当 ItemSelectFillStyle 设置为 ISFS_SOLIDCOLOR (实色填充)时以 ItemSelectFillStartColor 颜色为准
Public Property Get ItemSelectFillEndColor() As Long
    ItemSelectFillEndColor = FillEndColor
End Property
Public Property Let ItemSelectFillEndColor(ByVal nFillEndColor As Long)
    FillEndColor = nFillEndColor
End Property
' 属性: 菜单背景颜色
Public Property Get BackColor() As Long
    BackColor = BkColor
End Property
Public Property Let BackColor(ByVal nBkColor As Long)
    BkColor = nBkColor
End Property
' 属性: 菜单分隔条风格
Public Property Get SeparatorStyle() As MenuSeparatorStyle
    SeparatorStyle = SepStyle
End Property
Public Property Let SeparatorStyle(ByVal nSepStyle As MenuSeparatorStyle)
    SepStyle = nSepStyle
End Property
' 属性: 菜单分隔条颜色
Public Property Get SeparatorColor() As Long
    SeparatorColor = SepColor
End Property
Public Property Let SeparatorColor(ByVal nSepColor As Long)
    SepColor = nSepColor
End Property

 

' 属性: 菜单总体风格
Public Property Get Style() As MenuUserStyle
    Style = MenuStyle
End Property
Public Property Let Style(ByVal nMenuStyle As MenuUserStyle)
    MenuStyle = nMenuStyle
    Select Case nMenuStyle
        Case STYLE_WINDOWS                       ' Windows 默认风格
            Set BarImage = LoadPicture()
            BarWidth = 20
            BarStyle = LBS_NONE
            BarStartColor = GetSysColor(COLOR_MENU)
            BarEndColor = BarStartColor
            SelectScope = ISS_ICON_TEXT
            TextEnabledColor = GetSysColor(COLOR_MENUTEXT)
            TextDisabledColor = GetSysColor(COLOR_GRAYTEXT)
            TextSelectColor = GetSysColor(COLOR_HIGHLIGHTTEXT)
            IconStyle = IIS_NONE
            EdgeStyle = ISES_SOLID
            EdgeColor = GetSysColor(COLOR_HIGHLIGHT)
            FillStyle = ISFS_SOLIDCOLOR
            FillStartColor = EdgeColor
            FillEndColor = FillStartColor
            BkColor = GetSysColor(COLOR_MENU)
            SepColor = TextDisabledColor
            SepStyle = MSS_DEFAULT
        Case STYLE_XP                         ' XP 风格
            Set BarImage = LoadPicture()
            BarWidth = 20
            BarStyle = LBS_NONE
            BarStartColor = GetSysColor(COLOR_MENU)
            BarEndColor = BarStartColor
            SelectScope = ISS_ICON_TEXT
            TextEnabledColor = GetSysColor(COLOR_MENUTEXT)
            TextDisabledColor = GetSysColor(COLOR_GRAYTEXT)
            TextSelectColor = TextEnabledColor
            IconStyle = IIS_SHADOW
            EdgeStyle = ISES_SOLID
            EdgeColor = RGB(49, 106, 197)
            FillStyle = ISFS_SOLIDCOLOR
            FillStartColor = RGB(180, 195, 210)
            FillEndColor = FillStartColor
            BkColor = GetSysColor(COLOR_MENU)
            SepColor = RGB(192, 192, 192)
            SepStyle = MSS_SOLID
        Case STYLE_SHADE                       ' 渐变风格
            Set BarImage = LoadPicture()
            BarWidth = 20
            BarStyle = LBS_VERTICALCOLOR
            BarStartColor = vbBlack
            BarEndColor = vbWhite
            SelectScope = ISS_ICON_TEXT
            TextEnabledColor = GetSysColor(COLOR_MENUTEXT)
            TextDisabledColor = GetSysColor(COLOR_GRAYTEXT)
            TextSelectColor = GetSysColor(COLOR_HIGHLIGHTTEXT)
            IconStyle = IIS_NONE
            EdgeStyle = ISES_NONE
            EdgeColor = GetSysColor(COLOR_HIGHLIGHT)
            FillStyle = ISFS_HORIZONTALCOLOR
            FillStartColor = vbBlack
            FillEndColor = vbWhite
            BkColor = GetSysColor(COLOR_MENU)
            SepColor = TextDisabledColor
            SepStyle = MSS_DEFAULT
        Case STYLE_3D                   ' 3D 立体风格
            Set BarImage = LoadPicture()
            BarWidth = 20
            BarStyle = LBS_NONE
            BarStartColor = GetSysColor(COLOR_MENU)
            BarEndColor = BarStartColor
            SelectScope = ISS_TEXT
            TextEnabledColor = GetSysColor(COLOR_MENUTEXT)
            TextDisabledColor = GetSysColor(COLOR_GRAYTEXT)
            TextSelectColor = vbBlue
            IconStyle = IIS_RAISED
            EdgeStyle = ISES_SUNKEN
            EdgeColor = GetSysColor(COLOR_HIGHLIGHT)
            FillStyle = ISFS_NONE
            FillStartColor = EdgeColor
            FillEndColor = FillStartColor
            BkColor = GetSysColor(COLOR_MENU)
            SepColor = TextDisabledColor
            SepStyle = MSS_DEFAULT
        Case STYLE_COLORFUL                         ' 炫彩风格
            Set BarImage = frmMenu.Picture
            BarWidth = 20
            BarStyle = LBS_IMAGE
            BarStartColor = GetSysColor(COLOR_MENU)
            BarEndColor = BarStartColor
            SelectScope = ISS_ICON_TEXT
            TextEnabledColor = vbBlue
            TextDisabledColor = RGB(49, 106, 197)
            TextSelectColor = vbRed
            IconStyle = IIS_NONE
            EdgeStyle = ISES_DOT
            EdgeColor = vbBlack
            FillStyle = ISFS_VERTICALCOLOR
            FillStartColor = vbYellow
            FillEndColor = vbGreen
            BkColor = RGB(230, 230, 255)
            SepColor = vbMagenta
            SepStyle = MSS_DASHDOTDOT
    End Select
End Property

     这个类模块中包含了各种属性和方法及关于菜单的一些枚举类型，我想强调的有以下几点：

    1、在CreateMenu方法中用SetWindowLong重新定义了frmMenu的窗口入口函数的地址，MenuWndProc是标准模块中的一个函数，就是处理消息的那个函数。

    2、AddItem这个方法是添加菜单项的，使用一个叫做MyItemInfo的动态数组存储菜单项的内容，在“画”菜单项的时候要用到它。在AddItem方法的最后，将菜单项的fType设置成了MFT_OWNERDRAW，也就是物主绘图，这一步最关键，因为将菜单项设置成了Owner Draw，Windows将不会替我们写字，不会替我们画图标，一切都由我们自己来。

    3、在PopupMenu方法中，调用了API函数中的TrackPopupMenu，看到第6个参数了吗？将处理菜单消息的窗口设置成了frmMenu，而我们又对frmMenu进行了子类处理，一切都在我们的掌握之中。

    4、记得要在Class_Terminate中还原frmMenu的窗口入口函数的地址，并释放和菜单相关的资源。

     好了，类模块已经OK了，大家可能对这个菜单类有了更多的了解，也看到了它的属性和方法。怎么样？还算比较丰富吧。如果觉得不够丰富的话，自己加就好了，呵呵。不过，最核心的部分还不在这里，而是在那个处理消息的函数，也就是MenuWndProc，它将完成复杂地“画”菜单的任务以及处理各种菜单事件。看看右边的滚动条，已经够窄了，下一篇再讨论吧。 :)

源代码下载：点击这里下载(28K, winzip压缩文件)

     现在到了最关键，最精彩，也是最复杂的部分了。我们最关心的就是怎样“画”菜单，怎样处理菜单事件，在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