以文本方式查看主题

-  Foxtable(狐表)  (http://foxtable.com/bbs/index.asp)
--  专家坐堂  (http://foxtable.com/bbs/list.asp?boardid=2)
----  [求助]关于多级分类的问题  (http://foxtable.com/bbs/dispbbs.asp?boardid=2&id=16600)

--  作者:西瓜住持
--  发布时间:2012/2/18 15:53:00
--  [求助]关于多级分类的问题

将目录树形式的授权为模板修改为了三级分类.

但是其中增加二类和增加三类的代码有点问题,不知道如何修改.望解答

 下载信息  [文件大小:   下载次数: ]
图片点击可在新窗口打开查看点击浏览该文件:目录树形式的授权.foxdb

表名:授权

列:一类名称 二类名称 三类名称 用户

 

 

项目事件

 

AfterOpenProject

 

Forms("授权").Open()

 

计划管理

 

表事件

 

窗口表事件

 

窗口与控件事件

 

授权_AfterLoad

 

Dim trv1 As WinForm.TreeView = e.Form.Controls("TreeView1")

Dim trv2 As WinForm.TreeView = e.Form.Controls("TreeView2")

trv1.BuildTree("授权","一类名称|二类名称|三类名称")

For Each u As UserInfo In Users

    If u.Type = UserTypeEnum.User Then

        If trv2.Nodes.Contains(u.Group) = False Then

            trv2.Nodes.Add(u.Group)

        End If

        trv2.Nodes(u.Group).Nodes.Add(u.Name)

    End If

Next

Trv1.Nodes(0).Expand()

trv2.ExpandAll()

 

授权_Button1_Click

 

Dim trv As WinForm.TreeView = e.Form.Controls("TreeView1")

Dim pd As WinForm.TreeNode = trv.SelectedNode

trv.Select()

If pd.Level = 1 Then

    pd = pd.ParentNode

End If

Dim i As Integer

Do

    i = i+ 1

    Dim nm As String  =  "二类名称" & i

    If pd.Nodes.Contains(nm) = False

        Dim nd As WinForm.TreeNode = pd.Nodes.Add(nm)

        Dim dr As DataRow = DataTables("授权").AddNew()

        dr("一类名称") = pd.name

        dr("二类名称") = nm

        trv.SelectedNode = nd

        trv.BeginEdit

        Exit Do

    End If

Loop

 

授权_Button2_Click

 

DataTables("授权").Save()

e.Form.Close()

 

授权_Button3_Click

 

DataTables("授权").RejectChanges() \'撤销修改

e.Form.Close()

 

授权_Button4_Click

 

Dim trv As WinForm.TreeView = e.Form.Controls("TreeView1")

Dim i As Integer

trv.Select()

Do

    i = i+ 1

    Dim nm As String = "一类名称" & i

    If trv.Nodes.Contains(nm) = False

        Dim dr As DataRow = DataTables("授权").AddNew

        Dim nd As WinForm.TreeNode =  trv.Nodes.Add(nm)

        dr("一类名称") = nm

        trv.SelectedNode = nd

        trv.BeginEdit

        Exit Do

    End If

Loop

 

授权_Button5_Click

 

Dim trv As WinForm.TreeView = e.Form.Controls("TreeView1")

Dim nd As WinForm.TreeNode = trv.SelectedNode

trv.Select()

If nd Is Nothing Then

    Return

End If

If nd.Level = 0 Then \'删除分组

    Dim dt As DataTable = DataTables("授权")

    If MessageBox.Show("确定要删除此分组码?","提示",MessageBoxButtons.YesNo,MessageBoxIcon.Question) = DialogResult.Yes Then

        For Each dr As DataRow In dt.Select("分组 = \'" & nd.Name & "\'" )

            dr.Delete

        Next

        nd.Delete

    End If

ElseIf nd.Level = 1 \'删除权限

    Dim dt As DataTable = DataTables("授权")

    Dim dr As DataRow

    Dim fz As String = nd.ParentNode.Name \'获得分组名

    dr = dt.Find("分组 = \'" & fz & "\' And 权限 = \'" & nd.Name & "\'" ) \'找出对应的行

    dr.Delete

    nd.Delete

End If

 

授权_Button6_Click

 

Dim trv As WinForm.TreeView = e.Form.Controls("TreeView1")

trv.Select()

trv.BeginEdit()

 

授权_TreeView1_AfterEditNode

 

If e.NewText = "" Then

    e.Cancel = True

ElseIf e.Node.Level = 0 Then \'重命名分组

    Dim dt As DataTable = DataTables("授权")

    Dim dr As DataRow

    dr = dt.Find("一类名称 = \'" & e.NewText & "\' And 二类名称 Is Null" ) \'判断新输入的分组是否存在

    If dr IsNot Nothing \'如果存在,取消输入.

        MessageBox.Show("此分组已经存在!", "提示", MessageBoxButtons.OK, MessageBoxIcon.Information)

        e.cancel = True

    Else

        For Each dr In dt.Select("一类名称 = \'" & e.Node.Name & "\'" ) \'重命名分组

            dr("一类名称") = e.NewText

        Next

        e.Node.Name = e.NewText \'使得节点的名称和标题保持一致.

    End If

ElseIf e.Node.Level = 1 \'重命名权限

    Dim dt As DataTable = DataTables("授权")

    Dim dr As DataRow

    Dim fz As String = e.Node.ParentNode.Name \'获得分组名

    dr = dt.Find("一类名称 = \'" & fz & "\' And 二类名称 = \'" & e.NewText & "\'" ) \'判断新输入的权限是否存在

    If dr IsNot Nothing \'如果存在,取消输入.

        MessageBox.Show("此权限已经存在!", "提示", MessageBoxButtons.OK, MessageBoxIcon.Information)

        e.Cancel = True

    Else

        dr = dt.Find("一类名称 = \'" & fz & "\' And 二类名称  = \'" & e.Node.Name & "\'" ) \'找出对应的行

        dr("二类名称") = e.NewText  \'重命名权限

        e.Node.Name = e.NewText \'使得节点的名称和标题保持一致.

    End If

End If

 

授权_TreeView1_AfterSelectNode

 

Dim trv1 As WinForm.TreeView = e.Form.Controls("TreeView1")

Dim trv2 As WinForm.TreeView = e.Form.Controls("TreeView2")

Dim dr As DataRow

If e.node.Level = 0 Then

    dr = DataTables("授权").Find("一类名称 = \'" & e.Node.Name & "\' And 二类名称 Is Null")

ElseIf e.node.Level =1 Then

    dr = DataTables("授权").Find("一类名称 = \'" & e.Node.ParentNode.Name & "\' And 二类名称 = \'" & e.Node.Name & "\'")

Else

    dr = DataTables("授权").Find("一类名称 = \'" & e.Node.ParentNode.ParentNode.Name & "\' and 二类名称 = \'" & e.Node.ParentNode.Name & "\'  And 三类名称 = \'" & e.Node.Name & "\'")

End If

Dim nms As New List(of String)

If dr IsNot Nothing AndAlso dr.IsNull("用户") = False

    nms.AddRange(dr("用户").Split(","))

End If

For Each nd As WinForm.TreeNode In trv2.AllNodes

    nd.Checked = nms.Contains(nd.Name)

Next

 

授权_TreeView1_Enter

 

Dim trv As WinForm.TreeView = e.Sender

Dim nd As WinForm.TreeNode = trv.SelectedNode   

If nd IsNot Nothing Then

    nd.Text = nd.Text.Trim("←")

End If

 

授权_TreeView1_Leave

 

Dim trv As WinForm.TreeView = e.Sender

Dim nd As WinForm.TreeNode = trv.SelectedNode

If nd IsNot Nothing Then

    nd.Text = nd.Text & "←"

End  If

 

授权_TreeView1_NodeMouseDoubleClick

 

Dim trv As WinForm.TreeView = e.Sender

trv.Select()

trv.BeginEdit()

 

授权_TreeView2_AfterCheckNode

 

Dim trv1 As WinForm.TreeView = e.Form.Controls("TreeView1")

Dim trv2 As WinForm.TreeView = e.Form.Controls("TreeView2")

Dim nd1 As WinForm.TreeNode = trv1.SelectedNode

Dim dr As DataRow

If trv2.Focused AndAlso nd1 IsNot Nothing  Then \'一定要判断焦点是否在此目录树

    If nd1.Level = 0 Then

        dr = DataTables("授权").Find("一类名称 = \'" & nd1.Name & "\' And 二类名称 Is Null")

    ElseIf nd1.Level = 1 Then

        dr = DataTables("授权").Find("一类名称 = \'" & nd1.ParentNode.Name & "\' And 二类名称 = \'" & nd1.Name & "\'")

    Else

        

        dr = DataTables("授权").Find("一类名称 = \'" & nd1.ParentNode.Name & "\' And 二类名称 = \'" & nd1.ParentNode.Name & "\' And 三类名称 = \'" & nd1.Name & "\'")

 

    End If

    If dr IsNot Nothing Then

        Dim nms As String

        For Each nd2 As WinForm.TreeNode In trv2.AllNodes

            If nd2.Checked  Then

                nms  = nms & "," &  nd2.Name

            End If

        Next

        If nms > "" Then

            dr("一类名称") = nms.Trim(",")

        Else

            dr("一类名称") = Nothing

        End If

    End If

End If

 

授权_增加三类_Click

 

Dim trv As WinForm.TreeView = e.Form.Controls("TreeView1")

Dim pd As WinForm.TreeNode = trv.SelectedNode

trv.Select()

If pd.Level = 2 Then

    pd = pd.ParentNode.ParentNode

End If

 

Dim i As Integer

Do

    i = i+ 1

    Dim nm As String  =  "三类名称" & i

    If pd.Nodes.Contains(nm) = False

        Dim nd As WinForm.TreeNode = pd.Nodes.Add(nm)

        Dim dr As DataRow = DataTables("授权").AddNew()

        dr("一类名称") = pd.ParentNode.name

        dr("二类名称") = pd.Name

        dr("三类名称") = nm

        trv.SelectedNode = nd

        trv.BeginEdit

        Exit Do

    End If

Loop


--  作者:狐狸爸爸
--  发布时间:2012/2/18 15:57:00
--  

看看这个:

http://www.foxtable.com/help/topics/1988.htm

 


--  作者:西瓜住持
--  发布时间:2012/2/18 16:42:00
--  

增加分类的按钮已解决。重名名第三级类的时候碰到问题,求助:

 

If e.NewText = "" Then
    e.Cancel = True
ElseIf e.Node.Level = 0 Then \'重命名一类名称
    Dim dt As DataTable = DataTables("授权")
    Dim dr As DataRow
    dr = dt.Find("一类名称 = \'" & e.NewText & "\' And 二类名称 Is Null" ) \'判断新输入的分组是否存在
    If dr IsNot Nothing \'如果存在,取消输入.
        MessageBox.Show("此分类已经存在!", "提示", MessageBoxButtons.OK, MessageBoxIcon.Information)
        e.cancel = True
    Else
        For Each dr In dt.Select("一类名称 = \'" & e.Node.Name & "\'" ) \'重命名分组
            dr("一类名称") = e.NewText
        Next
        e.Node.Name = e.NewText \'使得节点的名称和标题保持一致.
    End If
ElseIf e.Node.Level = 1 \'重命名二级类
    Dim dt As DataTable = DataTables("授权")
    Dim dr As DataRow
    Dim fz As String = e.Node.ParentNode.Name \'获得一类名
    dr = dt.Find("一类名称 = \'" & fz & "\' And 二类名称 = \'" & e.NewText & "\'" ) \'判断新输入的权限是否存在
    If dr IsNot Nothing \'如果存在,取消输入.
        MessageBox.Show("此分类已经存在!", "提示", MessageBoxButtons.OK, MessageBoxIcon.Information)
        e.Cancel = True
    Else
        dr = dt.Find("一类名称 = \'" & fz & "\' And 二类名称  = \'" & e.Node.Name & "\'" ) \'找出对应的行
        dr("二类名称") = e.NewText  \'重命名分类
        e.Node.Name = e.NewText \'使得节点的名称和标题保持一致.
    End If
ElseIf e.Node.Level = 2 \'重命名分类名称
    Dim dt As DataTable = DataTables("授权")
    Dim dr As DataRow
    Dim fz1 As String = e.Node.ParentNode.ParentNode.Name \'获得一类名
    Dim fz2 As String = e.Node.ParentNode.Name \'获得二类名
    dr = dt.Find("一类名称 = \'" & fz1 & "\' And 二类名称 = \'" & fz2 & "\' And 三类名称 = \'" & e.NewText & "\' " ) \'判断新输入的分类是否存在
    If dr IsNot Nothing \'如果存在,取消输入.
        MessageBox.Show("此类名已经存在!", "提示", MessageBoxButtons.OK, MessageBoxIcon.Information)
        e.Cancel = True
    Else
        dr = dt.Find("一类名称 = \'" & fz1 & "\' And 二类名称 = \'" & fz2 & "\' And 三类名称 = \'" & e.NewText & "\' " ) \'找出对应的行
        dr("三类名称") = e.NewText  \'重命名权限
        e.Node.Name = e.NewText \'使得节点的名称和标题保持一致.
    End If
End If

 

红色部分不知道哪里出错了


--  作者:西瓜住持
--  发布时间:2012/2/18 17:56:00
--  

已解决

 

dr = dt.Find("一类名称 = \'" & fz1 & "\' And 二类名称 = \'" & fz2 & "\' And 三类名称 = \'" & e.noede.name & "\' " )


--  作者:狐狸爸爸
--  发布时间:2012/2/18 18:00:00
--  
ElseIf e.Node.Level = 2 \'重命名分类名称
    Dim dt As DataTable = DataTables("授权")
    Dim dr As DataRow
    Dim fz1 As String = e.Node.ParentNode.ParentNode.Name \'获得一类名
    Dim fz2 As String = e.Node.ParentNode.Name \'获得二类名
    dr = dt.Find("一类名称 = \'" & fz1 & "\' And 二类名称 = \'" & fz2 & "\' And 三类名称 = \'" & e.NewText & "\' " ) \'判断新输入的分类是否存在
    If dr IsNot Nothing \'如果存在,取消输入.
        MessageBox.Show("此类名已经存在!", "提示", MessageBoxButtons.OK, MessageBoxIcon.Information)
        e.Cancel = True
    Else
        dr = dt.Find("一类名称 = \'" & fz1 & "\' And 二类名称 = \'" & fz2 & "\' And 三类名称 = \'" & e.node.Text & "\' " ) \'找出对应的行
        dr("三类名称") = e.NewText  \'重命名权限
        e.Node.Name = e.NewText \'使得节点的名称和标题保持一致.
    End If
End If