- Foxtable(狐表) (http://foxtable.net/bbs/index.asp)
-- 专家坐堂 (http://foxtable.net/bbs/list.asp?boardid=2)
---- [求助]加载树及加载内容控制 (http://foxtable.net/bbs/dispbbs.asp?boardid=2&id=174405)
-- 发布时间：2022/1/13 22:32:00
-- [求助]加载树及加载内容控制
有两张表，分别是“加载树设置”和“加载内容表”
Select Case e.node.Name
Case e.node.Name
Dim dr As DataRow
dr = DataTables("加载树设置").Find("表名 = \'" & e.node.Name & "\'")
Dim kd As String = dr("宽度")
Dim hs As String = dr("行数")
Dim nms() As String
If dr.Isnull("列名")=False Then
nms = dr("列名").Split(",")
End If
Dim dr1 As DataRow
Dim dr2 As DataRow
Dim Filter As String
Dim nms1() As String = _UserRoles.Split(",")
For Each nm As String In nms1
dr1 = DataTables("加载内容表").Find("表名 = \'" & e.node.Name & "\' and 角色 like \'%" & nm & "%\' and 列名 is not null and 列内容 is not null and 制单人=false")
dr2 = DataTables("加载内容表").Find("表名 = \'" & e.node.Name & "\' and 角色 like \'%" & nm & "%\' and 制单人 = true")
If dr1 IsNot Nothing And Tables.Contains(e.node.Name) Then
Filter = dr1("列名") & " In ( \'" & dr1("列内容").replace(",","\',\'") & "\')"
If DataTables.Contains(e.node.Name) = False Then
DataTables(e.node.Name).LoadFilter = Filter
DataTables(e.node.Name).Load
End If
If dr IsNot Nothing And Tables.Contains(e.node.Name) Then
For i As Integer = 0 To nms.Length - 1
If i=0 Then
Tables(e.node.Name).OpenLoadTree("" & nms(0) & "",kd,hs,True,Filter)
ElseIf i=1 Then
Tables(e.node.Name).OpenLoadTree("" & nms(0) & "|" & nms(1) & "",kd,hs,True,Filter)
Else
Tables(e.node.Name).OpenLoadTree("" & nms(0) & "|" & nms(1) & "|" & nms(2) & "",kd,hs,True,Filter)
End If
Next
End If
ElseIf dr2 IsNot Nothing And Tables.Contains(e.node.Name) Then
Filter = dr2("制单人列") & " = \'" & _UserName & "\'"
If DataTables.Contains(e.node.Name) = False Then
DataTables(e.node.Name).LoadFilter = Filter
DataTables(e.node.Name).Load
End If
If dr IsNot Nothing And Tables.Contains(e.node.Name) Then
For i As Integer = 0 To nms.Length - 1
If i=0 Then
Tables(e.node.Name).OpenLoadTree("" & nms(0) & "",kd,hs,True,Filter)
ElseIf i=1 Then
Tables(e.node.Name).OpenLoadTree("" & nms(0) & "|" & nms(1) & "",kd,hs,True,Filter)
Else
Tables(e.node.Name).OpenLoadTree("" & nms(0) & "|" & nms(1) & "|" & nms(2) & "",kd,hs,True,Filter)
End If
Next
End If
Else
Filter = ""
If DataTables.Contains(e.node.Name) = False Then
DataTables(e.node.Name).LoadFilter = Filter
DataTables(e.node.Name).Load
End If
If dr IsNot Nothing And Tables.Contains(e.node.Name) Then
For i As Integer = 0 To nms.Length - 1
If i=0 Then
Tables(e.node.Name).OpenLoadTree("" & nms(0) & "",kd,hs,True,Filter)
ElseIf i=1 Then
Tables(e.node.Name).OpenLoadTree("" & nms(0) & "|" & nms(1) & "",kd,hs,True,Filter)
Else
Tables(e.node.Name).OpenLoadTree("" & nms(0) & "|" & nms(1) & "|" & nms(2) & "",kd,hs,True,Filter)
End If
Next
End If
End If
Next
End Select
当某张表在“加载树设置”表中不存在时，就会提示以下错误，要如何调整
此主题相关图片如下：微信图片_20220113223000.png
-- 发布时间：2022/1/13 23:03:00
--
If DataTables.Contains(e.node.Name) = true Then
DataTables(e.node.Name).LoadFilter = Filter
DataTables(e.node.Name).Load
End If
-- 发布时间：2022/1/14 9:22:00
--
晕，眼花了。不过调整后还是一样的问题
Select Case e.node.Name
Case e.node.Name
Dim dr As DataRow
dr = DataTables("加载树设置").Find("表名 = \'" & e.node.Name & "\'")
Dim kd As String = dr("宽度")
Dim hs As String = dr("行数")
Dim nms() As String
If dr.Isnull("列名")=False Then
nms = dr("列名").Split(",")
End If
Dim dr1 As DataRow
Dim dr2 As DataRow
Dim Filter As String
Dim nms1() As String = _UserRoles.Split(",")
For Each nm As String In nms1
dr1 = DataTables("加载内容表").Find("表名 = \'" & e.node.Name & "\' and 角色 like \'%" & nm & "%\' and 列名 is not null and 列内容 is not null and 制单人=false")
dr2 = DataTables("加载内容表").Find("表名 = \'" & e.node.Name & "\' and 角色 like \'%" & nm & "%\' and 制单人 = true")
If dr1 IsNot Nothing And DataTables.Contains(e.node.Name)= True Then
Filter = dr1("列名") & " In ( \'" & dr1("列内容").replace(",","\',\'") & "\')"
DataTables(e.node.Name).LoadFilter = Filter
DataTables(e.node.Name).Load
If dr IsNot Nothing And DataTables.Contains(e.node.Name)= True Then
For i As Integer = 0 To nms.Length - 1
If i=0 Then
Tables(e.node.Name).OpenLoadTree("" & nms(0) & "",kd,hs,True,Filter)
ElseIf i=1 Then
Tables(e.node.Name).OpenLoadTree("" & nms(0) & "|" & nms(1) & "",kd,hs,True,Filter)
Else
Tables(e.node.Name).OpenLoadTree("" & nms(0) & "|" & nms(1) & "|" & nms(2) & "",kd,hs,True,Filter)
End If
Next
End If
ElseIf dr2 IsNot Nothing And DataTables.Contains(e.node.Name)= True Then
Filter = dr2("制单人列") & " = \'" & _UserName & "\'"
DataTables(e.node.Name).LoadFilter = Filter
DataTables(e.node.Name).Load
If dr IsNot Nothing And DataTables.Contains(e.node.Name)= True Then
For i As Integer = 0 To nms.Length - 1
If i=0 Then
Tables(e.node.Name).OpenLoadTree("" & nms(0) & "",kd,hs,True,Filter)
ElseIf i=1 Then
Tables(e.node.Name).OpenLoadTree("" & nms(0) & "|" & nms(1) & "",kd,hs,True,Filter)
Else
Tables(e.node.Name).OpenLoadTree("" & nms(0) & "|" & nms(1) & "|" & nms(2) & "",kd,hs,True,Filter)
End If
Next
End If
Else
Filter = ""
If DataTables.Contains(e.node.Name) = True Then
DataTables(e.node.Name).LoadFilter = Filter
DataTables(e.node.Name).Load
End If
If dr IsNot Nothing And DataTables.Contains(e.node.Name)= True Then
For i As Integer = 0 To nms.Length - 1
If i=0 Then
Tables(e.node.Name).OpenLoadTree("" & nms(0) & "",kd,hs,True,Filter)
ElseIf i=1 Then
Tables(e.node.Name).OpenLoadTree("" & nms(0) & "|" & nms(1) & "",kd,hs,True,Filter)
Else
Tables(e.node.Name).OpenLoadTree("" & nms(0) & "|" & nms(1) & "|" & nms(2) & "",kd,hs,True,Filter)
End If
Next
End If
End If
Next
End Select
-- 发布时间：2022/1/14 9:23:00
--
调试技巧：http://www.foxtable.com/webhelp/scr/1485.htm，看哪一句代码出错
-- 发布时间：2022/1/16 14:49:00
--
Select Case e.node.Name
Case e.node.Name
Dim dr As DataRow
Dim dr1 As DataRow
Dim dr2 As DataRow
Dim dr3 As DataRow
Dim dr4 As DataRow
Dim Filter As String
Dim nms1() As String = _UserRoles.Split(",")
If Forms.Contains(e.Node.Name)= False Then
dr = DataTables("表加载树设置").Find("表名 = \'" & e.node.Name & "\'")
Dim nms() As String
Dim kd As String
Dim hs As String
If dr IsNot Nothing Then
kd = dr("宽度")
hs = dr("行数")
If dr.Isnull("列名")=False Then
nms = dr("列名").Split(",")
End If
End If
For Each nm As String In nms1
dr1 = DataTables("加载内容权限表").Find("表名 = \'" & e.node.Name & "\' and 角色 like \'%" & nm & "%\' and 列名 is not null and 列内容 is not null and 制单人=false")
dr2 = DataTables("加载内容权限表").Find("表名 = \'" & e.node.Name & "\' and 角色 like \'%" & nm & "%\' and 制单人 = true")
If dr1 IsNot Nothing Then
Filter = dr1("列名") & " In ( \'" & dr1("列内容").replace(",","\',\'") & "\')"
ElseIf dr2 IsNot Nothing Then
Filter = dr2("制单人列") & " = \'" & _UserName & "\'"
Else
Filter = ""
End If
Next
If DataTables.Contains(e.node.Name) = False Then \'初始未加载表
DataTables.Load(e.node.Name) \'先加载表
DataTables(e.node.Name).LoadFilter = Filter \'加载条件
DataTables(e.node.Name).Load() \'加载数据
Else \'如果已经加载表但未加载数据
DataTables(e.node.Name).LoadFilter = Filter
DataTables(e.node.Name).Load()
End If
If dr IsNot Nothing Then
For i As Integer = 0 To nms.Length - 1
If i=0 Then
Tables(e.node.Name).OpenLoadTree("" & nms(0) & "",kd,hs,True,Filter)
ElseIf i=1 Then
Tables(e.node.Name).OpenLoadTree("" & nms(0) & "|" & nms(1) & "",kd,hs,True,Filter)
Else
Tables(e.node.Name).OpenLoadTree("" & nms(0) & "|" & nms(1) & "|" & nms(2) & "",kd,hs,True,Filter)
End If
Next
End If
For Each nm As String In nms1
dr4 = DataTables("表列操作权限表").Find("表名 = \'" & e.node.Name & "\' and 角色 like \'%" & nm & "%\' And 不可见=true And 列名 is not null")
dr3 = DataTables("表列操作权限表").Find("表名 = \'" & e.node.Name & "\' and 角色 like \'%" & nm & "%\' And 不可见=true And 列名 is null")
For Each dr5 As DataRow In DataTables("表列操作权限表").Select("角色 like \'%" & nm & "%\'")
If dr5.IsNull("列名") Then
Tables(dr5("表名")).Visible = Not dr5("不可见")
Tables(dr5("表名")).AllowEdit = Not dr5("不可编辑")
Else
Tables(dr5("表名")).Cols(dr5("列名")).Visible = Not dr5("不可见")
Tables(dr5("表名")).Cols(dr5("列名")).AllowEdit = Not dr5("不可编辑")
End If
Next
If dr4 IsNot Nothing Then
RibbonTabs("hlcz").Groups("lcz").Items("UnHideColumn").Enabled=False
ContextMenus("Column").Items("UnHide").Visible=False
Else
RibbonTabs("hlcz").Groups("lcz").Items("UnHideColumn").Enabled=True
ContextMenus("Column").Items("UnHide").Visible=True
End If
If dr3 IsNot Nothing Then
e.cancel = True
End If
Next
If Tables.Contains(e.Node.Name)= True Then
If dr3 IsNot Nothing Then
e.cancel = True
Else
MainTable = Tables(e.node.Name)
End If
End If
ElseIf Forms.Contains(e.Node.Name)= True Then
For Each nm As String In nms1
dr3 = DataTables("表列操作权限表").Find("表名 = \'" & e.node.Name & "\' and 角色 like \'%" & nm & "%\' And 不可见=true And 列名 is null")
If dr3 IsNot Nothing Then
e.cancel = True
Else
MainTable = Tables("查询表")
Forms(e.node.name).open()
End If
Next
End If
End Select
上述代码在客户端运行正常，但开发者在开发项目中点击目录树节点想调取报表出来的时候总提示错误，如何解决，采用自定义用户登录
此主题相关图片如下：qq图片20220116144722.png
-- 发布时间：2022/1/16 21:21:00
--
看4楼，请先调试定位到错误的代码
-- 发布时间：2022/2/10 21:23:00
--
Select Case e.node.Name
Case e.node.Name
Dim Filter As String
For Each dr8 As DataRow In DataTables("加载内容权限表").DataRows
If dr8("表名") = e.node.Name And dr8("制单人")=False And dr8.Isnull("列名")=False And User.IsRole(dr8("角色")) Then
Filter = dr8("列名") & " In ( \'" & dr8("列内容").replace(",","\',\'") & "\')"
ElseIf dr8("表名") = e.node.Name And dr8("制单人")=True And User.IsRole(dr8("角色")) Then
Filter = dr8("制单人列") & " = \'" & User.Name & "\'"
Else
Filter = ""
End If
Next
DataTables(e.node.Name).LoadFilter = Filter
DataTables(e.node.Name).Load()
当用户同时有多个角色，如用户同时具有“加载内容权限表”（下图）中的两个角色时，结果只加载了其中一个角色的内容，如何把不同角色的内容都加载进来呢
此主题相关图片如下：微信图片_20220210212142.png
[此贴子已经被作者于2022/2/10 21:24:00编辑过]
-- 发布时间：2022/2/10 21:36:00
--
For Each dr8 As DataRow In DataTables("加载内容权限表").DataRows
if Filter > "" then Filter = Filter & " or "
If dr8("表名") = e.node.Name And dr8("制单人")=False And dr8.Isnull("列名")=False And User.IsRole(dr8("角色")) Then
Filter = Filter & dr8("列名") & " In ( \'" & dr8("列内容").replace(",","\',\'") & "\')"
-- 发布时间：2022/2/10 22:38:00
--
还是解决不了，偿试各种调整都不行，明天再看看
-- 发布时间：2022/2/10 23:05:00
--
怎么改的代码，重新发上来看看。
最后弹出条件看看是否正确
msgbox(filter)
DataTables(e.node.Name).LoadFilter = Filter