frmsystemset.frm

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

    
    cmdRefresh.Left = i + 6120
    cmdQuit.Left = i + 7200
    
    '修改高度位置
    cmdChange.Top = j + 5520
    cmdStorage.Top = j + 5520
    cmdRefresh.Top = j + 5520
    cmdQuit.Top = j + 5520
End Sub

Private Sub Form_Terminate()
    On Error Resume Next
    Set frmSystemSet = Nothing
End Sub

Private Sub opt1_Click(Index As Integer)
    On Error Resume Next
    
    If m_iStatus = False Then Exit Sub
    
    If opt1(0).Value = True Then
        dtpStart.Enabled = True
        dtpEnd.Enabled = True
    Else
        dtpStart.Enabled = False
        dtpEnd.Enabled = False
    End If
End Sub

Private Sub opt2_Click(Index As Integer)
    On Error Resume Next
    
    If m_iStatus = False Then Exit Sub
    
    If opt2(0).Value = True Then
        chk2(0).Enabled = True
        cboTime.Enabled = True
    Else
        chk2(0).Enabled = False
        cboTime.Enabled = False
    End If
End Sub

Private Sub opt3_Click(Index As Integer)
    On Error Resume Next
    
    If m_iStatus = False Then Exit Sub
    
    If opt3(0).Value = True Then
        chk3.Enabled = True
        If chk3.Value = Unchecked Then
            cboFlack(0).Enabled = False
        Else
            cboFlack(0).Enabled = True
        End If
    Else
        chk3.Enabled = False
        cboFlack(0).Enabled = False
    End If
End Sub

'///////////////////////////////////////////////////////////////////////////////////////
'/打开所有的选项
Private Sub OpenAllChoice()
    On Error Resume Next
    
    'frame 1
    opt1(0).Enabled = True
    opt1(1).Enabled = True
    If opt1(0).Value = True Then
        dtpStart.Enabled = True
        dtpEnd.Enabled = True
    Else
        dtpStart.Enabled = False
        dtpEnd.Enabled = False
    End If
    
    'frame 2
    chk1.Enabled = True
    If chk1.Value = Unchecked Then
        txtStopInfo.Enabled = False
    Else
        txtStopInfo.Enabled = True
    End If
    
    'frame 3
    txtTime1.Enabled = True
    
    'frame 4
    opt2(0).Enabled = True
    opt2(1).Enabled = True
    If opt2(0).Value = True Then
        chk2(0).Enabled = True
        cboTime.Enabled = True
    Else
        chk2(0).Enabled = False
        cboTime.Enabled = False
    End If
    
    'frame 5
    opt3(0).Enabled = True
    opt3(1).Enabled = True
    If opt3(0).Value = True Then
        chk3.Enabled = True
        If chk3.Value = Unchecked Then
            cboFlack(0).Enabled = False
        Else
            cboFlack(0).Enabled = True
        End If
    Else
        chk3.Enabled = False
        cboFlack(0).Enabled = False
    End If
    
    'frame 6
    chk4.Enabled = True
    If chk4.Value = Unchecked Then
        cboFlack(1).Enabled = False
    Else
        cboFlack(1).Enabled = True
    End If
    
    'frame 7
    txtHead.Enabled = True
    txtFoot.Enabled = True
    
End Sub

'关闭所有的选项
Private Sub CloseAllChoice()
    On Error Resume Next
    Dim bShow As Boolean
    
    'frame 1
    bShow = opt1(0).Value
    opt1(0).Enabled = False
    opt1(0).Value = bShow
    
    bShow = opt1(1).Enabled
    opt1(1).Enabled = False
    opt1(1).Value = bShow
    
    dtpStart.Enabled = False
    dtpEnd.Enabled = False
    
    'frame 2
    chk1.Enabled = False
    txtStopInfo.Enabled = False
    
    'frame 3
    txtTime1.Enabled = False
    
    'frame 4
    bShow = opt2(0).Value
    opt2(0).Enabled = False
    opt2(0).Value = bShow
    
    bShow = opt2(1).Value
    opt2(1).Enabled = False
    opt2(1).Value = bShow
    
    chk2(0).Enabled = False
    cboTime.Enabled = False
    
    'frame 5
    bShow = opt3(0).Value
    opt3(0).Enabled = False
    opt3(0).Value = bShow
    
    bShow = opt3(1).Value
    opt3(1).Enabled = False
    opt3(1).Value = bShow
    
    chk3.Enabled = False
    cboFlack(0).Enabled = False
    
    'frame 6
    chk4.Enabled = False
    cboFlack(1).Enabled = False
    
    'frame 7
    txtHead.Enabled = False
    txtFoot.Enabled = False
    
End Sub

