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

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

其实，漂亮的界面都是“画”出来的，菜单当然也不例外。既然是“画”出来的，就需要有窗体来接收“画”菜单这个消息，后面我们会看到，实际上不仅仅是“画”这个消息，一切关于这个菜单的消息都要有一个窗体来接收。如果你对消息不太了解，可以看看网上其它一些关于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，它将完成复杂地“画”菜单的任务以及处理各种菜单事件。看看右边的滚动条，已经够窄了，下一篇再讨论吧。 :)

（待续）

• ·Tracker 服务器源码分析之三：HTTPH
• ·Tracker 服务器源码分析之二：RawSe
• ·Tracker 服务器源码分析之一：总述
• ·HEC虚拟机的一些改进建议
• ·VB打造超酷个性化菜单（三）
• ·VB打造超酷个性化菜单（一）
• ·创建SvcHost.exe调用的服务原理与实践
• ·用API修改注册表的完整模块
• ·创建网站的 RSS 内容摘要
• ·软件保护之杀死Crack相关进程