一个treeview应用实例

来源:www.accessoft.com 点击数:14645 　 | 收藏 | 复制

时　间:2009-12-04 13:21:26
作　者:雨竹 ID：7475 城市：北京
摘　要:treeview应用：可任意添加项目、编辑项目、删除项目、移动项目，而且所有的更改全部保存到数据表中。
因积分不够，贴出原码。
正　文:

Option Compare Database
Option Explicit
Private nodx As Node
Dim Currentkey As String

Private Sub cmd1_Click()    '=================增加项目
    If Me.cmd1.Caption = "新增" Then
        Me.cmd1.Caption = "确定"
        Me.Cmd3.Enabled = False
        Me.Cmd4.Enabled = False
        Me.Cmd5.Enabled = False
        Me.cmd2.Enabled = False
        Me.Cmd6.Caption = "取消"
        Me.Text1.Enabled = True
        Me.Text1.SetFocus
        Exit Sub
    Else

        Dim newKey As String
        Dim maxkey As String
        If IsNull(Me.Text1) Then
            MsgBox "你还没有输入单位名称！ ", vbInformation, "警告"
            Me.Text1.SetFocus
            Exit Sub
        End If
        If Me.TreeView0.Nodes.Count = 0 Then    '如果treeview中无项目，则添加root项目
            newKey = "BH01"
            Me.TreeView0.Nodes.Add , , newKey, Me.Text1
        Else
            Currentkey = Me.TreeView0.SelectedItem.Key

            Dim i As Integer
            For i = 1 To Me.TreeView0.Nodes.Count
                If Me.TreeView0.Nodes.Item(i) = Me.Text1 Then
                    MsgBox "你输入的单位已经存在，请重新输入？ ", , "提示"
                    Me.Text1.SetFocus
                    Exit Sub
                End If
            Next i

            If Me.Frame1 = 1 Then   '添加同级项目
                maxkey = Me.TreeView0.Nodes(Currentkey).LastSibling.Key
                newKey = Left(maxkey, Len(maxkey) - 2) & Format(Val(Right(maxkey, 2)) + 1, "00")
                Set nodx = TreeView0.Nodes.Add(Currentkey, tvwLast, newKey, Me.Text1)
            Else                     '添加下级项目
                If Me.TreeView0.Nodes(Currentkey).Children = 0 Then
                    maxkey = Me.TreeView0.Nodes(Currentkey).Key & "00"
                Else
                    maxkey = Me.TreeView0.Nodes(Currentkey).Child.LastSibling.Key
                End If
                newKey = Left(maxkey, Len(maxkey) - 2) & Format(Val(Right(maxkey, 2)) + 1, "00")


                Set nodx = TreeView0.Nodes.Add(Currentkey, tvwChild, newKey, Me.Text1)

            End If
        End If
        Dim rs As Recordset
        Set rs = CurrentDb.OpenRecordset("单位名称")
        rs.AddNew
        rs("单位编号") = newKey
        rs("单位名称") = Me.Text1
        rs.Update
        rs.Close
        Set rs = Nothing
        Me.TreeView0.Refresh
        Me.TreeView0.Nodes(newKey).Selected = True
        Me.TreeView0.SetFocus
        Currentkey = newKey
        If Len(newKey) = 4 Then
            Me.Frame1 = 2
            Me.Frame1.Enabled = False
        ElseIf Len(newKey) = 6 Then
            Me.Frame1.Enabled = True
        Else
            Me.Frame1 = 1
            Me.Frame1.Enabled = False
        End If

        Me.Text1.Value = Null
        Me.Text1.Enabled = False
        Me.cmd1.Caption = "新增"
        Me.Cmd3.Enabled = True
        Me.Cmd4.Enabled = (Len(Currentkey) > 4 And Currentkey <> Me.TreeView0.Nodes(Currentkey).FirstSibling.Key) '   Nz(DLookup("单位编号", "单位名称", "单位编号<'" & Currentkey & "' and len(单位编号)=8")) <> 0)
        Me.Cmd5.Enabled = (Len(Currentkey) > 4 And Currentkey <> Me.TreeView0.Nodes(Currentkey).LastSibling.Key) 'DMax("单位编号", "单位名称", "单位编号 like '" & Left(Currentkey, 6) & "*'"))
        Me.Cmd6.Caption = "关闭"
        Me.cmd2.Enabled = True
    End If

