frmdptcountlist.frm

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

    On Error Resume Next
    Unload Me
End Sub

Private Sub cmdRefresh_Click()
    On Error Resume Next
    
    m_sBeginDate = dtpBegin.Value
    m_sEndDate = dtpEnd.Value
    
    InitListInfo
    
End Sub

Private Sub Form_Load()
    On Error GoTo ERROR_EXIT
    Dim sDate As String
    
    m_iDateLen = 0
    
    sDate = DateAdd("d", -1, Date)
    dtpBegin.MaxDate = DateAdd("m", -1, sDate)
    dtpBegin.Value = DateAdd("m", -1, sDate)
    dtpEnd.MaxDate = sDate
    dtpEnd.Value = sDate
    
    m_sBeginDate = dtpBegin.Value
    m_sEndDate = dtpEnd.Value
        
    InitListInfo
    
    Exit Sub
ERROR_EXIT:
    m_tagErrInfo.strErrDate = Format(Now, "yyyy-mm-dd hh:mm:ss")
    m_tagErrInfo.strErrFile = "frmDptCountList"
    m_tagErrInfo.strErrFunc = "Form_Load"
    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(1).Width = i + 5655
    dtpBegin.Width = i / 2 + 1575
    dtpEnd.Width = i / 2 + 1575
    lblInfo(1).Left = i / 2 + 3000
    dtpEnd.Left = i / 2 + 3960
    
    fra1.Width = i + 8175
    lsvStatus.Width = i + 7935
    
    cmdRefresh.Left = i + 6120
    cmdQuit.Left = i + 7200
    
    '修改高度位置
    fra1.Height = j + 4575
    lsvStatus.Height = j + 4215
    
    cmdPreview.Top = j + 5520
    cmdPrint.Top = j + 5520
    cmdRefresh.Top = j + 5520
    cmdQuit.Top = j + 5520
End Sub

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

Private Sub opt1_Click(Index As Integer)
    On Error Resume Next
    Dim sDate As String
    
    m_iDateLen = Index
    
    sDate = DateAdd("d", -1, Date)
    
    Select Case Index
        Case 0
            dtpBegin.MaxDate = DateAdd("m", -1, sDate)
            dtpBegin.Value = DateAdd("m", -1, dtpEnd.Value)
        Case 1
            dtpBegin.MaxDate = DateAdd("ww", -1, sDate)
            dtpBegin.Value = DateAdd("ww", -1, dtpEnd.Value)
        Case 2
            dtpBegin.MaxDate = sDate
            dtpBegin.Value = DateAdd("d", -1, dtpEnd.Value)
    End Select
    
End Sub

'//////////////////////////////////////////////////////////////////////////////////////
'/显示当前的数据
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, j As Integer, k As Integer
    Dim itmX As ListItem
    Dim sTime1 As String, sTime2 As String, sTime As String, l As Long
    Dim iHour As Long, iMinute As Long, iSecond As Long
    Dim sNum1() As Long, sNum2() As Long
    Dim iNum1() As Integer, iNum2() As Integer
    Dim sName() As String, sCode() As String, sID() As String
    
    lsvStatus.ListItems.Clear
    
    '连接数据库
    cmd.ActiveConnection = dbMyDB
    cmd.CommandType = adCmdText
    
    '查询数据库
    strSQL = "SELECT * FROM VIEW_SET_Computer_Windows ORDER BY server_code"
    cmd.CommandText = strSQL
    rs.CursorLocation = adUseClient
    rs.Open cmd, , adOpenStatic, adLockReadOnly
    If Not rs.EOF And rs.RecordCount > 0 Then
        ReDim sName(rs.RecordCount)
        ReDim sCode(rs.RecordCount)
        ReDim sID(rs.RecordCount)
        
        ReDim iNum1(rs.RecordCount)
        ReDim iNum2(rs.RecordCount)
        ReDim sNum1(rs.RecordCount)
        ReDim sNum2(rs.RecordCount)
                
        rs.MoveFirst
        For i = 1 To rs.RecordCount
            sName(i) = rs!server_name
            sCode(i) = rs!server_code
            sID(i) = rs!server_id
            rs.MoveNext
        Next i
    Else
        ReDim sName(0)
        ReDim sCode(0)
        
        Set rs = Nothing
        Set cmd = Nothing
        
        InitListInfo = True
        
        Exit Function
    End If
    rs.Close
    
    For k = 1 To UBound(sName)
        '查询数据库
        strSQL = "SELECT * FROM VIEW_LIST_Emp_Service WHERE (cq_start_data >= '" & DateValue(m_sBeginDate) & _
                 "' AND cq_start_data <= '" & DateValue(m_sEndDate) & "') AND st_name = '" & sName(k) & "'"
        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!end_state <> 1 And rs!end_state <> 2 Then
                    iNum1(k) = iNum1(k) + 1
                    '总服务时间
                    
                    '最长服务时间
                    If Not IsNull(rs!start_time) Then
                        sTime1 = TimeValue(rs!start_time)
                    End If
                    If Not IsNull(rs!end_time) Then
                        sTime2 = TimeValue(rs!end_time)
                    End If
                    l = DateDiff("s", sTime1, sTime2)
                    sNum1(k) = l + sNum1(k)                 '总服务时间
                    If l > sNum2(k) Then sNum2(k) = l       '最长服务时间
                End If
                If rs!end_state = 1 Then
                    iNum2(k) = iNum2(k) + 1
                End If
                rs.MoveNext
            Next i
        End If
        rs.Close
    Next k
    
    For k = 1 To UBound(sName)
        Set itmX = lsvStatus.ListItems.Add(, , sName(k))
        itmX.SubItems(1) = sCode(k)
        itmX.SubItems(3) = iNum1(k)
        itmX.SubItems(6) = iNum2(k)
        
        '平均服务时间
        If iNum1(k) <> 0 Then
            l = sNum1(k) / iNum1(k)
        Else
            l = 0
        End If
        iHour = l / 3600
        iMinute = (l - iHour * 3600) / 60
        iSecond = l - iHour * 3600 - iMinute * 60
        sTime = TimeSerial(iHour, iMinute, iSecond)
        itmX.SubItems(4) = sTime
        
        '最长等待时间
        l = sNum2(k)
        iHour = l / 3600
        iMinute = (l - iHour * 3600) / 60
        iSecond = l - iHour * 3600 - iMinute * 60
        sTime = TimeSerial(iHour, iMinute, iSecond)
        itmX.SubItems(5) = sTime
    Next k
    
    '取号人数
    For k = 1 To UBound(sName)
        '查询数据库
        strSQL = "SELECT * FROM CustomerQueue WHERE (cq_start_data >= '" & DateValue(m_sBeginDate) & _
                 "' AND cq_start_data <= '" & DateValue(m_sEndDate) & "') AND service_queue = '" & sID(k) & "'"
        cmd.CommandText = strSQL
        rs.CursorLocation = adUseClient
        rs.Open cmd, , adOpenStatic, adLockReadOnly
        If Not rs.EOF And rs.RecordCount > 0 Then
            lsvStatus.ListItems(k).SubItems(2) = rs.RecordCount
        End If
        rs.Close
    Next k
    
    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 = "frmDptStatusList"
    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