Option Compare Database
Option Explicit

Public SourceObject
Public NodeKey

Public Function LoadTree()

    Dim rs1 As ADODB.Recordset, rs2 As ADODB.Recordset, rs3 As ADODB.Recordset
    Dim nodeFirst As node, node1 As node, node2 As node, node3 As node
    
    Me.treeCtl.Nodes.Clear
    Set nodeFirst = Me.treeCtl.Nodes.Add( _
        Key:="ROOT", _
        Text:="Все типы вложений" _
    )
    Set rs1 = CurrentProject.Connection.Execute( _
        "SELECT * " & _
        "FROM TBD_AttachmentType " & _
        "ORDER BY iAttachmentTypeNomer ")
    Do While Not rs1.EOF
        Set node1 = Me.treeCtl.Nodes.Add( _
            relative:=nodeFirst.index, relationship:=tvwChild, _
            Key:="L1" & rs1!sAttachmentTypeCode, Text:=rs1!sAttachmentTypeCode & " " & rs1!sAttachmentTypeName _
        )
        Set rs2 = CurrentProject.Connection.Execute( _
            "SELECT * " & _
            "FROM TBD_AttachmentDocType " & _
            "WHERE sAttachmentTypeCode='" & rs1!sAttachmentTypeCode & "'" & _
            "ORDER BY iAttachmentDocTypeNomer ")
        Do While Not rs2.EOF
            Set node2 = Me.treeCtl.Nodes.Add( _
                relative:=node1.index, relationship:=tvwChild, _
                Key:="L2" & rs2!sAttachmentDocTypeCode, Text:=rs2!sAttachmentDocTypeCode & " " & rs2!sAttachmentDocTypeName _
            )
            Set rs3 = CurrentProject.Connection.Execute( _
                "SELECT * " & _
                "FROM qrAttachmentDocBase " & _
                "WHERE sAttachmentDocTypeCode='" & rs2!sAttachmentDocTypeCode & "'" & _
                "ORDER BY dtAttachmentDocDate, iAttachmentDocID ")
            Do While Not rs3.EOF
                Set node3 = Me.treeCtl.Nodes.Add( _
                    relative:=node2.index, relationship:=tvwChild, _
                    Key:="L3" & rs3!iAttachmentDocID, Text:=rs3!sDataSourceIDFieldValue & " " & rs3!sDataSourceAliasFieldValue _
                )
                rs3.MoveNext
            Loop
            rs2.MoveNext
        Loop
        rs1.MoveNext
    Loop
    
End Function

Private Sub form_Load()

    SourceObject = ""
    NodeKey = ""
    
    Call Me.LoadTree
    
    With Me.treeCtl
        .style =  7 
        .Indentation =  300 
        .LineStyle =  1 
        .Visible = True
        .SetFocus
        .OLEDragMode =  1  ' ccOLEDragAutomatic
        .OLEDropMode = 1 ' ccOLEDropManual
    End With
    
    Dim n  As node
    Set n = Me.treeCtl.Nodes("ROOT")
    n.Expanded = True
    n.Selected = True
    NodeClick n, True
    
End Sub

Private Sub treeCtl_NodeClick(ByVal oNode As Object)

    NodeClick oNode, True

End Sub

Public Function SubOnOff(bVisible As Boolean)

    Me.subForm.Visible = bVisible: Me.boxSub.Visible = (Not bVisible)
    Me.Repaint: Me.Painting = bVisible
    DoCmd.Hourglass (Not bVisible)
                    
End Function