End Sub

Private Sub cmd2_Click()

    If Me.cmd2.Caption = "修改" Then
        Me.cmd2.Caption = "确定"
        Me.cmd1.Enabled = False
        Me.Cmd3.Enabled = False
        Me.Cmd4.Enabled = False
        Me.Cmd5.Enabled = False
        Me.Cmd6.Caption = "取消"
        Me.Text1.Enabled = True
        Me.Text1 = Me.TreeView0.SelectedItem
        Me.Text1.SetFocus
        Me.Text1.SelStart = 0
        Me.Text1.SelLength = Len(Me.Text1)
    Else
        Dim rs As Recordset
        Set rs = CurrentDb.OpenRecordset("单位名称")
        rs.MoveFirst
        Do While Not rs.EOF
            If rs("单位编号") = Currentkey Then
                If rs("单位名称") <> Me.Text1 Then
                    rs.Edit
                    rs("单位名称") = Me.Text1
                    rs.Update
                End If
                Exit Do
            End If
            rs.MoveNext
        Loop

        rs.Close
        Set rs = Nothing
        Me.TreeView0.Nodes.Clear
        Form_Load
        Me.TreeView0.Nodes(Currentkey).Selected = True
        Me.TreeView0.SetFocus
        Me.Text1.Value = Null
        Me.Text1.Enabled = False
        Me.cmd1.Enabled = True
        Me.Cmd3.Enabled = True
        Me.Cmd4.Enabled = False
        Me.Cmd5.Enabled = False
        Me.Cmd6.Caption = "关闭"
        Me.cmd2.Caption = "修改"
    End If

End Sub
Private Sub cmd3_Click()        '================删除项目

    Dim nChild As Integer
    nChild = Me.TreeView0.SelectedItem.Children

    If nChild > 0 Then
        MsgBox "该部门下面有" & Trim(Str(nChild)) & "个单位，你不能删除！ ", vbInformation, "提示"
        Exit Sub
    ElseIf DCount("*", "职工信息", "单位编号='" & Me.TreeView0.SelectedItem.Key & "'") > 0 Then
        If MsgBox("该部门有职工信息，如果删除该部门，其中的职工信息也将删除！" & Chr(13) & "请确认是否删除？", vbCritical + vbYesNo + vbDefaultButton2, "警告") = vbNo Then
            Exit Sub
        End If
    End If

    If MsgBox("您确认删除该单位吗？   ", vbInformation + vbYesNo + vbDefaultButton2, "提示") = vbYes Then
        Dim rs As DAO.Recordset
        Set rs = CurrentDb.OpenRecordset("单位名称")
        rs.MoveFirst
        Do While Not rs.EOF
            If rs("单位编号") = Currentkey Then
                rs.delete
                Exit Do
            End If
            rs.MoveNext
        Loop
        rs.Close
        Set rs = Nothing

        Dim Removekey As String
        If Currentkey <> Me.TreeView0.Nodes(Currentkey).FirstSibling.Key Then     '判断当前项是否为本层第一项
            Me.TreeView0.Nodes(Currentkey).Previous.Selected = True
            Removekey = Currentkey
            Currentkey = Me.TreeView0.Nodes(Currentkey).Previous.Key
        ElseIf Currentkey <> Me.TreeView0.Nodes(Currentkey).LastSibling.Key Then   '判断当前是否为本层最后一项
            Me.TreeView0.Nodes(Currentkey).Next.Selected = True
            Removekey = Currentkey
            Currentkey = Me.TreeView0.Nodes(Currentkey).Next.Key
        ElseIf Not Me.TreeView0.Nodes(Currentkey).Parent Is Nothing Then            '判断当前项有无父结点
            Me.TreeView0.Nodes(Currentkey).Parent.Selected = True
            Removekey = Currentkey
            Currentkey = Me.TreeView0.Nodes(Currentkey).Parent.Key
        Else                                                                         '当前项无父结点
            Currentkey = Me.TreeView0.Nodes(1).Key
            Removekey = Currentkey
        End If
        Me.TreeView0.SetFocus
        Me.TreeView0.Nodes.Remove (Removekey)
        If Me.TreeView0.Nodes.Count > 0 Then
            Me.Cmd4.Enabled = (Len(Currentkey) > 4 And Currentkey <> Me.TreeView0.Nodes(Currentkey).FirstSibling.Key)
            Me.Cmd5.Enabled = (Len(Currentkey) > 4 And Currentkey <> Me.TreeView0.Nodes(Currentkey).LastSibling.Key)
        End If
    End If
    If Me.TreeView0.Nodes.Count = 0 Then
        Me.cmd1.SetFocus
        Me.Frame1 = 1
        Me.Frame1.Enabled = False
        Me.cmd2.Enabled = False
        Me.Cmd3.Enabled = False
    End If