'/////////////////////////////////////////////////////////////////////////////////////////
'/初始化 List 控件信息
Private Function InitListInfo() As Boolean
    On Error GoTo ERROR_EXIT
    Dim rs As New ADODB.Recordset, cmd As New ADODB.Command
    Dim strSQL As String, i As Integer
      
    dtpStart.Value = "08:00:00"
    dtpEnd.Value = "20:00:00"
    
    txtStopInfo.Text = "系统服务暂停"
    txtHead.Text = ""
    txtFoot.Text = ""
    
    cboTime.ListIndex = 0
    cboFlack(0).ListIndex = -1
    cboFlack(1).ListIndex = -1
    
    CloseAllChoice
    
    '连接数据库
    cmd.ActiveConnection = dbMyDB
    cmd.CommandType = adCmdText
    
    '查询数据库
    strSQL = "SELECT * FROM SystemSet"
    cmd.CommandText = strSQL
    rs.CursorLocation = adUseClient
    rs.Open cmd, , adOpenStatic, adLockReadOnly
    If Not rs.EOF And rs.RecordCount > 0 Then
        'frame 1
        If rs!time_set = 0 Then
            opt1(0).Value = True
            dtpStart.Value = TimeValue(rs!start_time)
            dtpEnd.Value = TimeValue(rs!end_time)
        Else
            opt1(0).Value = False
        End If
        'frame 2
        If rs!stop_print = 0 Then
            chk1.Value = Checked
            txtStopInfo.Text = rs!print_demo
        Else
            chk1.Value = Unchecked
        End If
        'frame 3
        txtTime1.Text = rs!system_refresh
        'frame 4
        If rs!sound_set = 0 Then
            opt2(0).Value = True
            If rs!sound_tip = 0 Then
                chk2(0).Value = Checked
            Else
                chk2(0).Value = Unchecked
            End If
            If Not IsNull(rs!sound_time) Then
                cboTime.ListIndex = rs!sound_time - 1
            End If
        Else
            opt2(1).Value = True
            chk2(0).Value = Unchecked
        End If
        'frame 5
        If rs!center_set = 0 Then
            opt3(0).Value = True
            If rs!service_center = 0 Then
                chk3.Value = Checked
                If Not IsNull(rs!center_flack) Then
                    For i = 1 To cboFlack(0).ListCount
                        If cboFlack(0).ItemData(i - 1) = rs!center_flack Then
                            cboFlack(0).ListIndex = i - 1
                            Exit For
                        End If
                    Next i
                End If
            Else
                chk3.Value = Unchecked
            End If
        Else
            opt3(1).Value = True
            chk3.Value = Unchecked
        End If
        'frame 6
        If rs!service_screen = 0 Then
            chk4.Value = Checked
            If Not IsNull(rs!screen_flack) Then
                For i = 1 To cboFlack(1).ListCount
                    If cboFlack(1).ItemData(i - 1) = rs!screen_flack Then
                        cboFlack(1).ListIndex = i - 1
                        Exit For
                    End If
                Next i
            End If
        Else
            chk4.Value = Unchecked
        End If
        'frame 7
        If Not IsNull(rs!print_head) Then txtHead.Text = rs!print_head
        If Not IsNull(rs!print_foot) Then txtFoot.Text = rs!print_foot
        
    Else
        '初始信息
        opt1(1).Value = True
        chk1.Value = Unchecked
        txtTime1.Text = 60
        opt2(1).Value = True
        opt3(1).Value = True
        chk4.Value = Unchecked
    End If
    rs.Close
    
    If rs.State = adStateOpen Then rs.Close
    Set rs = Nothing
    Set cmd = Nothing
    
    InitListInfo = True
    Exit Function
ERROR_EXIT:
    m_tagErrInfo.strErrDate = Format(Now, "yyyy-mm-dd hh:mm:ss")
    m_tagErrInfo.strErrFile = "frmSystemSet"
    m_tagErrInfo.strErrFunc = "InitListInfo"
    m_tagErrInfo.nErrNum = Err.Number
    m_tagErrInfo.strErrDesc = Error(Err.Number)
    If Err.Number <> 0 Then Err.Clear
    modErrorInfo.WriteErrLog m_tagErrInfo
    
    InitListInfo = False
End Function

'检查数据相关性
Private Function CheckData() As Boolean
    On Error Resume Next
    
    If TimeValue(dtpStart.Value) >= TimeValue(dtpEnd.Value) And opt1(0).Value = True Then
        MsgBox "请核对时间管理的设定时间！", vbOKOnly, "系统提示"
        CheckData = False
        Exit Function
    End If
    
    If Not IsNumeric(txtTime1.Text) Then
        MsgBox "请核对系统刷新时间！", vbOKOnly, "系统提示"
        CheckData = False
        Exit Function
    End If
    
    If CInt(txtTime1.Text) < 1 Then
        MsgBox "系统刷新时间不能小于1秒！", vbOKOnly, "系统提示"
        CheckData = False
        Exit Function
    End If
    
    If opt2(0).Value = True And chk2(0).Value = Checked Then
        If Not IsNumeric(cboTime.Text) Then
            MsgBox "请选择正确的播放次数！", vbOKOnly, "系统提示"
            CheckData = False
            Exit Function
        End If
    End If
    
    If opt3(0).Value = True And chk3.Value = Checked And cboFlack(0).ListIndex < 0 Then
        MsgBox "请选择正确的中心屏宣传用语！", vbOKOnly, "系统提示"
        CheckData = False
        Exit Function
    End If
        
    If chk4.Value = Checked And cboFlack(1).ListIndex < 0 Then
        MsgBox "请选择正确的条形屏宣传用语！", vbOKOnly, "系统提示"
        CheckData = False
        Exit Function
    End If
        
    CheckData = True
    
End Function