VB打造超酷個(gè)性化菜單（二）


其實(shí)，漂亮的界面都是“畫”出來的，菜單當(dāng)然也不例外。既然是“畫”出來的，就需要有窗體來接收“畫”菜單這個(gè)消息，后面我們會(huì)看到，實(shí)際上不僅僅是“畫”這個(gè)消息，一切關(guān)于這個(gè)菜單的消息都要有一個(gè)窗體來接收。如果你對(duì)消息不太了解，可以看看網(wǎng)上其它一些關(guān)于Windows消息機(jī)制的文章。不了解也沒有關(guān)系，只要會(huì)使用就可以了，后面的文章給出了完整的源代碼，而且文章的最后還給出了源代碼的下載地址。

下面我們來創(chuàng)建接收消息的窗體：打開上次建好的工程，添加一個(gè)窗體，并將其名稱設(shè)置為frmMenu（注意：這一步是必須的）。還記得上篇文章的最后一幅圖嗎？菜單左邊那個(gè)黑底色的附加條，為了方便，將frmMenu的Picture屬性設(shè)置成那幅圖。到此，這個(gè)窗體就算OK了！對(duì)了，就這樣，因?yàn)檫@個(gè)窗體僅僅是為了處理消息和存儲(chǔ)那個(gè)黑底色的風(fēng)格條，我們將會(huì)對(duì)它進(jìn)行子類處理，處理消息的代碼全部都放在了將在下一篇中詳細(xì)介紹的標(biāo)準(zhǔn)模塊中。

接下來添加一個(gè)類模塊，并將其名稱設(shè)置為cMenu，代碼如下：

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

'* 本類模塊是一個(gè)菜單類, 提供了各種樣式的菜單的制作方案

'*

'* 版權(quán): LPP軟件工作室

'* 作者: 盧培培(goodname008)

'* (******* 復(fù)制請(qǐng)保留以上信息 *******)

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



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 ' 菜單總體風(fēng)格

STYLE_WINDOWS

STYLE_XP

STYLE_SHADE

STYLE_3D

STYLE_COLORFUL

End Enum



Public Enum MenuSeparatorStyle ' 菜單分隔條風(fēng)格

MSS_SOLID

MSS_DASH

MSS_DOT

MSS_DASDOT

MSS_DASHDOTDOT

MSS_NONE

MSS_DEFAULT

End Enum



Public Enum MenuItemSelectFillStyle ' 菜單項(xiàng)背景填充風(fēng)格

ISFS_NONE

ISFS_SOLIDCOLOR

ISFS_HORIZONTALCOLOR

ISFS_VERTICALCOLOR

End Enum



Public Enum MenuItemSelectEdgeStyle ' 菜單項(xiàng)邊框風(fēng)格

ISES_SOLID

ISES_DASH

ISES_DOT

ISES_DASDOT

ISES_DASHDOTDOT

ISES_NONE

ISES_SUNKEN

ISES_RAISED

End Enum



Public Enum MenuItemIconStyle ' 菜單項(xiàng)圖標(biāo)風(fēng)格

IIS_NONE

IIS_SUNKEN

IIS_RAISED

IIS_SHADOW

End Enum



Public Enum MenuItemSelectScope ' 菜單項(xiàng)高亮條的范圍

ISS_TEXT = &H1

ISS_ICON_TEXT = &H2

ISS_LEFTBAR_ICON_TEXT = &H4

End Enum



Public Enum MenuLeftBarStyle ' 菜單附加條風(fēng)格

LBS_NONE

LBS_SOLIDCOLOR

LBS_HORIZONTALCOLOR

LBS_VERTICALCOLOR

LBS_IMAGE

End Enum



Public Enum MenuItemType ' 菜單項(xiàng)類型

MIT_STRING = &H0

MIT_CHECKBOX = &H200

MIT_SEPARATOR = &H800

End Enum



Public Enum MenuItemState ' 菜單項(xiàng)狀態(tài)

MIS_ENABLED = &H0

MIS_DISABLED = &H2

MIS_CHECKED = &H8

MIS_UNCHECKED = &H0

End Enum



Public Enum PopupAlign ' 菜單彈出對(duì)齊方式

POPUP_LEFTALIGN = &H0& ' 水平左對(duì)齊

POPUP_CENTERALIGN = &H4& ' 水平居中對(duì)齊

POPUP_RIGHTALIGN = &H8& ' 水平右對(duì)齊

POPUP_TOPALIGN = &H0& ' 垂直上對(duì)齊

POPUP_VCENTERALIGN = &H10& ' 垂直居中對(duì)齊

POPUP_BOTTOMALIGN = &H20& ' 垂直下對(duì)齊

End Enum



' 釋放類

Private Sub Class_Terminate()

SetWindowLong frmMenu.hwnd, GWL_WNDPROC, preMenuWndProc

Erase MyItemInfo

DestroyMenu hMenu

End Sub



' 創(chuàng)建彈出式菜單

Public Sub CreateMenu()

