frmuserset.frm

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

                Exit Sub
            End If
            iTrans = dbMyDB.BeginTrans
    
            dbMyDB.Execute "DELETE FROM Department WHERE dp_id = '" & m_iTreeChoice & "'"
            
            If iTrans > 0 Then
                dbMyDB.CommitTrans
                iTrans = 0
            End If
        Else
            If MsgBox("是否删除选择的员工信息(Y/N)?", vbYesNo Or vbQuestion, "系统提示") = vbNo Then
                Exit Sub
            End If
            iTrans = dbMyDB.BeginTrans
    
            dbMyDB.Execute "DELETE FROM Employee WHERE ep_id = '" & m_iTreeChoice & "'"
            
            If iTrans > 0 Then
                dbMyDB.CommitTrans
                iTrans = 0
            End If
        End If
    End If
    
    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 = "frmUserSet"
    m_tagErrInfo.strErrFunc = "cmdDelete_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 cmdPass_Click()
    On Error Resume Next
    Dim dlg As dlgPassword
    
    Set dlg = New dlgPassword
    Load dlg
    dlg.DateBase = "Employee"
    dlg.DateCode = m_iTreeChoice
    dlg.Show vbModal
    Set dlg = Nothing
    cmdRefresh_Click
End Sub

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

Private Sub cmdRefresh_Click()
    On Error Resume Next
    m_bTreeChoice = False
    m_iTreeChoice = 0
    m_bTreeDepart = False
    
    cmdChange.Enabled = False
    cmdDelete.Enabled = False
    cmdPass.Enabled = False
    InitListInfo
End Sub

Private Sub Form_Load()
    On Error Resume Next
    m_bTreeChoice = False
    m_iTreeChoice = 0
    m_bTreeDepart = False
    
    cmdChange.Enabled = False
    cmdDelete.Enabled = False
    cmdPass.Enabled = False
    InitListInfo
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

    '修改宽度
    fra1.Width = i + 5655
    lsvUser.Width = i + 5415
    cmdRefresh.Left = i + 6120
    cmdQuit.Left = i + 7200
    
    '修改高度位置
    fra1.Height = j + 5295
    lsvUser.Height = j + 4935
    fra2.Height = j + 5295
    trvUser.Height = j + 4935
    
    cmdAddNew.Top = j + 5520
    cmdChange.Top = j + 5520
    cmdDelete.Top = j + 5520
    cmdPass.Top = j + 5520
    cmdRefresh.Top = j + 5520
    cmdQuit.Top = j + 5520
End Sub

Private Sub trvUser_NodeClick(ByVal Node As MSComctlLib.Node)
    On Error Resume Next
    Dim sCode() As String
    
    sCode = Split(Node.Key, vbTab)
    lsvUser.ListItems.Clear
    
    Select Case sCode(1)
        Case "0"
            '点击的为窗口的根
            m_bTreeChoice = False
            m_iTreeChoice = 0
            m_bTreeDepart = False
            
            cmdChange.Enabled = False
            cmdDelete.Enabled = False
            cmdPass.Enabled = False
            
            '显示对应的数据
            InitListUser 0
        Case "1"
            m_bTreeChoice = True
            m_iTreeChoice = CInt(sCode(0))
            m_bTreeDepart = True
            
            cmdChange.Enabled = True
            cmdDelete.Enabled = True
            cmdPass.Enabled = False
            
            '显示对应的数据
            InitListUser 1
        Case "2"
            m_bTreeChoice = True
            m_iTreeChoice = CInt(sCode(0))
            m_bTreeDepart = False
            
            cmdChange.Enabled = True
            cmdDelete.Enabled = True
            cmdPass.Enabled = True
    End Select
    
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
    Dim sDate As String
    Dim ndObject As Node
    
    trvUser.Nodes.Clear
    Set ndObject = trvUser.Nodes.Add(, , "ROOT" & vbTab & "0", "营业大厅")
    ndObject.Image = 2
    
    '连接数据库
    cmd.ActiveConnection = dbMyDB
    cmd.CommandType = adCmdText
    
    '查询数据库
    strSQL = "SELECT * FROM Department WHERE father_id = 0 AND shap_index = 0 AND nouse_yesno = 0"
    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
            Set ndObject = trvUser.Nodes.Add("ROOT" & vbTab & "0", tvwChild, CStr(rs!dp_id) & vbTab & "1", rs!dp_name)
            ndObject.Image = 2
            rs.MoveNext
        Next i
    End If
    rs.Close
    
    strSQL = "SELECT * FROM Employee WHERE nouse_yesno = 0"
    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 Not IsNull(rs!department_id) And rs!department_id > 0 Then
                sDate = CStr(rs!department_id) & vbTab & "1"
            Else
                sDate = "ROOT" & vbTab & "0"
            End If
            Set ndObject = trvUser.Nodes.Add(sDate, tvwChild, rs!ep_id & vbTab & "2", rs!name_c)
            ndObject.Image = 1
            rs.MoveNext
        Next i
    End If
    rs.Close
        
    For i = 1 To trvUser.Nodes.Count
        trvUser.Nodes(i).Expanded = True
    Next i
    
    InitListUser 0
    
    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 = "frmUserSet"
    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 InitListUser(Optional ByVal iMode As Integer = 0) 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
    Dim itmX As ListItem
    
    lsvUser.ListItems.Clear
    
    '连接数据库
    cmd.ActiveConnection = dbMyDB
    cmd.CommandType = adCmdText
    
    '查询数据库
    If iMode = 0 Then
        strSQL = "SELECT * FROM Employee WHERE nouse_yesno = 0"
    Else
        strSQL = "SELECT * FROM Employee WHERE nouse_yesno = 0 AND department_id = '" & m_iTreeChoice & "'"
    End If
    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
            Set itmX = lsvUser.ListItems.Add(, , CStr(i))
            itmX.SubItems(1) = rs!ep_code
            itmX.SubItems(2) = rs!name_c
            If Not IsNull(rs!ep_title) Then itmX.SubItems(3) = rs!ep_title
            If Not IsNull(rs!note) Then itmX.SubItems(4) = rs!note
            rs.MoveNext
        Next i
    End If
    rs.Close
    
    InitListUser = True
    Exit Function
ERROR_EXIT:
    m_tagErrInfo.strErrDate = Format(Now, "yyyy-mm-dd hh:mm:ss")
    m_tagErrInfo.strErrFile = "frmUserSet"
    m_tagErrInfo.strErrFunc = "InitListUser"
    m_tagErrInfo.nErrNum = Err.Number
    m_tagErrInfo.strErrDesc = Error(Err.Number)
    If Err.Number <> 0 Then Err.Clear
    modErrorInfo.WriteErrLog m_tagErrInfo
    
    InitListUser = False
End Function