VB语言

本类阅读TOP10

·Visual Basic 安装程序的制作!!
·VB中使用EXCEL输出
·一个简单的MP3播放器
·VB程序实现WindowsXP效果的界面!!
·VB打造超酷个性化菜单(六)
·透明位图
·平铺与拉伸MDI窗口的背景图 ~!~
·对《VB程序实现WindowsXP效果的界面》一文的补遗
·从Windows资源管理器中拖动文件
·VB打造超酷个性化菜单(一)

分类导航
VC语言Delphi
VB语言ASP
PerlJava
Script数据库
其他语言游戏开发
文件格式网站制作
软件工程.NET开发
VB打造超酷个性化菜单(二)

作者:未知 来源:月光软件站 加入时间:2005-2-28 月光软件站

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

(接上篇)   

 

    其实,漂亮的界面都是“画”出来的,菜单当然也不例外。既然是“画”出来的,就需要有窗体来接收“画”菜单这个消息,后面我们会看到,实际上不仅仅是“画”这个消息,一切关于这个菜单的消息都要有一个窗体来接收。如果你对消息不太了解,可以看看网上其它一些关于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

 

(待续)

 

相关链接:

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

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

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

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

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

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




相关文章

相关软件