frmuserview.frm

用VB开发的巡检系统基于MAPINFo用VB开发的巡检系统基于MAPINFo很好的

                If MsgBox("此用户已经绑定GPS终端，是否真的要删除所有关联的资料？", vbInformation + vbYesNo, "提示") = vbNo Then
                    rs.Close
                    Exit Sub
                End If
                strDelete = "delete from tbl_User where UserID='" & curUserID & "'"
                gblCn.Execute strDelete
            Else
                strDelete = "delete from tbl_User where UserID='" & curUserID & "'"
                gblCn.Execute strDelete
            End If
            rs.Close
        End If
    Next
    '重新刷新数据
    InitTreeView
    LoadListItemData "ALL"
End Sub

Private Sub Command3_Click()
    frmPeople.txtField(0).Enabled = False
    frmPeople.blIsEdit = True
    If Me.ListView1.ListItems.Count = 0 Then Exit Sub
    With frmPeople
        .txtField(0).Text = Me.ListView1.SelectedItem.SubItems(1)
        .txtField(1).Text = Me.ListView1.SelectedItem.SubItems(2)
        If Me.ListView1.SelectedItem.SubItems(3) = "男" Then
            .Option1(0).Value = True
        Else
            .Option1(1).Value = True
        End If
        .txtField(2).Text = Me.ListView1.SelectedItem.SubItems(4)
        .txtField(3).Text = Me.ListView1.SelectedItem.SubItems(5)
        .Combo1.Text = Me.ListView1.SelectedItem.SubItems(6)
        .txtField(4).Text = Me.ListView1.SelectedItem.SubItems(7)
        .txtField(5).Text = Me.ListView1.SelectedItem.SubItems(8)
    End With
    frmPeople.Show
End Sub

Private Sub Command4_Click()
    If Not CheckDepartment Then Exit Sub
    frmPeople.txtField(0).Enabled = True
    frmPeople.blIsEdit = False
    frmPeople.Show
End Sub

Function CheckDepartment() As Boolean
'检查是否存在部门名称
    Set rs = Nothing
    rs.Open "select * from tbl_Department", gblCn, adOpenKeyset, adLockOptimistic, adCmdText
    If rs.RecordCount = 0 Then
        MsgBox "请先确定存在部门后再进行人员资料的添加！", vbInformation, "提示"
        CheckDepartment = False
    Else
        CheckDepartment = True
    End If
    rs.Close
End Function

Private Sub Form_Load()
    Label3.Caption = "说明：双击记录可以查看详细资料。" & vbCrLf & "删除操作需要在列表前记录打上钩号，然后再进行删除。"
    InitListViewHeader
    InitTreeView
    LoadListItemData "ALL"
End Sub

Private Sub Form_Resize()
    With Me
        .Picture1.Width = .ScaleWidth
        .lblLineTop.Width = .ScaleWidth
        .lblLineBottom.Width = .ScaleWidth
        .lblLineBottom.Top = .ScaleHeight - .StatusBar1.Height - 700
    End With
    
    TreeView1.Top = 1230
    ListView1.Top = 1230
    ListView1.Left = 2610
    
    Me.Command1.Top = Me.ScaleHeight - Me.StatusBar1.Height - 500
    Me.Command1.Left = Me.ScaleWidth - Me.Command1.Width - 500
    
    Me.Command2.Top = Me.Command1.Top
    Me.Command2.Left = Me.Command1.Left - Me.Command2.Width - 100
    
    Me.Command3.Top = Me.Command1.Top
    Me.Command3.Left = Me.Command2.Left - Me.Command3.Width - 100
    
    Me.Command4.Top = Me.Command1.Top
    Me.Command4.Left = Me.Command3.Left - Me.Command4.Width - 100
    
    Me.TreeView1.Height = Me.lblLineBottom.Top - Me.lblLineTop.Top - 100
    Me.ListView1.Height = Me.TreeView1.Height

    ListView1.Width = Me.ScaleWidth - ListView1.Left - 50
    
    Label3.Top = Me.Command1.Top
End Sub

Sub InitListViewHeader()
    With Me.ListView1
        .ColumnHeaders.Add , , "序号", 800
        .ColumnHeaders.Add , , "使用者编号", 1500, 2
        .ColumnHeaders.Add , , "姓名", 1200, 2
        .ColumnHeaders.Add , , "性别", 600, 2
        .ColumnHeaders.Add , , "年龄", 600, 2
        .ColumnHeaders.Add , , "工龄", 600, 2
        .ColumnHeaders.Add , , "部门", 2500, 2
        .ColumnHeaders.Add , , "职务", 1500, 2
        .ColumnHeaders.Add , , "备注", 3000, 2
    End With
    
End Sub

'刷新部门
Public Sub InitTreeView()
    Dim nodeX As Node
    Dim strSql As String
    'On Error Resume Next
    TreeView1.Nodes.Clear
    TreeView1.ImageList = ImageList1
    TreeView1.Nodes.Add , , "ROOT", "部门列表", 1
    TreeView1.Nodes.Add "ROOT", tvwChild, CStr("N_ALL"), "全部人员", 2
    strSql = "select * from tbl_Department order by ID asc"
    Set rs = Nothing
    rs.Open strSql, gblCn, adOpenForwardOnly, adLockOptimistic, adCmdText
    Do Until rs.EOF
        TreeView1.Nodes.Add "ROOT", tvwChild, CStr("N_" & rs("ID")), rs("Department"), 2
        rs.MoveNext
    Loop
    rs.Close
    TreeView1.Nodes(1).Expanded = True
End Sub

