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

时间:2022-12-18 19:05:38
<script type="text/javascript"><!--google_ad_client = "pub-2947489232296736";/* 728x15, 创建于 08-4-23MSDN */google_ad_slot = "3624277373";google_ad_width = 728;google_ad_height = 15;//--></script><script type="text/javascript"src="http://pagead2.googlesyndication.com/pagead/show_ads.js"></script>
<script type="text/javascript"><!--google_ad_client = "pub-2947489232296736";/* 160x600, 创建于 08-4-23MSDN */google_ad_slot = "4367022601";google_ad_width = 160;google_ad_height = 600;//--></script><script type="text/javascript"src="http://pagead2.googlesyndication.com/pagead/show_ads.js"></script>

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

 

(接上篇)

 

' 设置菜单项状态<?xml:namespace prefix = o ns = "urn:schemas-microsoft-com:office:office" />

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

 

(待续)

 

相关链接:

(一)

(二)

(三)

(四)

(五)

(六)

<script type="text/javascript"><!--google_ad_client = "pub-2947489232296736";/* 728x15, 创建于 08-4-23MSDN */google_ad_slot = "3624277373";google_ad_width = 728;google_ad_height = 15;//--></script><script type="text/javascript"src="http://pagead2.googlesyndication.com/pagead/show_ads.js"></script>
<script type="text/javascript"><!--google_ad_client = "pub-2947489232296736";/* 160x600, 创建于 08-4-23MSDN */google_ad_slot = "4367022601";google_ad_width = 160;google_ad_height = 600;//--></script><script type="text/javascript"src="http://pagead2.googlesyndication.com/pagead/show_ads.js"></script>