专家坐堂-多选的加载目录树Foxtable(狐表) - 新一代数据库软件，完美融合Access、Foxpro、Excel、vb.net之优势，人人都能掌握的快速软件开发工具!

以文本方式查看主题

-  Foxtable(狐表)  (http://foxtable.net/bbs/index.asp)
--  专家坐堂  (http://foxtable.net/bbs/list.asp?boardid=2)
----  多选的加载目录树  (http://foxtable.net/bbs/dispbbs.asp?boardid=2&id=174024)

--  作者：采菊东篱下
--  发布时间：2021/12/27 19:26:00
--  多选的加载目录树

此主题相关图片如下：qq图片20211227192258.png

勾选代码这样写点击勾选后没反应：
Dim trv As WinForm.TreeView = e.Sender
Dim flt,flt1,flt2,flt3 As String
If trv.Nodes(0).Name = e.Node.Name
If e.Node.Checked
For Each nd As WinForm.TreeNode In trv.AllNodes
nd.Checked = False
Next
e.Node.Checked = True
Else
flt = "1=2"
End If
Else
Dim nms As String() = {"团体赛或个人赛","棋赛名称","分组","第几轮比赛","姓名"} \'指定生成目录树的各列
Dim qts As String() = {"\'","\'","\'","\'","\'"} \'指定将各列的值括起来的符号,这里都是字符型,所以都是单引号
Dim nms1 As String() = {"团体赛或个人赛","棋赛名称","分组","所属团体","第几轮比赛","姓名"} \'指定生成目录树的各列
Dim qts1 As String() = {"\'","\'","\'","\'","\'","\'"} \'指定将各列的值括起来的符号,这里都是字符型,所以都是单引号
Dim s() As String = {"个人赛","团体赛","擂台赛"}
For Each nd As WinForm.TreeNode In e.node.allNodes \'清除子节点的选中标记
nd.Checked = e.node.Checked
Next
If e.node.Checked = False
Dim pd As WinForm.TreeNode = e.Node.ParentNode
If pd IsNot Nothing Then
pd.Checked = False
End If
End If
For Each nd As WinForm.TreeNode In trv.AllNodes
If nd.Checked Then
Dim val As String = ""
Dim rts() As String = nd.FullPath.Split("\\")
If nd.FullPath Like """ & s(0) & """
For i As Integer = 1 To rts.length - 1
If val > "" Then
val = val & " And "
End If
val = val & nms(i-1) & " = " & qts(i-1) & rts(i) & qts(i-1)
Next
If flt > "" Then
flt = flt & " or (" & val & ")"
Else
flt = val
End If
ElseIf nd.FullPath Like """ & s(1) & """
For i As Integer = 1 To rts.length - 1
If val > "" Then
val = val & " And "
End If
val = val & nms1(i-1) & " = " & qts1(i-1) & rts(i) & qts1(i-1)
Next
If flt1 > "" Then
flt1 = flt1 & " or (" & val & ")"
Else
flt1 = val
End If
ElseIf nd.FullPath Like """ & s(2) & """
For i As Integer = 1 To rts.length - 1
If val > "" Then
val = val & " And "
End If
val = val & nms1(i-1) & " = " & qts1(i-1) & rts(i) & qts1(i-1)
Next
If flt2 > "" Then
flt2 = flt2 & " or (" & val & ")"
Else
flt2 = val
End If
End If
End If
Next
If flt1 > "" Then
flt1 = s(0) & "\' And " & flt1 & "\'"
End If
If flt2 > "" Then
flt2 = s(1) & "\' And " & flt2 & "\'"
End If
If flt3 > "" Then
flt3 = s(2) & "\' And " & flt3 & "\'"
End If
If flt1 > "" Then
flt = "(" & flt1 & ")"
End If
If flt2 > "" Then
If flt > "" Then
flt = flt & " Or "
End If
flt = flt & "(" & flt2 & ")"
End If
If flt3 > "" Then
If flt > "" Then
flt = flt & " Or "
End If
flt = flt & "(" & flt3 & ")"
End If
End If
With DataTables("比赛积分")
.LoadFilter = flt \'设置加载条件
.LoadPage = 0 \'加载第一页
.LoadTop = 20 \'每页5行
.loadover = "_Identify"
.LoadReverse = True
.Load()
e.Form.Controls("TextBox1").Value = 1 & "/" & .TotalPages
End With

--  作者：有点蓝
--  发布时间：2021/12/27 20:50:00
--
看不懂，上传实例

--  作者：采菊东篱下
--  发布时间：2021/12/27 21:01:00
--

下载信息  [文件大小：   下载次数： ]
点击浏览该文件:管理项目2.foxdb

--  作者：有点蓝
--  发布时间：2021/12/27 21:41:00
--

http://www.foxtable.com/webhelp/topics/0222.htm

If nd.FullPath Like s(0) & "\\*"

--  作者：采菊东篱下
--  发布时间：2021/12/27 23:02:00
--

这样写子字节去除勾加载，打勾不加载，跟我要的效果相反，我要打勾加载，去除勾不加载，另点一级子节没反应，其他子节没筛选。
Dim trv As WinForm.TreeView = e.Sender
Dim flt,flt1,flt2,flt3 As String
Dim nd As WinForm.TreeNode
If trv.Nodes(0).Name = e.Node.Name
If e.Node.Checked
For Each nd In trv.AllNodes
nd.Checked = False
Next
e.Node.Checked = True
Else
flt = "1=2"
End If
Else
Dim nms As String() = {"团体赛或个人赛","棋赛名称","分组","第几轮比赛","姓名"} \'指定生成目录树的各列
Dim qts As String() = {"\'","\'","\'","\'","\'"} \'指定将各列的值括起来的符号,这里都是字符型,所以都是单引号
Dim nms1 As String() = {"团体赛或个人赛","棋赛名称","分组","所属团体","第几轮比赛","姓名"} \'指定生成目录树的各列
Dim qts1 As String() = {"\'","\'","\'","\'","\'","\'"} \'指定将各列的值括起来的符号,这里都是字符型,所以都是单引号
Dim s() As String = {"个人赛","团体赛","擂台赛"}
For Each nd In e.node.allNodes \'清除子节点的选中标记
nd.Checked = False
Next
nd = e.Node.ParentNode
Do While nd IsNot Nothing \'清除父节点的选中标记
nd.Checked = False
nd = nd.ParentNode
Loop
For Each nd In trv.AllNodes
If nd.Checked Then
Dim val As String = ""
Dim rts() As String = nd.FullPath.Split("\\")
If nd.FullPath Like s(0) & "\\*"
For i As Integer = 1 To rts.length - 1
If val > "" Then
val = val & " And "
End If
val = val & nms(i-1) & " = " & qts(i-1) & rts(i) & qts(i-1)
Next
If flt > "" Then
flt = flt & " or (" & val & ")"
Else
flt = val
End If
ElseIf nd.FullPath Like s(1) & "\\*"
For i As Integer = 1 To rts.length - 1
If val > "" Then
val = val & " And "
End If
val = val & nms1(i-1) & " = " & qts1(i-1) & rts(i) & qts1(i-1)
Next
If flt1 > "" Then
flt1 = flt1 & " or (" & val & ")"
Else
flt1 = val
End If
ElseIf nd.FullPath Like s(2) & "\\*"
For i As Integer = 1 To rts.length - 1
If val > "" Then
val = val & " And "
End If
val = val & nms1(i-1) & " = " & qts1(i-1) & rts(i) & qts1(i-1)
Next
If flt2 > "" Then
flt2 = flt2 & " or (" & val & ")"
Else
flt2 = val
End If
End If
End If
Next
If flt1 > "" Then
flt1 = s(0) & "\' And " & flt1 & "\'"
End If
If flt2 > "" Then
flt2 = s(1) & "\' And " & flt2 & "\'"
End If
If flt3 > "" Then
flt3 = s(2) & "\' And " & flt3 & "\'"
End If
If flt1 > "" Then
flt = "(" & flt1 & ")"
End If
If flt2 > "" Then
If flt > "" Then
flt = flt & " Or "
End If
flt = flt & "(" & flt2 & ")"
End If
If flt3 > "" Then
If flt > "" Then
flt = flt & " Or "
End If
flt = flt & "(" & flt3 & ")"
End If
End If
With DataTables("比赛积分")
.LoadFilter = flt \'设置加载条件
.LoadPage = 0 \'加载第一页
.LoadTop = 20 \'每页5行
.loadover = "_Identify"
.LoadReverse = True
.Load()
e.Form.Controls("TextBox1").Value = 1 & "/" & .TotalPages
End With

[此贴子已经被作者于2021/12/28 11:12:27编辑过]

--  作者：有点蓝
--  发布时间：2021/12/28 10:05:00
--

下载信息  [文件大小：   下载次数： ]
点击浏览该文件:管理项目2 (2).zip

--  作者：采菊东篱下
--  发布时间：2021/12/28 13:28:00
--
谢谢，行了。

--  作者：采菊东篱下
--  发布时间：2023/3/8 22:43:00
--

下载信息  [文件大小：   下载次数： ]
点击浏览该文件:加载树.foxdb

6楼你做的效果取消子字节勾选，不能减少筛选加载，且子节点全部勾选父节点没同步勾选，我现在做的效果已实现子节点全部勾选父节点同步勾选了，但出现了勾选倒数第三层父节点、子节点都没问题，勾选综合组字节就报错了：应是红色标注的问题，因为勾选综合组字节，其下所有子字节、其上的个人赛字节、2020年迎春杯父字节自动同步勾选，造成红字合成的条件错误，应如何实现这种既能兼顾反选效果，又能实现同步加载。
......
For Each nd In trv.AllNodes
If nd.Checked Then
Dim val As String = ""
Dim val1 As String = ""
Dim val2 As String = ""
Dim rts() As String = nd.FullPath.Split("\\")
If nd.FullPath Like s(0) & "*" Then
For i As Integer = 0 To rts.length - 1
If val > "" Then
val = val & " And "
End If
val = val & nms(i) & " = " & qts(i) & rts(i) & qts(i)
Next
If flt1 > "" Then
flt1 = flt1 & " or (" & val & ")"
ElseIf flt1 = "" Then
flt1 = "1=2"
Else
flt1 = val
End If
\' MessageBox.Show(flt1)
ElseIf nd.FullPath Like s(1) & "*" Then
For i1 As Integer = 0 To rts.length - 1
If val1 > "" Then
val1 = val1 & " And "
End If
val1 = val1 & nms1(i1) & " = " & qts1(i1) & rts(i1) & qts1(i1)
Next
If flt2 > "" Then
flt2 = flt2 & " or (" & val1 & ")"
ElseIf flt2 = "" Then
flt2 = "1=2"
Else
flt2 = val1
End If
ElseIf nd.FullPath Like s(2) & "*" Then
For i2 As Integer = 0 To rts.length - 1
If val2 > "" Then
val2 = val2 & " And "
End If
val2 = val2 & nms1(i2) & " = " & qts1(i2) & rts(i2) & qts1(i2)
Next
If flt3 > "" Then
flt3 = flt3 & " or (" & val2 & ")"
ElseIf flt3 = "" Then
flt3 = "1=2"
Else
flt3 = val2
End If
End If
End If
Next
If flt1 > "" Then
If flt > "" Then
flt = flt & " or (" & flt1 & ")"
Else
flt = flt1
End If
End If
If flt2 > "" Then
If flt > "" Then
flt = flt & " or (" & flt2 & ")"
Else
flt = flt2
End If
End If
If flt3 > "" Then
If flt > "" Then
flt = flt & " or (" & flt3 & ")"
Else
flt = flt3
End If
End If
If flt = "" Then
flt = "[_Identify] Is Null"
End If
End If
With DataTables("比赛积分")
.LoadFilter = flt \'设置加载条件
.LoadPage = 0 \'加载第一页
.LoadTop = 20 \'每页5行
.loadover = "_Identify"
.LoadReverse = True
.Load()
e.Form.Controls("TextBox1").Value = 1 & "/" & .TotalPages
End With
With Tables("比赛积分")
.AutoSizeCol("日期")
.AutoSizeCol("操作人姓名")
.Cols("备注").Width = 180
.AutoSizeRows()
End With

[此贴子已经被作者于2023/3/8 23:18:31编辑过]

--  作者：采菊东篱下
--  发布时间：2023/3/9 7:15:00
--

把开头的代码改为：
For Each nd In trv.AllNodes
  Dim pd As WinForm.TreeNode = e.Node.ParentNode
If pd.Checked Then
Continue For
  End If
If nd.Checked And nd.Nodes.Count = 0 Then

这几行红色标注代码，跳过父节点，执行勾选节点最后一层子节点条件，执行结果，点第一节点报错：
.NET Framework 版本：4.0.30319.42000
Foxtable 版本：2022.8.18.1
错误所在事件：窗口,主窗口,TreeView1,AfterCheckNode
详细错误信息：
未将对象引用设置到对象的实例。
点第二、三节点不报错，但没任何数据加载，点最后3层字节，能正常加载数据，到底应如做到跳过父节点，加载所有勾选的最后一层子节点数据。

[此贴子已经被作者于2023/3/9 7:35:24编辑过]

--  作者：有点蓝
--  发布时间：2023/3/9 8:58:00
--
查询条件是有长度限制的。综合组下面的子节点太多，导致合成的查询条件过长。