'刷新人员
Public Sub LoadListItemData(ByVal flag As String)
    Dim strSql As String
    Dim lstItem As ListItem
    Dim ItemCount As Integer
    With Me
        .ListView1.ListItems.Clear
        Set rs = Nothing
        Select Case flag
            Case "ALL"
                strSql = "select * from tbl_User order by UserID asc"
            Case Else
                strSql = "select * from tbl_User where department='" & flag & "' order by UserID asc"
        End Select
        
        rs.Open strSql, gblCn, adOpenForwardOnly, adLockOptimistic, adCmdText
        Do Until rs.EOF
            ItemCount = ItemCount + 1
            .ListView1.ListItems.Add , "T_" & CStr(ItemCount), ItemCount
            .ListView1.ListItems(ItemCount).SubItems(1) = rs("UserID")
            .ListView1.ListItems(ItemCount).SubItems(2) = rs("username")
            .ListView1.ListItems(ItemCount).SubItems(3) = rs("sex")
            .ListView1.ListItems(ItemCount).SubItems(4) = rs("age")
            .ListView1.ListItems(ItemCount).SubItems(5) = rs("gl")
            .ListView1.ListItems(ItemCount).SubItems(6) = rs("department")
            .ListView1.ListItems(ItemCount).SubItems(7) = rs("business")
            .ListView1.ListItems(ItemCount).SubItems(8) = rs("remark")
            rs.MoveNext
        Loop
        rs.Close
        .StatusBar1.Panels(1).Text = "共查询：" & ItemCount & " 条记录"
    End With
End Sub

Private Sub ListView1_DblClick()
    Dim I As Integer
    If Me.ListView1.ListItems.Count = 0 Then Exit Sub
    With frmPeople
        .txtField(0).Text = Me.ListView1.SelectedItem.SubItems(1)
        .txtField(1).Text = Me.ListView1.SelectedItem.SubItems(2)
         If Me.ListView1.SelectedItem.SubItems(3) = "男" Then
            .Option1(0).Value = True
        Else
            .Option1(1).Value = True
        End If
        .txtField(2).Text = Me.ListView1.SelectedItem.SubItems(4)
        .txtField(3).Text = Me.ListView1.SelectedItem.SubItems(5)
        .Combo1.Text = Me.ListView1.SelectedItem.SubItems(6)
        .txtField(4).Text = Me.ListView1.SelectedItem.SubItems(7)
        .txtField(5).Text = Me.ListView1.SelectedItem.SubItems(8)
    End With
    For I = 0 To 5
        frmPeople.txtField(I).Enabled = False
    Next
    frmPeople.Combo1.Enabled = False
    frmPeople.Option1(0).Enabled = False
    frmPeople.Option1(1).Enabled = False
    frmPeople.Command1.Enabled = False
    frmPeople.Show
End Sub

Private Sub ListView1_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
    If Button = 2 Then
        PopupMenu mnuFile
    End If
End Sub

Private Sub mnuFile_Edit_Click()
    Command3_Click
End Sub

Private Sub mnuFile_new_Click()
    Command4_Click
End Sub

Private Sub mnuFile_View_Click()
    ListView1_DblClick
End Sub

Private Sub mnuFile2_delete_Click()
    Dim sKey As String
    Dim sDepartment As String
    Dim strDelete As String
    On Error GoTo err_lab
    sKey = Me.TreeView1.SelectedItem.Key
    If sKey = "ROOT" Or sKey = "N_ALL" Then Exit Sub
    sDepartment = Me.TreeView1.SelectedItem.Text
    strDelete = "select * from  tbl_User where department='" & sDepartment & "'"
    Set rs = Nothing
    rs.Open strDelete, gblCn, adOpenKeyset, adLockOptimistic, adCmdText
    If rs.RecordCount > 0 Then
        MsgBox "当前部门还存在人员资料，请确认删除全部人员资料后再进行操作！", vbInformation, "提示"
    Else
        If MsgBox("是否真的要删除选定的部门？", vbInformation + vbYesNo, "提示") = vbNo Then
            rs.Close
            Exit Sub
        End If
        gblCn.Execute "delete from tbl_Department where Department='" & sDepartment & "'"
    End If
    rs.Close
    InitTreeView '刷新部门
    Exit Sub
err_lab:
    MsgBox Err.Description, vbInformation + vbOKOnly, "提示"
End Sub

Private Sub mnuFile2_new_Click()
    Dim sDepartment As String
    sDepartment = InputBox("请输入新的部门名称：", "新增部门", "")
    If Len(sDepartment) = 0 Then Exit Sub
    If Len(sDepartment) > 30 Then
        MsgBox "部门名称过长！请重新输入。", vbInformation, "提示"
        Exit Sub
    End If
    Set rs = Nothing
    rs.Open "select * from tbl_Department where Department='" & sDepartment & "'", gblCn, adOpenKeyset, adLockOptimistic, adCmdText
    If rs.RecordCount > 0 Then
        MsgBox "已经存在当前的部门名称！", vbInformation, "提示"
        Exit Sub
    Else
        gblCn.Execute "insert into tbl_Department(Department) values('" & sDepartment & "')"
    End If
    InitTreeView '刷新部门
End Sub

Private Sub TreeView1_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
    If Button = 2 Then
        PopupMenu mnuFile2
    End If
End Sub

Private Sub TreeView1_NodeClick(ByVal Node As MSComctlLib.Node)
    Dim curNode As String
    curNode = Node.Text
    Select Case Node.Key
        Case "ROOT"
            
        Case "N_ALL"
            Node.SelectedImage = 3
            LoadListItemData "ALL"
        Case Else
            Node.SelectedImage = 3
            LoadListItemData curNode
    End Select
End Sub