mdiqueue.frm

排队分诊管理系统源代码！该代码使用VB6开发环境

    On Error Resume Next
    Dim SureQ As Integer
    SureQ = MsgBox("真的退出该系统吗(Y/N)?", vbYesNo Or vbQuestion, "系统提示")
    If SureQ = vbYes Then
        Cancel = 0
    Else
        Cancel = -1
    End If
End Sub

Private Sub MDIForm_Terminate()
    On Error Resume Next
    Set mdiQueue = Nothing
End Sub

Private Sub MDIForm_Unload(Cancel As Integer)
    On Error Resume Next
    Dim i As Integer
    Dim bolDbClose As Boolean
    
    For i = Forms.Count - 1 To 1 Step -1
        Unload Forms(i)
    Next
    If Me.WindowState <> vbMinimized Then
        SaveSetting App.Title, "Settings", "MainLeft", Me.Left
        SaveSetting App.Title, "Settings", "MainTop", Me.Top
        SaveSetting App.Title, "Settings", "MainWidth", Me.Width
        SaveSetting App.Title, "Settings", "MainHeight", Me.Height
    End If
        
    bolDbClose = CloseDB()
End Sub

Private Sub mnuDateBackup_Click()
    On Error Resume Next
    OpenForm dlgDatabaseBackup, "dlgDatabaseBackup", True
End Sub

Private Sub mnuDateRestore_Click()
    On Error Resume Next
    'OpenForm dlgDatabaseRestore, "dlgDatabaseRestore", True
End Sub

Private Sub mnuFlackSet_Click()
    On Error Resume Next
    OpenForm frmFlackSet, "frmFlackSet"
End Sub

Private Sub mnuHelpAbout_Click()
    On Error Resume Next
    OpenForm frmAbout, "frmAbout", True
End Sub

Private Sub mnuListBizStatus_Click()
    On Error Resume Next
    OpenForm frmBizStatusList, "frmBizStatusList"
End Sub

Private Sub mnuListDptCount_Click()
    On Error Resume Next
    OpenForm frmDptCountList, "frmDptCountList"
End Sub

Private Sub mnuListDptService_Click()
    On Error Resume Next
    OpenForm frmDptStatusList, "frmDptStatusList"
End Sub

Private Sub mnuListEmpService_Click()
    On Error Resume Next
    OpenForm frmEmpDetailList, "frmEmpDetailList"
End Sub

Private Sub mnuListEmpStatus_Click()
    On Error Resume Next
    OpenForm frmEmpStatusList, "frmEmpStatusList"
End Sub

Private Sub mnuPrintSet_Click()
    On Error Resume Next
    cdg1.Flags = cdlPDPrintSetup
    cdg1.ShowPrinter
End Sub

Private Sub mnuQuit_Click()
    On Error Resume Next
    Unload Me
End Sub

Private Sub mnuSeatSet_Click()
    On Error Resume Next
    OpenForm frmSeatSet, "frmSeatSet"
End Sub

Private Sub mnuServerState_Click()
    On Error Resume Next
    'OpenForm frmServerState, "frmServerState"
End Sub

Private Sub mnuServiceSet_Click()
    On Error Resume Next
    OpenForm frmQueueSet, "frmQueueSet"
End Sub

Private Sub mnuStateQueue_Click()
    On Error Resume Next
    OpenForm frmQueueState, "frmQueueState"
End Sub

Private Sub mnuStateSeat_Click()
    On Error Resume Next
    OpenForm frmSeatState, "frmSeatState"
End Sub

'******************************************
' 打开某个 FORM 子窗体
Public Sub OpenForm(ByRef frm As Form, Optional strFormName As String, Optional ByVal iMode As Boolean = False)
    On Error Resume Next
    Dim i As Integer

    Load frm
    If frm Is Nothing Then Exit Sub
    mdiQueue.MousePointer = 11
    If iMode = False Then
        frm.Show
    Else
        frm.Show vbModal
    End If
    frm.SetFocus
    mdiQueue.MousePointer = 0
End Sub

Private Sub mnuSystemSet_Click()
    On Error Resume Next
    OpenForm frmSystemSet, "frmSystemSet"
End Sub

Private Sub mnuUserChange_Click()
    On Error Resume Next
    Unload Me
    modStartup.Main
End Sub

Private Sub mnuUserManager_Click()
    On Error Resume Next
    OpenForm frmUserManager, "frmUserManager", True
