Наполнение альтернативного TreeView данными

@Statheros · Регистрация: 24.08.2017

Студворк — интернет-сервис помощи студентам

Имеется таблица с полями dtKey, dtName, dtParent, dtLevel необходимо извлечь из нее данные для дерева.
Сложная для меня задача. В приложенном примере альтернативному TreeView (отсюда) данные в нескольких таблицах, а здесь в одной.
По аналогии с примером написал:

Кликните здесь для просмотра всего текста

Visual Basic
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
  'добавить узел Root с основными и расширенными значками и сделать его жирным
        Set cRoot = .AddRoot("Root", strCap, "FolderClosed", "FolderOpen")
        cRoot.Bold = True
        
        'Открыть набор записей  первого уровня
        Set dbs = CurrentDb
        strSQL = "SELECT dtKey, dtName, dtParent, dtLevel FROM " & strTmp & " ORDER BY dtKey"
        Set rst1 = dbs.OpenRecordset(strSQL, dbOpenForwardOnly)
        'перебрать первый уровень
        Do While rst1!dtlevel = 1
        i = i + 1
               'Добавить узел первого уровня
               strKey = rst1!dtKey & i
               strCaption = rst1!dtName
               Set cNode1 = cRoot.AddChild(strKey, strCaption, "Scroll", "OpenBook")
               
               'Открыть набор записей второго уровня
               strSQL = "SELECT dtKey, dtName, dtParent, dtLevel FROM " & strTmp & " WHERE dtKey = " & _
               rst1!dtKey & " ORDER BY dtKey"
               Set rst2 = dbs.OpenRecordset(strSQL, dbOpenForwardOnly)
 
               Do While rst2!dtlevel = 2
                       'Добавить узел второго уровня
                       strKey = rst2!dtKey & i
                       strCaption = rst2!dtName
                       Debug.Print rst2!dtName
                       Set cNode2 = cNode1.AddChild(strKey, strCaption, "Scroll", "OpenBook")
               
                       'Открыть набор записей третьего уровня
                       strSQL = "SELECT dtKey, dtName, dtParent, dtLevel FROM " & strTmp & " WHERE dtKey = " & _
                       rst2!dtKey & " ORDER BY dtKey"
                       Set rst3 = dbs.OpenRecordset(strSQL, dbOpenForwardOnly)
                       Do While rst3!dtlevel = 3
                              'Добавить узел третьего уровня
                              strKey = rst3!dtKey & i
                              strCaption = rst3!dtName
                              Set cNode3 = cNode2.AddChild(strKey, strCaption, "Scroll", "OpenBook")
                              
                              'Открыть набор записей четвертого уровня
                              strSQL = "SELECT dtKey, dtName, dtParent, dtLevel FROM " & strTmp & " WHERE dtKey = " & _
                              rst3!dtKey & " ORDER BY dtKey"
                              Set rst4 = dbs.OpenRecordset(strSQL, dbOpenForwardOnly)
                              Do While rst4!dtlevel = 4
                                      'Добавить узел четвертого уровня
                                      strKey = rst4!dtKey & i
                                      strCaption = rst4!dtName
                                      Set cNode4 = cNode3.AddChild(strKey, strCaption, "Scroll", "OpenBook")
                                      rst4.MoveNext
                              Loop
                              rst4.Close
                              rst3.MoveNext
                      Loop
                      rst3.Close
                      rst2.MoveNext
               Loop
               rst2.Close
               rst1.MoveNext
        Loop
        rst1.Close

Работает, но показывает только записи первого уровня. Помогите советом как быть с такой таблицей.
С ней еще одна проблема сейчас записи углубились на четвертый уровень. В будущем может еще ниже будет, а у меня только четыре уровня перебираются...
К сожалению слеп по невежеству. Наверное для многих все здесь просто. Ткните мне пальцем где накосячил, пожалуйста!

@Eugene-LS · 25.06.2019, 13:08

Сообщение от Statheros

Помогите советом как быть с такой таблицей.

Как быть с таблицей - не знаю ...

А если вы строите дерево в TreeView control, то обычно дочерние узлы добавляются рекурсивным вызовом процедуры добавления дочерних узлов относительно текущего.
полистайте:
https://yandex.ru/search/?clid... r=23&msp=1

@Statheros · 04.07.2019, 23:09 **[ТС]**

Доброго времени суток! Что-то никак не осилю рекурсию. Принцип ясен, темы по ссылкам просмотрел. Но как на основе приведенных там примеров пишу что-то сам, дальше первого уровня не ухожу. Что-то упускаю. Выкладываю кусок базы. Посмотрите, пожалуйста, что там не так.

@Statheros · 06.07.2019, 16:17 **[ТС]**

Вроде разобрался. Правда теперь другая беда. Перебираются все записи таблицы, но на записях последнего уровня возникает ошибка "Требуется объект", а его нет, уровень ведь последний. Может кто подскажет, что нужно. Условие написать какое-нибудь...

Выделил цветом строку, на которую Аксесс ругается.

Кликните здесь для просмотра всего текста

