frmmain.frm

这是一个实际的工程中所用的源程序

VERSION 5.00
Begin VB.MDIForm frmMDI 
   BackColor       =   &H80000000&
   ClientHeight    =   8310
   ClientLeft      =   300
   ClientTop       =   630
   ClientWidth     =   11880
   Icon            =   "frmMain.frx":0000
   LinkTopic       =   "MDIForm1"
   WindowState     =   2  'Maximized
   Begin VB.PictureBox Picture1 
      Align           =   4  'Align Right
      BackColor       =   &H80000001&
      Height          =   8310
      Left            =   7815
      ScaleHeight     =   8250
      ScaleWidth      =   4005
      TabIndex        =   0
      Top             =   0
      Visible         =   0   'False
      Width           =   4065
      Begin 宁波港.AlarmList AlarmList1 
         Height          =   1365
         Left            =   570
         TabIndex        =   1
         Top             =   780
         Width           =   1095
         _ExtentX        =   1931
         _ExtentY        =   2408
      End
   End
   Begin VB.Menu a1 
      Caption         =   "【系统维护】(&System)"
      Begin VB.Menu mnuSysInfo 
         Caption         =   "系统信息(&SysInfo)"
         Begin VB.Menu mnuLog 
            Caption         =   "程序日志(Sys&Log)"
            Index           =   0
         End
         Begin VB.Menu mnuLog 
            Caption         =   "错误日志(&ErrorLog)"
            Index           =   1
         End
         Begin VB.Menu mnuLog 
            Caption         =   "零点记录(&ZeroLog)"
            Index           =   2
            Visible         =   0   'False
         End
      End
      Begin VB.Menu w1 
         Caption         =   "-"
         Visible         =   0   'False
      End
      Begin VB.Menu mnuUsers 
         Caption         =   "用户管理(&Users)"
         Visible         =   0   'False
      End
      Begin VB.Menu h1 
         Caption         =   "-"
      End
      Begin VB.Menu mnuEnd 
         Caption         =   "退出系统(&Close)"
      End
   End
   Begin VB.Menu mnuSetup 
      Caption         =   "【设置...】(S&etup)"
      Visible         =   0   'False
      Begin VB.Menu mnuMima 
         Caption         =   "口令"
         Visible         =   0   'False
      End
      Begin VB.Menu s5 
         Caption         =   "-"
         Visible         =   0   'False
      End
      Begin VB.Menu mnuMimaUpdate 
         Caption         =   "口令修改"
         Visible         =   0   'False
      End
      Begin VB.Menu s6 
         Caption         =   "-"
         Visible         =   0   'False
      End
      Begin VB.Menu mnu串口 
         Caption         =   "通信串口"
         Begin VB.Menu mnuPort 
            Caption         =   "MT2000串口"
            Index           =   0
         End
         Begin VB.Menu mnuPort 
            Caption         =   "XR2000串口"
            Index           =   1
         End
      End
      Begin VB.Menu s1 
         Caption         =   "-"
         Visible         =   0   'False
      End
      Begin VB.Menu mnuHB 
         Caption         =   "换班设置"
         Visible         =   0   'False
      End
      Begin VB.Menu s3 
         Caption         =   "-"
         Visible         =   0   'False
      End
      Begin VB.Menu mnuCompanyName 
         Caption         =   "公司名称"
         Visible         =   0   'False
      End
      Begin VB.Menu s2 
         Caption         =   "-"
         Visible         =   0   'False
      End
      Begin VB.Menu mnu仪表名称 
         Caption         =   "仪表名称"
         Visible         =   0   'False
         Begin VB.Menu mnuTechName 
            Caption         =   "仪表1"
            Index           =   0
         End
      End
      Begin VB.Menu s7 
         Caption         =   "-"
         Visible         =   0   'False
      End
      Begin VB.Menu mnuScd1 
         Caption         =   "到船时间"
         Visible         =   0   'False
         Begin VB.Menu mnuScd 
            Caption         =   "仪表1"
            Index           =   1
         End
         Begin VB.Menu mnuScd 
            Caption         =   "仪表1"
            Index           =   2
         End
         Begin VB.Menu mnuScd 
            Caption         =   "仪表1"
            Index           =   3
         End
         Begin VB.Menu mnuScd 
            Caption         =   "仪表1"
            Index           =   4
         End
      End
      Begin VB.Menu s4 
         Caption         =   "-"
         Visible         =   0   'False
      End
      Begin VB.Menu mnu流量曲线 
         Caption         =   "流量曲线"
         Visible         =   0   'False
         Begin VB.Menu mnu刻度 
            Caption         =   "刻度"
         End
         Begin VB.Menu mnu线宽 
            Caption         =   "线宽"
         End
      End
   End
   Begin VB.Menu mnuReport 
      Caption         =   "【综合查询】(&Report)"
      Begin VB.Menu mnuQuery 
         Caption         =   "上船数据查询"
      End
      Begin VB.Menu q1 
         Caption         =   "-"
      End
      Begin VB.Menu mnuQX 
         Caption         =   "历史曲线(&F)"
         Visible         =   0   'False
      End
      Begin VB.Menu q2 
         Caption         =   "-"
         Visible         =   0   'False
      End
      Begin VB.Menu mnu设备运行状况 
         Caption         =   "设备利用状况"
      End
   End
   Begin VB.Menu mnuTechs 
      Caption         =   "【监控】(&Monitor)"
      Begin VB.Menu mnuTech 
         Caption         =   "仪表"
         Index           =   0
      End
      Begin VB.Menu mnuTech 
         Caption         =   "仪表数据"
         Index           =   1
      End
      Begin VB.Menu mnuTech 
         Caption         =   "仪表面板"
         Index           =   2
      End
      Begin VB.Menu j1 
         Caption         =   "-"
      End
      Begin VB.Menu mnu泊位 
         Caption         =   "2#泊位状态"
         Index           =   0
      End
      Begin VB.Menu mnu泊位 
         Caption         =   "3#泊位状态"
         Index           =   1
      End
   End
   Begin VB.Menu mnuHelps 
      Caption         =   "【帮助】(&Help)"
      Visible         =   0   'False
      Begin VB.Menu mnuHelp 
         Caption         =   "帮助主题(&Topic)"
      End
      Begin VB.Menu mnuLine3 
         Caption         =   "-"
      End
      Begin VB.Menu mnuHelpAbout 
         Caption         =   "关    于(&About)"
      End
   End