End Sub

Private Sub mnuUserPass_Click()
    On Error Resume Next
    Dim dlg As dlgPassword
    
    Set dlg = New dlgPassword
    Load dlg
    dlg.DateBase = "QFUser"
    dlg.DateCode = m_iUser
    dlg.Show vbModal
    Set dlg = Nothing
End Sub

Private Sub mnuUserSet_Click()
    On Error Resume Next
    OpenForm frmUserSet, "frmUserSet"
End Sub

Private Sub mnuWindowArrange_Click()
    On Error Resume Next
    Me.Arrange vbArrangeIcons
End Sub

Private Sub mnuWindowCascade_Click()
    On Error Resume Next
    Me.Arrange vbCascade
End Sub

Private Sub mnuWindowClose_Click()
    On Error Resume Next
    Dim i As Integer
    For i = Forms.Count - 1 To 0 Step -1
        If Forms(i).Caption <> Me.Caption Then Unload Forms(i)
    Next i
End Sub

Private Sub mnuWindowMax_Click()
    On Error Resume Next
    Dim i As Integer
    For i = 0 To Forms.Count - 1
        If Forms(i).Caption <> Me.Caption Then ShowWindow Forms(i).hwnd, 3 'SW_MAXIMIZE
    Next i
End Sub

Private Sub mnuWindowMix_Click()
    On Error Resume Next
    Dim i As Integer
    For i = 0 To Forms.Count - 1
        If Forms(i).Caption <> Me.Caption Then ShowWindow Forms(i).hwnd, 6 'SW_MINIMIZE
    Next i
End Sub

Private Sub mnuWindowRestore_Click()
    On Error Resume Next
    Dim i As Integer
    For i = 0 To Forms.Count - 1
        If Forms(i).Caption <> Me.Caption Then ShowWindow Forms(i).hwnd, 9 'SW_RESTORE
    Next i
End Sub

Private Sub mnuWindowSet_Click()
    On Error Resume Next
    OpenForm frmBarScreen, "frmBarScreen"
End Sub

Private Sub mnuWindowTile_Click()
    On Error Resume Next
    Me.Arrange vbTileHorizontal
End Sub

Private Sub timInfo_Timer()
    On Error Resume Next
    Refresh_Info
End Sub

Private Sub yxVMenu_MenuItemClick(MenuNumber As Long, MenuItem As Long)
    On Error Resume Next
    
    Me.MousePointer = 11
    Select Case MenuNumber
        Case 1
            Select Case MenuItem
                Case 1  ' 客户资料
                    OpenForm frmQueueState, "frmQueueState"
                Case 2  '
                    OpenForm frmSeatState, "frmSeatState"
'                Case 3
'                    OpenForm frmServerState, "frmServerState"
            End Select
        Case 2
            Select Case MenuItem
                Case 1
                    OpenForm frmSeatSet, "frmSeatSet"
                Case 2
                    OpenForm frmBarScreen, "frmBarScreen"
                Case 3
                    OpenForm frmQueueSet, "frmQueueSet"
                Case 4
                    OpenForm frmUserSet, "frmUserSet"
                Case 5
                    OpenForm frmSystemSet, "frmSystemSet"
                Case 6
                    OpenForm frmFlackSet, "frmFlackSet"
            End Select
        Case 3
            Select Case MenuItem
                Case 1
                    OpenForm frmEmpDetailList, "frmEmpDetailList"
                Case 2
                    OpenForm frmEmpStatusList, "frmEmpStatusList"
                Case 3
                    OpenForm frmBizStatusList, "frmBizStatusList"
                Case 4
                    OpenForm frmDptStatusList, "frmDptStatusList"
                Case 5
                    OpenForm frmDptCountList, "frmDptCountList"
            End Select
        Case 4
            Select Case MenuItem
                Case 1
                    OpenForm frmEmpAnaly, "frmEmpAnaly"
                Case 2
                    OpenForm frmCmpAnaly, "frmCmpAnaly"
                Case 3
                    OpenForm frmAngAnaly, "frmAngAnaly"
                Case 4
                    MsgBox "对不起，数据不够，无法进行分析！", vbOKOnly, "系统提示"
                Case 5
                    MsgBox "对不起，数据不够，无法进行分析！", vbOKOnly, "系统提示"
            End Select
    End Select
    Me.MousePointer = 0
End Sub