快捷搜索:

VB打造超酷个性化菜单(2)

着实,漂亮的界面都是“画”出来的,菜单当然也不例外。既然是“画”出来的,就必要有窗体来接管“画”菜单这个消息,后面我们会看到,实际上不仅仅是“画”这个消息,统统关于这个菜单的消息都要有一个窗体来接管。假如你对消息不太懂得,可以看看网上其它一些关于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,它将完成繁杂地“画”菜单的义务以及处置惩罚各类菜单事故。看看右边的滚动条,已经够窄了,下一篇再评论争论吧。 :)

您可能还会对下面的文章感兴趣: