frmsystemset.frm

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

      Begin VB.CheckBox chk1 
         Caption         =   "打印服务停止信息"
         Height          =   255
         Left            =   360
         TabIndex        =   4
         Top             =   360
         Width           =   2175
      End
      Begin VB.TextBox txtStopInfo 
         Enabled         =   0   'False
         Height          =   270
         Left            =   360
         TabIndex        =   5
         Text            =   "系统服务暂停"
         Top             =   720
         Width           =   3495
      End
   End
   Begin VB.Frame fra1 
      Caption         =   "状态刷新时间"
      BeginProperty Font 
         Name            =   "宋体"
         Size            =   10.5
         Charset         =   134
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   1215
      Index           =   2
      Left            =   240
      TabIndex        =   27
      Top             =   3000
      Width           =   4095
      Begin VB.TextBox txtTime1 
         Height          =   270
         Left            =   2040
         TabIndex        =   6
         Top             =   360
         Width           =   1335
      End
      Begin VB.TextBox txtTime2 
         Enabled         =   0   'False
         Height          =   270
         Left            =   2040
         TabIndex        =   7
         Top             =   720
         Width           =   1335
      End
      Begin VB.Label lblInfo 
         Caption         =   "排队状态刷新时间："
         Height          =   255
         Index           =   2
         Left            =   240
         TabIndex        =   23
         Top             =   375
         Width           =   1695
      End
      Begin VB.Label lblInfo 
         Caption         =   "坐席状态刷新时间："
         Height          =   255
         Index           =   3
         Left            =   240
         TabIndex        =   24
         Top             =   735
         Width           =   1695
      End
      Begin VB.Label lblInfo 
         Caption         =   "秒"
         Height          =   255
         Index           =   4
         Left            =   3480
         TabIndex        =   30
         Top             =   375
         Width           =   255
      End
      Begin VB.Label lblInfo 
         Caption         =   "秒"
         Height          =   255
         Index           =   5
         Left            =   3480
         TabIndex        =   31
         Top             =   735
         Width           =   255
      End
   End
End
Attribute VB_Name = "frmSystemSet"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit

Dim m_tagErrInfo    As TYPE_ERRORINFO
Dim m_iStatus       As Boolean

Private Sub chk1_Click()
    On Error Resume Next
    
    If m_iStatus = False Then Exit Sub
    
    If chk1.Value = Unchecked Then
        txtStopInfo.Enabled = False
    Else
        txtStopInfo.Enabled = True
    End If
End Sub

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

Private Sub chk4_Click()
    On Error Resume Next
    
    If m_iStatus = False Then Exit Sub
    
    If chk4.Value = Unchecked Then
        cboFlack(1).Enabled = False
    Else
        cboFlack(1).Enabled = True
    End If
End Sub

Private Sub cmdChange_Click()
    On Error Resume Next
    m_iStatus = True
    cmdStorage.Enabled = True
    cmdChange.Enabled = False
    OpenAllChoice
End Sub

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

Private Sub cmdRefresh_Click()
    On Error Resume Next
    cmdChange.Enabled = True
    cmdStorage.Enabled = False
    InitListInfo
End Sub

Private Sub cmdStorage_Click()
    On Error GoTo ERROR_EXIT
    Dim rs As New ADODB.Recordset, cmd As New ADODB.Command
    Dim strSQL As String, iTrans As Integer
    
    If CheckData = False Then Exit Sub
    
    '连接数据库
    iTrans = dbMyDB.BeginTrans
    
    cmd.ActiveConnection = dbMyDB
    cmd.CommandType = adCmdText
    
    '更新数据库
    strSQL = "SELECT * FROM SystemSet ORDER BY ss_id"
    cmd.CommandText = strSQL
    rs.CursorLocation = adUseClient
    rs.Open cmd, , adOpenDynamic, adLockOptimistic
    If Not rs.EOF And rs.RecordCount > 0 Then
        rs.MoveFirst
    Else
        rs.AddNew
    End If
    
    'frame 1
    If opt1(0).Value = True Then
        rs!time_set = 0
        rs!start_time = TimeValue(dtpStart.Value)
        rs!end_time = TimeValue(dtpEnd.Value)
    Else
        rs!time_set = 1
        rs!start_time = "08:00:00"
        rs!end_time = "20:00:00"
    End If
    
    'frame 2
    If chk1.Value = Checked Then
        rs!stop_print = 0
        rs!print_demo = txtStopInfo.Text
    Else
        rs!stop_print = 1
        rs!print_demo = Null
    End If
    
    'frame 4
    If opt2(0).Value = True Then
        rs!sound_set = 0
        If chk2(0).Value = Checked Then
            rs!sound_tip = 0
        Else
            rs!sound_tip = 1
        End If
        If cboTime.ListIndex <> -1 Then
            rs!sound_time = CInt(cboTime.Text)
        Else
            rs!sound_time = 1
        End If
    Else
        rs!sound_set = 1
        rs!sound_tip = Null
        rs!sound_time = 1
    End If
    
    'frame 5
    If opt3(0).Value = True Then
        rs!center_set = 0
        If chk3.Value = Checked Then
            rs!service_center = 0
            rs!center_flack = cboFlack(0).ItemData(cboFlack(0).ListIndex)
        Else
            rs!service_center = Null
            rs!center_flack = Null
        End If
    Else
        rs!center_set = 1
        rs!service_center = 1
        rs!center_flack = Null
    End If
    
    'frame 6
    If chk4.Value = Checked Then
        rs!service_screen = 0
        rs!screen_flack = cboFlack(1).ItemData(cboFlack(1).ListIndex)
    Else
        rs!service_screen = 1
        rs!screen_flack = Null
    End If
    
    'frame 3
    If CInt(txtTime1.Text) <= 0 Then
        rs!system_refresh = 60
    Else
        rs!system_refresh = CInt(txtTime1.Text)
    End If
    
    'frame 7
    If Trim$(txtHead.Text) <> "" Then
        rs!print_head = txtHead.Text
    End If
    If Trim$(txtFoot.Text) <> "" Then
        rs!print_foot = txtFoot.Text
    End If
    
    rs.Update
    
    If iTrans > 0 Then
        dbMyDB.CommitTrans
        iTrans = 0
    End If
    
    If rs.State = adStateOpen Then rs.Close
    Set rs = Nothing
    Set cmd = Nothing
    
    m_iStatus = False
    cmdRefresh_Click
    
    Exit Sub
ERROR_EXIT:
    If iTrans > 0 Then dbMyDB.RollbackTrans
    m_tagErrInfo.strErrDate = Format(Now, "yyyy-mm-dd hh:mm:ss")
    m_tagErrInfo.strErrFile = "frmSystemSet"
    m_tagErrInfo.strErrFunc = "cmdStorage_Click"
    m_tagErrInfo.nErrNum = Err.Number
    m_tagErrInfo.strErrDesc = Error(Err.Number)
    If Err.Number <> 0 Then Err.Clear
    modErrorInfo.WriteErrLog m_tagErrInfo
End Sub

Private Sub Form_Load()
    On Error GoTo ERROR_EXIT
    Dim rs As New ADODB.Recordset, cmd As New ADODB.Command
    Dim strSQL As String, i As Integer, j As Integer, k As Integer
    
    m_iStatus = False
    
    cmdChange.Enabled = True
    cmdStorage.Enabled = False
    
    cboFlack(0).Clear
    cboFlack(1).Clear
    
    j = 0
    k = 0
    
    '连接数据库
    cmd.ActiveConnection = dbMyDB
    cmd.CommandType = adCmdText
    
    '查询数据库
    strSQL = "SELECT * FROM FlackDateSet"
    cmd.CommandText = strSQL
    rs.CursorLocation = adUseClient
    rs.Open cmd, , adOpenStatic, adLockReadOnly
    If Not rs.EOF And rs.RecordCount > 0 Then
        rs.MoveFirst
        For i = 1 To rs.RecordCount
            If rs!fd_type = 1 Then
                cboFlack(0).AddItem rs!fd_name
                cboFlack(0).ItemData(j) = rs!fd_id
                j = j + 1
            Else
                cboFlack(1).AddItem rs!fd_name
                cboFlack(1).ItemData(k) = rs!fd_id
                k = k + 1
            End If
            rs.MoveNext
        Next i
    End If
    rs.Close
    
    
    If rs.State = adStateOpen Then rs.Close
    Set rs = Nothing
    Set cmd = Nothing
    
    InitListInfo
    
    Exit Sub
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
End Sub

Private Sub Form_Resize()
    On Error Resume Next
    Dim i As Integer, j As Integer

    If Me.WindowState = 1 Then Exit Sub
    
    If Me.Width < 8535 Then Me.Width = 8535
    If Me.Height < 6420 Then Me.Height = 6420
    
    i = Me.Width - 8535
    j = Me.Height - 6420

    '修改宽度
    fra2.Width = i + 3375
    fra3(0).Width = i + 3375
    fra3(1).Width = i + 3375
    
    cboTime.Width = i + 1695
    cboFlack(0).Width = i + 2535
    cboFlack(1).Width = i + 2775