End
Attribute VB_Name = "frmMDI"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False

Option Explicit

Private Sub MDIForm_Load()
Dim i As Integer

    Me.Caption = App.Title + "(" + CStr(App_Major) + CStr(App_Minor) + CStr(App_Revision) + ")" + "  使用于 " + App_CompanyName
    '------------参数设置初始化----------------------------
    
    mnuPort(0).Caption = "秤仪表通信（" & COMM_PORT1 & "）"
    mnuPort(1).Caption = "调度室通信（" & COMM_PORT2 & "）"
    
    
   '-------------报警初始化----------------------------

   Set AlarmMarquee = AlarmList1
   
   fQM.Show
   
   Call MainFC
End Sub

Private Sub MDIForm_QueryUnload(Cancel As Integer, UnloadMode As Integer)
'vbFormControlMenu 0 用户从窗体上的“控件”菜单中选择“关闭”指令。
'vbFormCode        1 Unload 语句被代码调用。
'vbAppWindows      2 当前 Microsoft Windows 操作环境会话结束。
'vbAppTaskManager  3 Microsoft Windows 任务管理器正在关闭应用程序。
'vbFormMDIForm     4 MDI 子窗体正在关闭，因为 MDI 窗体正在关闭。
'vbFormOwner       5 因为窗体的所有者正在关闭，所以窗体也在关闭。
            Dim sMsg As String
            Dim i As Integer
            Dim bClose As Boolean
            On Error Resume Next
            
            Select Case UnloadMode
                Case vbAppTaskManager
                    bClose = False
                    MsgBox "不能退出程序!", vbExclamation, App.Title
'               Case vbFormControlMenu
'                Case vbFormCode
                
                Case Else
                        
                    sMsg = "真的要退出本应用程序吗？"
                    If MsgBox(sMsg, vbQuestion + vbYesNoCancel, App.Title) = vbYes Then
                    
'                        If Not ShowMimaOk Then
'                            bClose = False
'                        Else
'                            bClose = True
'                        End If
                            bClose = UserLimit("系统退出")
                    Else
                        bClose = False
                    End If
            End Select
            '===================
            
'    If UnloadMode = vbFormControlMenu Then Cancel = True
    If bClose Then
        '
        On Error GoTo errUnload
        
        For i = Forms.Count - 1 To 0 Step -1
        Debug.Print "Unload Forms:" & Forms(i).Name
            Unload Forms(i)
        Next
        
   '================================================
    End
    Else
        Cancel = True
    End If
Exit Sub
errUnload:
    Debug.Assert False
    Call meErr("程序异常终止:Form_QueryUnload", Err.Description, , False)  ', , PATH_Errlog)
    Err.Clear
    End

End Sub


Private Sub MDIForm_Unload(Cancel As Integer)
    On Error Resume Next
      End '退出本应用程序
End Sub



Private Sub mnuEnd_Click()
    Unload Me
End Sub


Private Sub mnuLog_Click(Index As Integer)
Select Case Index
    Case 0 '系统
        AlarmMarquee.LogSys
    Case 1 '错误
        AlarmMarquee.LogErr
    Case 2 '零点
        AlarmMarquee.LogZero
End Select
End Sub
 

Private Sub mnuTech_Click(Index As Integer)
If UserLimit("仪表设定") Then
    Select Case Index
        Case 0 'XR
            frmTechs.Show , frmMDI
        Case 1 'MT
            frmTechs1.Show , frmMDI
        Case 2
            fQM.ShowInstruments
    End Select
Else
 MsgBox "权限不够!", vbExclamation, "用户权限"
End If

End Sub

Private Sub mnuQuery_Click()
'
frmRuning.Show , Me
'Dim sh#
'
'    On Error Resume Next
'sh = Shell(PATH_Root & "\Exe\班表查询.exe", vbNormalFocus)

End Sub

Private Sub mnuHelp_Click()
   Shell "HH.exe " & PATH_Exe & "\皮带秤计量管理系统.chm", vbNormalFocus
End Sub


Private Sub mnu泊位_Click(Index As Integer)
Select Case Index
   Case 0
      fPG2.Show , frmMDI
   Case 1
      fPG3.Show , frmMDI
End Select
End Sub

Private Sub mnu设备运行状况_Click()
frmQuery.Show , frmMDI
End Sub