form14.frm

菜单设计VB打造超酷个性化菜单

VERSION 5.00
Object = "{BA15ACB6-8B32-4ABF-AD1E-FA042F275322}#1.0#0"; "VsMenu.ocx"
Begin VB.Form Form15 
   Caption         =   "Form15"
   ClientHeight    =   5100
   ClientLeft      =   60
   ClientTop       =   345
   ClientWidth     =   6180
   LinkTopic       =   "Form15"
   ScaleHeight     =   5100
   ScaleWidth      =   6180
   StartUpPosition =   3  '窗口缺省
   Begin VsMenu.ctxVsMenu ctxVsMenu1 
      Left            =   720
      Top             =   1320
      _ExtentX        =   900
      _ExtentY        =   900
      BmpCount        =   0
      BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851} 
         Name            =   "宋体"
         Size            =   9
         Charset         =   134
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      UserSelectedMenuBackColour=   13040639
      UserSelectedMenuBorderColour=   16711680
      UserTopMenuBackColour=   16761765
      UserTopMenuSelectedColour=   16769990
      UserTopMenuHotColour=   33023
      UserTopMenuHotBorderColour=   16711680
      UserMenuBorderColour=   8388608
      UserCheckBackColour=   8108783
      UserCheckBorderColour=   16711680
      UserGradientOne =   16777215
      UserGradientTwo =   16761765
      UserUseGradient =   -1  'True
      UserSelectedItemForeColour=   16384
      UserSideBarColour=   16711680
   End
   Begin VB.Frame fraStyle 
      BackColor       =   &H8000000B&
      Height          =   4935
      Left            =   2760
      TabIndex        =   5
      Top             =   0
      Width           =   3255
   End
   Begin VB.OptionButton opnStyle 
      Caption         =   "多彩风格"
      Height          =   615
      Index           =   4
      Left            =   360
      TabIndex        =   3
      Top             =   4200
      Width           =   1335
   End
   Begin VB.OptionButton opnStyle 
      Caption         =   "渐变风格"
      Height          =   495
      Index           =   3
      Left            =   240
      TabIndex        =   2
      Top             =   3480
      Width           =   1575
   End
   Begin VB.OptionButton opnStyle 
      Caption         =   "xp风格"
      Height          =   375
      Index           =   2
      Left            =   240
      TabIndex        =   1
      Top             =   2760
      Width           =   1455
   End
   Begin VB.OptionButton opnStyle 
      Caption         =   "window风格"
      Height          =   495
      Index           =   1
      Left            =   240
      TabIndex        =   0
      Top             =   2040
      Width           =   1455
   End
   Begin VB.Label lblHelp 
      Caption         =   $"Form14.frx":0000
      Height          =   375
      Left            =   120
      TabIndex        =   4
      Top             =   600
      Width           =   2175
   End
End
Attribute VB_Name = "Form15"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False

Option Explicit
Private Declare Function GetCursorPos Lib "user32.dll" (lpPoint As POINTAPI) As Long

Private Type POINTAPI
    X As Long
    Y As Long
End Type
'Dim menu As cMenu


 
Private Sub Form_Load()
    ' 初始化菜单并添加菜单项
    Set menu = New cMenu
    menu.CreateMenu
    menu.AddItem "open", LoadPicture("images\open.ico"), "打开", MIT_STRING
    menu.AddItem "save", LoadPicture("images\save.ico"), "保存", MIT_STRING
    menu.AddItem "print", LoadPicture("images\print.ico"), "打印", MIT_STRING
    menu.AddItem "find", LoadPicture("images\find.ico"), "查找", MIT_STRING
    menu.AddItem "sep1", LoadPicture(), "", MIT_SEPARATOR
    menu.AddItem "undo", LoadPicture("images\undo.ico"), "撤消", MIT_STRING
    menu.AddItem "redo", LoadPicture("images\redo.ico"), "重复", MIT_STRING
    menu.AddItem "sep2", LoadPicture(), "", MIT_SEPARATOR
    menu.AddItem "cut", LoadPicture("images\cut.ico"), "剪切", MIT_STRING
    menu.AddItem "copy", LoadPicture("images\copy.ico"), "复制", MIT_STRING
    menu.AddItem "paste", LoadPicture("images\paste.ico"), "粘贴", MIT_STRING
    menu.AddItem "sep3", LoadPicture(), "", MIT_SEPARATOR
    menu.AddItem "check", LoadPicture("images\check.ico"), "一个 CheckBox", MIT_CHECKBOX
    menu.AddItem "exit", LoadPicture("images\exit.ico"), "退出", MIT_STRING
End Sub

Private Sub Form_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
    ' 单击鼠标右建弹出菜单
    If Button = vbRightButton Then
        Dim Pos As POINTAPI
        GetCursorPos Pos
        menu.PopupMenu Pos.X, Pos.Y, POPUP_LEFTALIGN Or POPUP_TOPALIGN
    End If
End Sub

Private Sub Form_Unload(Cancel As Integer)
    ' 释放资源, 卸载窗体
    Set menu = Nothing
    Dim frm As Form
    For Each frm In Forms
        Unload frm
    Next
End Sub

Private Sub opnStyle_Click(Index As Integer)
    ' 设置菜单风格
    Select Case Index
        Case 0                                  ' Windows 标准
            menu.Style = STYLE_WINDOWS
        Case 1                                  ' XP 风格
            menu.Style = STYLE_XP
        Case 2                                  ' 3D 立体风格
            menu.Style = STYLE_3D
        Case 3                                  ' 渐变风格
            menu.Style = STYLE_SHADE
        Case 4                                  ' 多彩风格
            menu.Style = STYLE_COLORFUL
    End Select

End Sub