End Sub

Private Sub cmd4_Click() '上移一行

    If IsNull(Currentkey) Then Exit Sub

    Dim ckey As String
    ckey = Me.TreeView0.Nodes(Currentkey).Previous.Key
    Dim rs1, rs2 As Recordset
    Dim strSQL1, strSQL2 As String
    strSQL1 = "select * from 单位名称 where 单位编号 like '" & ckey & "*'"
    strSQL2 = "select * from 单位名称 where 单位编号 like '" & Currentkey & "*'"
    Set rs1 = CurrentDb.OpenRecordset(strSQL1)
    Set rs2 = CurrentDb.OpenRecordset(strSQL2)
    rs1.MoveFirst
    Do Until rs1.EOF
        rs1.Edit
        rs1("单位编号") = Replace(rs1("单位编号"), ckey, "X")
        rs1.Update
        rs1.MoveNext
    Loop


    rs2.MoveFirst
    Do Until rs2.EOF
        rs2.Edit
        rs2("单位编号") = Replace(rs2("单位编号"), Currentkey, ckey)
         rs2.Update
        rs2.MoveNext
    Loop
    rs2.Close
    Set rs2 = Nothing

    rs1.MoveFirst
    Do Until rs1.EOF
        rs1.Edit
        rs1("单位编号") = Replace(rs1("单位编号"), "X", Currentkey)
        rs1.Update
        rs1.MoveNext
    Loop
    rs1.Close
    Set rs1 = Nothing

    Me.TreeView0.Nodes.Clear
    Form_Load
    Currentkey = ckey
    Me.TreeView0.Nodes(Currentkey).Selected = True
    Me.TreeView0.SetFocus
    Me.Cmd4.Enabled = (Len(Currentkey) > 4 And Currentkey <> Me.TreeView0.Nodes(Currentkey).FirstSibling.Key)
    Me.Cmd5.Enabled = (Len(Currentkey) > 4 And Currentkey <> Me.TreeView0.Nodes(Currentkey).LastSibling.Key)
End Sub

Private Sub cmd5_Click()   '下移一行

    If IsNull(Currentkey) Then Exit Sub

    Dim ckey As String
    ckey = Me.TreeView0.Nodes(Currentkey).Next.Key

    Dim rs1, rs2 As Recordset
    Dim strSQL1, strSQL2 As String
    strSQL1 = "select * from 单位名称 where 单位编号 like '" & ckey & "*'"
    strSQL2 = "select * from 单位名称 where 单位编号 like '" & Currentkey & "*'"
    Set rs1 = CurrentDb.OpenRecordset(strSQL1)
    Set rs2 = CurrentDb.OpenRecordset(strSQL2)
    rs1.MoveFirst
    Do Until rs1.EOF
        rs1.Edit
        rs1("单位编号") = Replace(rs1("单位编号"), ckey, "X")
        rs1.Update
        rs1.MoveNext
    Loop


    rs2.MoveFirst
    Do Until rs2.EOF
        rs2.Edit
        rs2("单位编号") = Replace(rs2("单位编号"), Currentkey, ckey)
         rs2.Update
        rs2.MoveNext
    Loop
    rs2.Close
    Set rs2 = Nothing

    rs1.MoveFirst
    Do Until rs1.EOF
        rs1.Edit
        rs1("单位编号") = Replace(rs1("单位编号"), "X", Currentkey)
        rs1.Update
        rs1.MoveNext
    Loop
    rs1.Close
    Set rs1 = Nothing

    Me.TreeView0.Nodes.Clear
    Form_Load
    Currentkey = ckey
    Me.TreeView0.Nodes(Currentkey).Selected = True
    Me.TreeView0.SetFocus
    Me.Cmd4.Enabled = (Len(Currentkey) > 4 And Currentkey <> Me.TreeView0.Nodes(Currentkey).FirstSibling.Key)
    Me.Cmd5.Enabled = (Len(Currentkey) > 4 And Currentkey <> Me.TreeView0.Nodes(Currentkey).LastSibling.Key)
