test.frm

星级酒店管理系统（附带系统自写控件源码）

VERSION 5.00
Object = "{3B7C8863-D78F-101B-B9B5-04021C009402}#1.2#0"; "RICHTX32.OCX"
Object = "{4365BF57-65C2-11D5-B5C3-0050BAA9AC14}#1.0#0"; "VERTMENU.OCX"
Begin VB.Form Form1 
   Caption         =   "OutLook 垂直菜单演示"
   ClientHeight    =   6615
   ClientLeft      =   1800
   ClientTop       =   2595
   ClientWidth     =   10575
   Icon            =   "Test.frx":0000
   LinkTopic       =   "Form1"
   ScaleHeight     =   441
   ScaleMode       =   3  'Pixel
   ScaleWidth      =   705
   Begin OutLookMenu.VerticalMenu VerticalMenu1 
      Height          =   6195
      Left            =   150
      TabIndex        =   1
      Top             =   210
      Width           =   1905
      _ExtentX        =   3360
      _ExtentY        =   10927
      MenusMax        =   3
      MenuCur         =   3
      MenuCaption1    =   "菜单一"
      MenuItemsMax1   =   3
      MenuItemIcon11  =   "Test.frx":030A
      MenuItemIcon12  =   "Test.frx":0624
      MenuItemCaption12=   "Item2"
      MenuItemIcon13  =   "Test.frx":093E
      MenuItemCaption13=   "Item3"
      MenuCaption2    =   "菜单二"
      MenuItemsMax2   =   4
      MenuItemIcon21  =   "Test.frx":0C58
      MenuItemIcon22  =   "Test.frx":0F72
      MenuItemCaption22=   "Item2"
      MenuItemIcon23  =   "Test.frx":128C
      MenuItemCaption23=   "Item3"
      MenuItemIcon24  =   "Test.frx":15A6
      MenuItemCaption24=   "Item4"
      MenuCaption3    =   "Menu3"
      MenuItemIcon31  =   "Test.frx":18C0
   End
   Begin RichTextLib.RichTextBox RichTextBox1 
      Height          =   6225
      Left            =   2070
      TabIndex        =   0
      Top             =   180
      Width           =   8385
      _ExtentX        =   14790
      _ExtentY        =   10980
      _Version        =   393217
      Enabled         =   -1  'True
      ScrollBars      =   3
      DisableNoScroll =   -1  'True
      TextRTF         =   $"Test.frx":1BDA
   End
End
Attribute VB_Name = "Form1"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False

Option Explicit

Private Sub Form_Load()

End Sub

Private Sub VerticalMenu1_MenuItemClick(MenuNumber As Long, MenuItem As Long)
    
    Dim Path As String
    
    On Error Resume Next
    Path = App.Path & "\"
    Select Case MenuNumber
        Case 1
            Select Case MenuItem
                Case 1
                    RichTextBox1.FileName = Path & "Q100190.rtf"
                Case 2
                    RichTextBox1.FileName = Path & "Q100367.rtf"
                Case 3
                    RichTextBox1.FileName = Path & "Q101257.rtf"
                Case 4
                    RichTextBox1.FileName = Path & "Q113281.rtf"
                Case 5
                    RichTextBox1.FileName = Path & "Q74517.rtf"
                Case 6
                    RichTextBox1.FileName = Path & "Q84475.rtf"
                Case 7
                    RichTextBox1.FileName = Path & "Q93436.rtf"
            End Select
        Case 2
            Select Case MenuItem
                Case 1
                    RichTextBox1.FileName = Path & "Q79094.rtf"
                Case 2
                    RichTextBox1.FileName = Path & "Q79599.rtf"
                Case 3
                    RichTextBox1.FileName = Path & "Q82157.rtf"
                Case 4
                    RichTextBox1.FileName = Path & "Q80645.rtf"
                Case 5
                    RichTextBox1.FileName = Path & "Q84483.rtf"
            End Select
        Case 3
            Select Case MenuItem
                Case 1
                    RichTextBox1.FileName = Path & "Q100193.rtf"
                Case 2
                    RichTextBox1.FileName = Path & "Q115779.rtf"
                Case 3
                    RichTextBox1.FileName = Path & "Q139567.rtf"
                Case 4
                    RichTextBox1.FileName = Path & "Q145618.rtf"
                Case 5
                    RichTextBox1.FileName = Path & "Q76520.rtf"
                Case 6
                    RichTextBox1.FileName = Path & "Q77393.rtf"
            End Select
        Case 4
            Select Case MenuItem
                Case 1
                    Shell "calc.exe", vbNormalFocus
                Case 2
                    Shell "clock.exe", vbNormalFocus
                Case 3
                    Shell "notepad.exe", vbNormalFocus
                Case 4
                    Shell "mspaint.exe", vbNormalFocus
            End Select
    End Select
End Sub