|
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)夠窄了，下一篇再討論吧。 :)
<>
|