End Sub

Private Sub cmd6_Click() '关闭窗体

    If Me.Cmd6.Caption = "关闭" Then
        DoCmd.Close acForm, "机构设置窗体"
    Else
        Me.Cmd6.Caption = "关闭"
        If Me.cmd1.Caption = "确定" Then
            Me.cmd1.Caption = "新增"
            Me.cmd2.Enabled = True
        Else
            Me.cmd2.Caption = "修改"
            Me.cmd1.Enabled = True
        End If
        Me.Text1.Value = Null
        Me.Text1.Enabled = False
        Me.Cmd3.Enabled = True
        Me.Cmd4.Enabled = (Len(Currentkey) > 4 And Currentkey <> Me.TreeView0.Nodes(Currentkey).FirstSibling.Key)
        Me.Cmd5.Enabled = (Len(Currentkey) > 4 And Currentkey <> Me.TreeView0.Nodes(Currentkey).LastSibling.Key)
    End If
End Sub

Private Sub Form_Load() '================载入窗体

    If DCount("*", "单位名称") > 0 Then
        Dim syDB As DAO.Database
        Dim strSQL1, strSQL2, strSQL3 As String
        Dim rs1, rs2, rs3 As DAO.Recordset
        Dim cNo As String
        Set syDB = CurrentDb
        strSQL1 = "select * from 单位名称 where len(单位编号)=4 order by 单位编号"
        strSQL2 = "select * from 单位名称 where len(单位编号)=6 order by 单位编号"
        strSQL3 = "select * from 单位名称 where len(单位编号)=8 order by 单位编号"
        Set rs1 = syDB.OpenRecordset(strSQL1)
        Set rs2 = syDB.OpenRecordset(strSQL2)
        Set rs3 = syDB.OpenRecordset(strSQL3)

        '载入第一层数据
        rs1.MoveFirst
        Do Until rs1.EOF
            Set nodx = Me.TreeView0.Nodes.Add(, , rs1("单位编号"), rs1("单位名称"))
            rs1.MoveNext
        Loop
        rs1.Close
        Set rs1 = Nothing

        '载入第二层数据
        Do Until rs2.EOF
            Set nodx = Me.TreeView0.Nodes.Add(Left(rs2("单位编号"), 4), tvwChild, rs2("单位编号"), rs2("单位名称"))
            rs2.MoveNext
        Loop
        rs2.Close
        Set rs2 = Nothing

        '载入第三层数据
        Do Until rs3.EOF
            Set nodx = Me.TreeView0.Nodes.Add(Left(rs3("单位编号"), 6), tvwChild, rs3("单位编号"), rs3("单位名称"))
            rs3.MoveNext
        Loop
        rs3.Close
        Set rs3 = Nothing

        With Me.TreeView0
            .Nodes(1).Expanded = True
            .Nodes(1).Selected = True
            .SetFocus
        End With
    End If
End Sub

Private Sub Form_Open(Cancel As Integer)

    Me.Caption = "机构设置"
    Me.Frame1 = 2
    Me.Frame1.Enabled = False
    Me.Cmd4.Enabled = False
    Me.Cmd5.Enabled = False
    Me.Text1.Enabled = False

End Sub

Private Sub TreeView0_NodeClick(ByVal Node As Object)

    Currentkey = Me.TreeView0.SelectedItem.Key
    Me.Frame1.Enabled = True
    If Len(Currentkey) = 4 Then      '==================如果当前选择的是目录树根项，则只能增加其下级项目
        Me.Frame1 = 2
        Me.Frame1.Enabled = False
    Else
        If Len(Currentkey) = 8 Then '================如果当前选择的是目录树的第三级，则只能增加其同级项目
            Me.Frame1 = 1
            Me.Frame1.Enabled = False
        End If
    End If
    Me.Cmd4.Enabled = (Len(Currentkey) > 4 And Currentkey <> Me.TreeView0.Nodes(Currentkey).FirstSibling.Key) '控制只能三级项目才可移动，并且单击第一个项目时，上移按钮锁定
    Me.Cmd5.Enabled = (Len(Currentkey) > 4 And Currentkey <> Me.TreeView0.Nodes(Currentkey).LastSibling.Key) '单击三级最后一个项目时，下移按钮锁定
End Sub