preMenuWndProc = SetWindowLong(frmMenu.hwnd, GWL_WNDPROC, AddressOf MenuWndProc)

hMenu = CreatePopupMenu()

Me.Style = STYLE_WINDOWS

End Sub



' 插入菜單項(xiàng)并保存自定義菜單項(xiàng)數(shù)組, 設(shè)置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

' 插入菜單項(xiàng)

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



' 將菜單項(xiàng)數(shù)據(jù)存入動(dòng)態(tài)數(shù)組

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", "菜單項(xiàng)別名相同."

End If

Next i



With MyItemInfo(ID)

Set .itemIcon = itemIcon

.itemText = itemText

.itemType = itemType

.itemState = itemState

.itemAlias = itemAlias

End With



' 獲得菜單項(xiàng)數(shù)據(jù)

With ItemInfo

.cbSize = LenB(ItemInfo)

.fMask = MIIM_DATA Or MIIM_ID Or MIIM_TYPE

End With

GetMenuItemInfo hMenu, ID, False, ItemInfo



' 設(shè)置菜單項(xiàng)數(shù)據(jù)

With ItemInfo

.fMask = .fMask Or MIIM_TYPE

.fType = MFT_OWNERDRAW

End With

SetMenuItemInfo hMenu, ID, False, ItemInfo



' 菜單項(xiàng)ID累加

ID = ID + 1



End Sub



' 刪除菜單項(xiàng)

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



' 設(shè)置菜單項(xiàng)圖標(biāo)

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



' 獲得菜單項(xiàng)圖標(biāo)

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



' 設(shè)置菜單項(xiàng)文字

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



' 獲得菜單項(xiàng)文字

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



' 設(shè)置菜單項(xiàng)狀態(tài)

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



' 獲得菜單項(xiàng)狀態(tài)

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



' 屬性: 菜單附加條風(fēng)格

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



' 屬性: 菜單附加條圖像(只有當(dāng) LeftBarStyle 設(shè)置為 LBS_IMAGE 時(shí)才有效)

Public Property Get LeftBarImage() As StdPicture

Set LeftBarImage = BarImage

End Property



Public Property Let LeftBarImage(ByVal nBarImage As StdPicture)

Set BarImage = nBarImage

End Property



' 屬性: 菜單附加條過渡色起始顏色(只有當(dāng) LeftBarStyle 設(shè)置為 LBS_HORIZONTALCOLOR 或 LBS_VERTICALCOLOR 時(shí)才有效)

' 當(dāng) LeftBarStyle 設(shè)置為 LBS_SOLIDCOLOR (實(shí)色填充)時(shí)以 LeftBarStartColor 顏色為準(zhǔn)

Public Property Get LeftBarStartColor() As Long

LeftBarStartColor = BarStartColor

End Property



Public Property Let LeftBarStartColor(ByVal nBarStartColor As Long)

BarStartColor = nBarStartColor

End Property



' 屬性: 菜單附加條過渡色終止顏色(只有當(dāng) LeftBarStyle 設(shè)置為 LBS_HORIZONTALCOLOR 或 LBS_VERTICALCOLOR 時(shí)才有效)

' 當(dāng) LeftBarStyle 設(shè)置為 LBS_SOLIDCOLOR (實(shí)色填充)時(shí)以 LeftBarStartColor 顏色為準(zhǔn)

Public Property Get LeftBarEndColor() As Long

LeftBarEndColor = BarEndColor

End Property



Public Property Let LeftBarEndColor(ByVal nBarEndColor As Long)

BarEndColor = nBarEndColor

End Property



' 屬性: 菜單項(xiàng)高亮條的范圍

Public Property Get ItemSelectScope() As MenuItemSelectScope

ItemSelectScope = SelectScope

End Property



Public Property Let ItemSelectScope(ByVal nSelectScope As MenuItemSelectScope)

SelectScope = nSelectScope

End Property



' 屬性: 菜單項(xiàng)可用時(shí)文字顏色

Public Property Get ItemTextEnabledColor() As Long

ItemTextEnabledColor = TextEnabledColor

End Property



Public Property Let ItemTextEnabledColor(ByVal nTextEnabledColor As Long)

TextEnabledColor = nTextEnabledColor

End Property



' 屬性: 菜單項(xiàng)不可用時(shí)文字顏色

Public Property Get ItemTextDisabledColor() As Long

ItemTextDisabledColor = TextDisabledColor

End Property



Public Property Let ItemTextDisabledColor(ByVal nTextDisabledColor As Long)

TextDisabledColor = nTextDisabledColor

End Property



' 屬性: 菜單項(xiàng)選中時(shí)文字顏色

Public Property Get ItemTextSelectColor() As Long

ItemTextSelectColor = TextSelectColor

End Property



Public Property Let ItemTextSelectColor(ByVal nTextSelectColor As Long)

TextSelectColor = nTextSelectColor

End Property



' 屬性: 菜單項(xiàng)圖標(biāo)風(fēng)格