Visual Basic
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
Public Function Node_Add(ByVal idParent As Integer)
Dim strKey As String, strParent As String, strCaption As String
Dim cRoot, cNode, cExtraNode As clsNode
 
    'создайте новый clsTreeview, возвращенный с прикрепленным контейнером TreeControl
    Set mcTree = Me.subTreeView.Form.pTreeview
    
    With mcTree
        'Добавляем некоторые свойства дерева:
        '.NodesClear
        .AppName = strCap
 
        
        'выберем настройки из элементов управления флажка и счетчика на форме.
        .CheckBoxes = False
        .RootButton = True
        .FullWidth = True 'полная ширина
        .Indentation = 18 * 0.75
        .NodeHeight = 12 * 0.75
        .ShowLines = True
        .ShowExpanders = True ' использовать значки для кнопок свертывания / развертывания
 
'Теперь отфильтруем набор записей  по родительским узлам
Dim strF As String
strF = idParent
 
         'добавить узел Root с основными и расширенными значками и сделать его жирным
        Set cRoot = .AddRoot("Root", strCap, "FolderClosed", "FolderOpen")
        cRoot.Bold = True
 
 
        'Открываем набор записей
        strQTrw = "SELECT dtKey, dtName, dtParent, dtLevel FROM DefTree WHERE dtParent = " & strF & " ORDER BY dtKey"
        Set rstTrw = CurrentDb.OpenRecordset(strQTrw)
        
        Do While Not rstTrw.EOF
 
            
            strKey = rstTrw!dtKey
            strCaption = rstTrw!dtName
            
            'строим следующие уровни
            Call Node_Add(strKey)
            
          If strF = 0 Then
            'строим превый уровень
            Set cNode = cRoot.AddChild(strKey, strCaption, "Scroll", "OpenBook")
            Debug.Print strF, strKey
          Else
           [COLOR="Red"] Set cNode = cNode.AddChild(strKey, strCaption, "Scroll", "OpenBook")[/COLOR]
            Debug.Print strF, strKey
          End If
 
            'перейти к следующей записи
            rstTrw.MoveNext
        Loop
        'Закрыть  набор записей
        rstTrw.Close
              
        'очистить
        Set rstTrw = Nothing
        
        'создать элементы управления узла и отобразить дерево
        .Refresh
    End With
 
End Function

Новые блоги и статьи Все статьи Все блоги /
SDL3 для Web (WebAssembly): Загрузка PNG с прозрачным фоном с помощью SDL_LoadPNG (без SDL3_image) 8Observer8 11.02.2026 Содержание блога Библиотека SDL3 содержит встроенные инструменты для базовой работы с изображениями - без использования библиотеки SDL3_image. Пошагово создадим проект для загрузки изображения. . .	SDL3 для Web (WebAssembly): Загрузка PNG с прозрачным фоном с помощью SDL3_image 8Observer8 10.02.2026 Содержание блога Библиотека SDL3_image содержит инструменты для расширенной работы с изображениями. Пошагово создадим проект для загрузки изображения формата PNG с альфа-каналом (с прозрачным. . .	Установка Qt-версии Lazarus IDE в Debian Trixie Xfce volvo 10.02.2026 В общем, достали меня глюки IDE Лазаруса, собранной с использованием набора виджетов Gtk2 (конкретно: если набирать текст в редакторе и вызвать подсказку через Ctrl+Space, то после закрытия окошка. . .	SDL3 для Web (WebAssembly): Работа со звуком через SDL3_mixer 8Observer8 08.02.2026 Содержание блога Пошагово создадим проект для загрузки звукового файла и воспроизведения звука с помощью библиотеки SDL3_mixer. Звук будет воспроизводиться по клику мышки по холсту на Desktop и по. . .
SDL3 для Web (WebAssembly): Основы отладки веб-приложений на SDL3 по USB и Wi-Fi, запущенных в браузере мобильных устройств 8Observer8 07.02.2026 Содержание блога Браузер Chrome имеет средства для отладки мобильных веб-приложений по USB. В этой пошаговой инструкции ограничимся работой с консолью. Вывод в консоль - это часть процесса. . .	SDL3 для Web (WebAssembly): Обработчик клика мыши в браузере ПК и касания экрана в браузере на мобильном устройстве 8Observer8 02.02.2026 Содержание блога Для начала пошагово создадим рабочий пример для подготовки к экспериментам в браузере ПК и в браузере мобильного устройства. Потом напишем обработчик клика мыши и обработчик. . .	Философия технологии iceja 01.02.2026 На мой взгляд у человека в технических проектах остается роль генерального директора. Все остальное нейронки делают уже лучше человека. Они не могут нести предпринимательские риски, не могут. . .	SDL3 для Web (WebAssembly): Вывод текста со шрифтом TTF с помощью SDL3_ttf 8Observer8 01.02.2026 Содержание блога В этой пошаговой инструкции создадим с нуля веб-приложение, которое выводит текст в окне браузера. Запустим на Android на локальном сервере. Загрузим Release на бесплатный. . .