Public Function NodeClick(n As node, Optional bVisualEffect As Boolean = True)

    SubOnOff False
    If Not n Is Nothing Then
        NodeKey = n.Key
        Dim s As String, ss() As String
        s = n.FullPath
        ss = Split(s, "\")
        Select Case UBound(ss)
        Case  0 
            If n.Key = "ROOT" Then
                If SourceObject <> "subForm0" Then
                    SourceObject = "subForm0"
                    Me.subForm.SourceObject = Me.Name & "_subForm0"
                    With Me.lblSub
                        .Visible = True
                        .Caption = "Все типы вложений"
                    End With
                End If
                Me.subForm.Form.RecordSource = _
                    "SELECT * " & _
                    "FROM TBD_AttachmentType " & _
                    "ORDER BY iAttachmentTypeNomer "
            End If
        Case  1 
            If SourceObject <> "subForm1" Then
                SourceObject = "subForm1"
                Me.subForm.SourceObject = Me.Name & "_subForm1"
                With Me.lblSub
                    .Visible = True
                    .Caption = "Данные типа вложений"
                End With
            End If
            Me.subForm.Form.RecordSource = _
                    "SELECT * " & _
                    "FROM TBD_AttachmentType " & _
                    "WHERE sAttachmentTypeCode='" & Mid(n.Key, 3) & "' " & _
                    "ORDER BY iAttachmentTypeNomer "
            Me.subForm.Form.ResizeForm Me.subForm.Height -  30 , Me.subForm.Width -  30 
        Case  2 
            If SourceObject <> "subForm2" Then
                SourceObject = "subForm2"
                Me.subForm.SourceObject = Me.Name & "_subForm2"
                With Me.lblSub
                    .Visible = True
                    .Caption = "Данные типа вложенных документов"
                End With
            End If
            Me.subForm.Form.RecordSource = _
                "SELECT * " & _
                "FROM TBD_AttachmentDocType " & _
                "WHERE sAttachmentDocTypeCode='" & Mid(n.Key, 3) & "' " & _
                "ORDER BY iAttachmentDocTypeNomer"
            Me.subForm.Form.ResizeForm Me.subForm.Height -  30 , Me.subForm.Width -  30 
        Case  3 
            Me.iAttachmentDocID = Mid(n.Key,  3 )
            If SourceObject <> "subForm3" Then
                SourceObject = "subForm3"
                Me.subForm.SourceObject = "frmAttachmentDoc"
                With Me.lblSub
                    .Visible = True
                    .Caption = "Данные вложенного документа"
                End With
            End If
            Me.subForm.Form.RecordSource = _
                "SELECT * " & _
                "FROM qrAttachmentDoc " & _
                "WHERE iAttachmentDocID=" & Mid(n.Key,  3 ) & " " & _
                "ORDER BY iAttachmentDocTypeNomer"
            Me.subForm.Form.ResizeForm Me.subForm.Height -  30 , Me.subForm.Width -  30 
        End Select
    Else
        NodeKey = ""
    End If
    If Me.subForm.SourceObject <> "" Then
        Dim b As Boolean: b = modUser.IsSuperUser()
        With Me.subForm.Form
            .AllowAdditions = b
            .AllowDeletions = b
            .AllowEdits = b
        End With
    End If
    SubOnOff True

End Function

Private Sub btnExpandAll_Click()

    Dim n As node
    For Each n In Me.treeCtl.Nodes
        n.Expanded = True
    Next n
    Me.treeCtl.SetFocus

End Sub

Private Sub btnCollapseAll_Click()

    Dim n As node
    For Each n In Me.treeCtl.Nodes
        If Left(n.Key,  4 ) = "ROOT" Then
            n.Expanded = True
        Else
            n.Expanded = False
        End If
    Next n
    Me.treeCtl.SetFocus

End Sub

Private Sub btnRequery_Click()

    If Me.NodeKey <> "" Then
        LoadTree
        Dim n As node
        Set n = Me.treeCtl.Nodes(NodeKey)
        n.EnsureVisible
        n.Selected = True
        NodeClick Me.treeCtl.Nodes(NodeKey)
        Me.treeCtl.SetFocus
    End If

End Sub

Private Sub btnOpenDocClassForm_Click()

    DoCmd.OpenForm "frmDocClass", acNormal, , , acFormEdit, acWindowNormal
    Me.treeCtl.SetFocus

End Sub

Private Sub btnOpenDatasourceForm_Click()

    DoCmd.OpenForm "frmMETA_Datasource", acNormal, , , acFormEdit, acWindowNormal
    Me.treeCtl.SetFocus

End Sub

Private Sub Form_Resize()

    On Error Resume Next
    Me.Painting = False
    Dim w
    With Me!btnExpandAll
        .Left =  100 : .Top =  100 
    End With
    With Me!btnCollapseAll
        .Left = Me!btnExpandAll.Left + Me!btnExpandAll.Width
        .Top = Me!btnExpandAll.Top
    End With
    With Me!btnRequery
        .Left = Me!btnCollapseAll.Left + Me!btnCollapseAll.Width +  100 
        .Top = Me!btnCollapseAll.Top
    End With
    With Me.btnOpenDocClassForm
        .Left = Me!btnRequery.Left + Me!btnRequery.Width +  100 
        .Top = Me!btnRequery.Top
    End With
    With Me.btnOpenDatasourceForm
        .Left = Me!btnOpenDocClassForm.Left + Me!btnOpenDocClassForm.Width +  100 
        .Top = Me!btnOpenDocClassForm.Top
    End With
    With Me.lblTree
        .Left = Me!btnExpandAll.Left
        .Top = Me!btnExpandAll.Top + Me!btnExpandAll.Height +  100 
        w = Me.InsideWidth *  0 . 35 
        If w >  5000  Then w =  5000 
        If w <  2000  Then w =  2000 
        .Width = w
    End With
    With Me.treeCtl
        .Left = Me.lblTree.Left
        .Top = Me.lblTree.Top + Me.lblTree.Height
        .Width = Me.lblTree.Width +  15 
        Dim h: h = Me.InsideHeight - .Top -  60 
        If h <  1000  Then h =  1000 
        .Height = h
    End With
    With Me.lblSub
        .Left = Me.lblTree.Left + Me.lblTree.Width +  100 
        .Top = Me.lblTree.Top
        w = Me.InsideWidth - .Left -  60 
        If w <  1000  Then w =  1000 
        .Width = w
    End With
    With Me.subForm
        .Left = Me.lblSub.Left
        .Top = Me.lblSub.Top + Me.lblSub.Height
        .Width = Me.lblSub.Width
        .Height = Me.treeCtl.Height -  15 
    End With
    
    On Error Resume Next
    Me.subForm.Form.ResizeForm Me.subForm.Height -  30 , Me.subForm.Width -  30 
    On Error GoTo  0 

    With Me.treeCtl
        Me.boxTree.Move .Left, .Top, .Width, .Height
    End With
    With Me.subForm
        Me.boxSub.Move .Left, .Top, .Width, .Height
    End With
    Me.Painting = True

End Sub