cmenu.cls

多功能菜单、弹出菜单设计、个性化菜单

    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