📄 frmmain.frm
字号:
VERSION 5.00
Begin VB.Form frmMain
Caption = "菜单例子"
ClientHeight = 4380
ClientLeft = 60
ClientTop = 345
ClientWidth = 6150
LinkTopic = "Form1"
ScaleHeight = 4380
ScaleWidth = 6150
StartUpPosition = 3 'Windows Default
Begin VB.Frame fraStyle
Caption = "菜单风格"
Height = 2295
Left = 960
TabIndex = 13
Top = 480
Width = 1935
Begin VB.OptionButton opnStyle
Caption = "多彩风格"
Height = 180
Index = 4
Left = 240
TabIndex = 18
Top = 1800
Width = 1215
End
Begin VB.OptionButton opnStyle
Caption = "渐变风格"
Height = 180
Index = 3
Left = 240
TabIndex = 17
Top = 1440
Width = 1095
End
Begin VB.OptionButton opnStyle
Caption = "3D 立体风格"
Height = 180
Index = 2
Left = 240
TabIndex = 16
Top = 1080
Width = 1335
End
Begin VB.OptionButton opnStyle
Caption = "XP 风格"
Height = 180
Index = 1
Left = 240
TabIndex = 15
Top = 720
Width = 1455
End
Begin VB.OptionButton opnStyle
Caption = "Windows 标准"
Height = 180
Index = 0
Left = 240
TabIndex = 14
Top = 360
Width = 1575
End
End
Begin VB.Label lblHelp
AutoSize = -1 'True
BackStyle = 0 'Transparent
Caption = "在窗体空白处单击鼠标右键"
Height = 180
Left = 840
TabIndex = 19
Top = 3480
Width = 2160
End
Begin VB.Label lblIconExit
AutoSize = -1 'True
Caption = "exit"
Height = 180
Left = 120
MouseIcon = "frmMain.frx":0000
TabIndex = 12
Top = 2760
Visible = 0 'False
Width = 360
End
Begin VB.Label lblIconCheck
AutoSize = -1 'True
Caption = "check"
Height = 180
Left = 120
MouseIcon = "frmMain.frx":014A
TabIndex = 11
Top = 3000
Visible = 0 'False
Width = 450
End
Begin VB.Label lblIconDelete
AutoSize = -1 'True
Caption = "delete"
Height = 180
Left = 120
MouseIcon = "frmMain.frx":0294
TabIndex = 10
Top = 1800
Visible = 0 'False
Width = 540
End
Begin VB.Label lblIconHelp
AutoSize = -1 'True
Caption = "help"
Height = 180
Left = 120
MouseIcon = "frmMain.frx":081E
TabIndex = 9
Top = 2520
Visible = 0 'False
Width = 360
End
Begin VB.Label lblIconRedo
AutoSize = -1 'True
Caption = "redo"
Height = 180
Left = 120
MouseIcon = "frmMain.frx":0DA8
TabIndex = 8
Top = 2040
Visible = 0 'False
Width = 360
End
Begin VB.Label lblIconUndo
AutoSize = -1 'True
Caption = "undo"
Height = 180
Left = 120
MouseIcon = "frmMain.frx":1332
TabIndex = 7
Top = 2280
Visible = 0 'False
Width = 360
End
Begin VB.Label lblIconFind
AutoSize = -1 'True
Caption = "find"
Height = 180
Left = 120
MouseIcon = "frmMain.frx":18BC
TabIndex = 6
Top = 1560
Visible = 0 'False
Width = 360
End
Begin VB.Label lblIconPrint
AutoSize = -1 'True
Caption = "print"
Height = 180
Left = 120
MouseIcon = "frmMain.frx":1E46
TabIndex = 5
Top = 1320
Visible = 0 'False
Width = 450
End
Begin VB.Label lblIconPaste
AutoSize = -1 'True
Caption = "paste"
Height = 180
Left = 120
MouseIcon = "frmMain.frx":23D0
TabIndex = 4
Top = 1080
Visible = 0 'False
Width = 450
End
Begin VB.Label lblIconCopy
AutoSize = -1 'True
Caption = "copy"
Height = 180
Left = 120
MouseIcon = "frmMain.frx":295A
TabIndex = 3
Top = 840
Visible = 0 'False
Width = 360
End
Begin VB.Label lblIconCut
AutoSize = -1 'True
Caption = "cut"
Height = 180
Left = 120
MouseIcon = "frmMain.frx":2EE4
TabIndex = 2
Top = 600
Visible = 0 'False
Width = 270
End
Begin VB.Label lblIconSave
AutoSize = -1 'True
Caption = "save"
Height = 180
Left = 120
MouseIcon = "frmMain.frx":346E
TabIndex = 1
Top = 360
Visible = 0 'False
Width = 360
End
Begin VB.Label lblIconOpen
AutoSize = -1 'True
Caption = "open"
Height = 180
Left = 120
MouseIcon = "frmMain.frx":39F8
TabIndex = 0
Top = 120
Visible = 0 'False
Width = 360
End
End
Attribute VB_Name = "frmMain"
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", lblIconOpen.MouseIcon, "打开", MIT_STRING
menu.AddItem "save", lblIconSave.MouseIcon, "保存", MIT_STRING
menu.AddItem "print", lblIconPrint.MouseIcon, "打印", MIT_STRING
menu.AddItem "find", lblIconFind.MouseIcon, "查找", MIT_STRING
menu.AddItem "sep1", LoadPicture(), "", MIT_SEPARATOR
menu.AddItem "undo", lblIconUndo.MouseIcon, "撤消", MIT_STRING
menu.AddItem "redo", lblIconRedo.MouseIcon, "重复", MIT_STRING
menu.AddItem "sep2", LoadPicture(), "", MIT_SEPARATOR
menu.AddItem "cut", lblIconCut.MouseIcon, "剪切", MIT_STRING
menu.AddItem "copy", lblIconCopy.MouseIcon, "复制", MIT_STRING
menu.AddItem "paste", lblIconPaste.MouseIcon, "粘贴", MIT_STRING
menu.AddItem "sep3", LoadPicture(), "", MIT_SEPARATOR
menu.AddItem "check", lblIconCheck.MouseIcon, "一个 CheckBox", MIT_CHECKBOX
menu.AddItem "exit", lblIconExit.MouseIcon, "退出", 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
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -