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打造超酷个性化菜单(六)




相关文章

相关软件




月光软件源码下载编程文档电脑教程网站优化网址导航网络文学游戏天地生活休闲写作范文安妮宝贝站内搜索
电脑技术编程开发网络专区谈天说地情感世界游戏元素分类游戏热门游戏体育运动手机专区业余爱好影视沙龙
音乐天地数码广场教育园地科学大观古今纵横谈股论金人文艺术医学保健动漫图酷二手专区地方风情各行各业

月光软件站·版权所有