Public Property Get ItemIconStyle() As MenuItemIconStyle

ItemIconStyle = IconStyle

End Property



Public Property Let ItemIconStyle(ByVal nIconStyle As MenuItemIconStyle)

IconStyle = nIconStyle

End Property



' 屬性: 菜單項(xiàng)邊框風(fēng)格

Public Property Get ItemSelectEdgeStyle() As MenuItemSelectEdgeStyle

ItemSelectEdgeStyle = EdgeStyle

End Property



Public Property Let ItemSelectEdgeStyle(ByVal nEdgeStyle As MenuItemSelectEdgeStyle)

EdgeStyle = nEdgeStyle

End Property



' 屬性: 菜單項(xiàng)邊框顏色

Public Property Get ItemSelectEdgeColor() As Long

ItemSelectEdgeColor = EdgeColor

End Property



Public Property Let ItemSelectEdgeColor(ByVal nEdgeColor As Long)

EdgeColor = nEdgeColor

End Property



' 屬性: 菜單項(xiàng)背景填充風(fēng)格

Public Property Get ItemSelectFillStyle() As MenuItemSelectFillStyle

ItemSelectFillStyle = FillStyle

End Property



Public Property Let ItemSelectFillStyle(ByVal nFillStyle As MenuItemSelectFillStyle)

FillStyle = nFillStyle

End Property



' 屬性: 菜單項(xiàng)過渡色起始顏色(只有當(dāng) ItemSelectFillStyle 設(shè)置為 ISFS_HORIZONTALCOLOR 或 ISFS_VERTICALCOLOR 時(shí)才有效)

' 當(dāng) ItemSelectFillStyle 設(shè)置為 ISFS_SOLIDCOLOR (實(shí)色填充)時(shí)以 ItemSelectFillStartColor 顏色為準(zhǔn)

Public Property Get ItemSelectFillStartColor() As Long

ItemSelectFillStartColor = FillStartColor

End Property



Public Property Let ItemSelectFillStartColor(ByVal nFillStartColor As Long)

FillStartColor = nFillStartColor

End Property



' 屬性: 菜單項(xiàng)過渡色終止顏色(只有當(dāng) ItemSelectFillStyle 設(shè)置為 ISFS_HORIZONTALCOLOR 或 ISFS_VERTICALCOLOR 時(shí)才有效)

' 當(dāng) ItemSelectFillStyle 設(shè)置為 ISFS_SOLIDCOLOR (實(shí)色填充)時(shí)以 ItemSelectFillStartColor 顏色為準(zhǔn)

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



' 屬性: 菜單分隔條風(fēng)格

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



' 屬性: 菜單總體風(fēng)格

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 默認(rèn)風(fēng)格

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 風(fēng)格

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 ' 漸變風(fēng)格

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 立體風(fēng)格

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 ' 炫彩風(fēng)格

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



這個(gè)類模塊中包含了各種屬性和方法及關(guān)于菜單的一些枚舉類型，我想強(qiáng)調(diào)的有以下幾點(diǎn)：

1、在CreateMenu方法中用SetWindowLong重新定義了frmMenu的窗口入口函數(shù)的地址，MenuWndProc是標(biāo)準(zhǔn)模塊中的一個(gè)函數(shù)，就是處理消息的那個(gè)函數(shù)。

2、AddItem這個(gè)方法是添加菜單項(xiàng)的，使用一個(gè)叫做MyItemInfo的動(dòng)態(tài)數(shù)組存儲(chǔ)菜單項(xiàng)的內(nèi)容，在“畫”菜單項(xiàng)的時(shí)候要用到它。在AddItem方法的最后，將菜單項(xiàng)的fType設(shè)置成了MFT_OWNERDRAW，也就是物主繪圖，這一步最關(guān)鍵，因?yàn)閷⒉藛雾?xiàng)設(shè)置成了Owner Draw，Windows將不會(huì)替我們寫字，不會(huì)替我們畫圖標(biāo)，一切都由我們自己來。

3、在PopupMenu方法中，調(diào)用了API函數(shù)中的TrackPopupMenu，看到第6個(gè)參數(shù)了嗎？將處理菜單消息的窗口設(shè)置成了frmMenu，而我們又對(duì)frmMenu進(jìn)行了子類處理，一切都在我們的掌握之中。

4、記得要在Class_Terminate中還原frmMenu的窗口入口函數(shù)的地址，并釋放和菜單相關(guān)的資源。



好了，類模塊已經(jīng)OK了，大家可能對(duì)這個(gè)菜單類有了更多的了解，也看到了它的屬性和方法。怎么樣？還算比較豐富吧。如果覺得不夠豐富的話，自己加就好了，呵呵。不過，最核心的部分還不在這里，而是在那個(gè)處理消息的函數(shù)，也就是MenuWndProc，它將完成復(fù)雜地“畫”菜單的任務(wù)以及處理各種菜單事件�？纯从疫叺臐L動(dòng)條，已經(jīng)夠窄了，下一篇再討論吧。 :)


<>