TreeView

@radlif · Регистрация: 18.12.2011

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

Народ кто шарит выручайте

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

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
Private Function tvwadd(a)
    Dim TheFolder As Folder
    Dim f As Scripting.File
    Dim fso As New FileSystemObject
    Dim MoreFolders, TempFolder
    Set TheFolder = fso.GetFolder(a) 'с какого каталога пойдем
    'On Local Error Resume Next
    ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
    'поиск файлов в данном каталоге.
    For Each f In TheFolder.Files
        If f.Name Like "*.htm" Then
            tvwTree.Nodes.Add TheFolder.Path, tvwChild, f.Path, f.Name, CS_UNCHECKED
        End If
    Next f
    ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
    'Поиск вложеных папок.
    Set MoreFolders = TheFolder.SubFolders
    For Each TempFolder In MoreFolders
        If Not CBool(TempFolder.Attributes And (Hidden Or System)) Then
            tvwadd2 TempFolder
        End If
    Next
    '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
End Function
 
Private Function tvwadd2(a)
    Dim MoreFolders, TempFolder
    Dim f As Scripting.File
    'On Local Error Resume Next
    Set MoreFolders = a.SubFolders
    'поиск вложеных папок 2 уровня
    For Each TempFolder In MoreFolders
        'добавляем узел к TreeView
        If Not CBool(TempFolder.Attributes And (Hidden Or System)) Then
            tvwTree.Nodes.Add a.Path, tvwChild, TempFolder.Path, TempFolder.Name, CS_UNCHECKED
        End If
        '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
        'Проверка на наличие файлов в папках 2 уровня
        For Each f In TempFolder.Files
            'если фаил есть добавляем узел
            If f.Name Like "*.htm" Then
                tvwTree.Nodes.Add TempFolder.Path, tvwChild, f.Path, f.Name, CS_UNCHECKED
                Debug.Print f.Path
            End If
        Next f
        ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
    Next
End Function

Первая функция принимает папку и проверяет в ней наличие файлов и заносит найденные файлы в TreeView,
после в цикле находит дочерние папки и передаёт их 2 функции чтоб ещё 1 раз найти дочерние папки и
занести их в TreeView, так же проверяет во всех папках наличие файлов и если есть добавляет их в TreeView
чтоб возле папок был узел.
Но почему то вылазит ошибка если в папке только файлы.

@radlif · 16.09.2013, 14:39 **[ТС]**

Забыл добавить ошибка вылазит в первой функции где добавляем файлы в TreeView

Добавлено через 56 минут
Стоп советы, разобрался

Dragokas · 16.09.2013, 16:55

А чем проблема была?

@radlif · 16.09.2013, 23:11 **[ТС]**

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

А чем проблема была?

У меня 4 функции первые 2 открывают диск и считывают папки на 2 уровня от корня,
в первой ещё до цикла сам корень создаётся с буквой диска, во 2 уже обрабатывается 2 уровень.
Вторые 2 функции похожие только принимают адрес узла раскрываемой папки и так же проставляют
узлы на 2 уровня в глубь.
Достаточно было цикл по поиску файлов перенести в 1 2 функции и ошибка пропала.
Хотелось бы чтоб вместо 4 всего 2 функции было так как они похожи, но задолбался с ошибками
TreeView бороться, капризный шибко контрол

@radlif · 18.09.2013, 09:32 **[ТС]**

Опять я в этой теме

Проблема такая, когда раскрываю узел срабатывает функция поиска файлов и папок
и заносит найденное в TreeView, если после этого закрыть узел и раскрыть заново
вылазит ошибка что данный узел уже создан.
Как можно проверить наличие узла с такими же данными перед его созданием?
Глушить ошибку с помощью

Visual Basic
1
On Local Error Resume Next

по моему не вариант совсем

Если можно без циклов, у меня их и так многовато))

@The trick · 18.09.2013, 10:03

1. Можно удалить при схлопывании и это будет правильней, т.к. если какие-то папки удалиись, то их не будет в дереве.
2. Проверять название узла и папки/файла
3. У узла есть свойство Tag заноси в него что хочешь и проверяй его

@radlif · 18.09.2013, 10:49 **[ТС]**

3 вариант подошёл, первый не подойдёт так как расставив галочки я буду сворачивать дерево, так удобнее
с 2 я часа 2 промучился так и не поняв как реализовать, 3 само то

Добавлено через 7 минут
При этом если интересно будет реализовал всё в 3 функции.

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
68
69
70
71
72
73
74
75
76
77
'Принимает букву диска в формате C:\
Private Function tvwvid(a)
    Dim f As Scripting.File
    Dim TheFolder As Folder
    Dim fso As New FileSystemObject
    Dim TempFolder
    'On Local Error Resume Next
    Set TheFolder = fso.GetFolder(a)  'ñ êàêîãî êàòàëîãà ïîéäåì
    Dim kk As Integer
    
    For Each f In TheFolder.Files
        kk = (f.Attributes And (Hidden Or System)) Or (f.Name = vbNullString)
        If (kk = 0) Or (kk = -1) Then
            If f.Name Like "*.htm" Then
                TreeView1.Nodes.Add(TheFolder.Path, tvwChild, f.Path, f.Name, CS_UNCHECKED).ForeColor = RGB(0, 0, 255)
            End If
        End If
    Next f
    For Each TempFolder In TheFolder.SubFolders
        kk = (TempFolder.Attributes And (Hidden Or System)) Or (TempFolder.Name = vbNullString)
        If (kk = 0) Or (kk = -1) Then
            TreeView1.Nodes.Add TheFolder.Path, tvwChild, TempFolder.Path, TempFolder.Name, CS_UNCHECKED
            TreeView1.Nodes.Item(TempFolder.Path).Tag = 1
            tvwvid2 (TempFolder)
        End If
    Next
    
End Function
'Обрабатывает папки до 2 уровня для узлов
Private Function tvwvid2(a)
    Dim f As Scripting.File
    Dim TheFolder As Folder
    Dim fso As New FileSystemObject
    Dim TempFolder
    'On Local Error Resume Next
    Set TheFolder = fso.GetFolder(a)  'ñ êàêîãî êàòàëîãà ïîéäåì
    Dim kk As Integer
    
    For Each f In TheFolder.Files
        kk = (f.Attributes And (Hidden Or System)) Or (f.Name = vbNullString)
        If (kk = 0) Or (kk = -1) Then
            If f.Name Like "*.htm" Then
                TreeView1.Nodes.Add(TheFolder.Path, tvwChild, f.Path, f.Name, CS_UNCHECKED).ForeColor = RGB(0, 0, 255)
            End If
        End If
    Next f
    For Each TempFolder In TheFolder.SubFolders
        kk = (TempFolder.Attributes And (Hidden Or System)) Or (TempFolder.Name = vbNullString)
        If (kk = 0) Or (kk = -1) Then
            TreeView1.Nodes.Add TheFolder.Path, tvwChild, TempFolder.Path, TempFolder.Name, CS_UNCHECKED
            TreeView1.Nodes.Item(TempFolder.Path).Tag = 1
        End If
    Next
    
End Function
'принимает ключ раскрываемого узла и обрабатывает на 2 уровня
Private Function tvwvid3(a)
    Dim TheFolder As Folder
    Dim fso As New FileSystemObject
    Dim TempFolder
    Dim kk As Integer
    'On Local Error Resume Next
    Set TheFolder = fso.GetFolder(a)  'ñ êàêîãî êàòàëîãà ïîéäåì
    For Each TempFolder In TheFolder.SubFolders
        kk = (TempFolder.Attributes And (Hidden Or System)) Or (TempFolder.Name = vbNullString)
        If (kk = 0) Or (kk = -1) Then
            If TreeView1.Nodes.Item(TempFolder.Path).Tag = 1 Then
                TreeView1.Nodes.Item(TempFolder.Path).Tag = 2
                tvwvid2 TempFolder
            End If
        End If
    Next
End Function
 
Private Sub TreeView1_Expand(ByVal zx As Node)
    tvwvid3 (zx.Key)
End Sub

Главный узел и буква диска задаются в другой функции.
Критика приветствуется

Добавлено через 7 минут
Строка 24 значение Tag замените на 2 тогда не будет ошибки при сворачивание и разворачивание главного узла)

Новые блоги и статьи Все статьи Все блоги /
Перемещение выделенных строк ТЧ из одного документа в другой Maks 30.03.2026 Реализация из решения ниже выполнена на примере нетипового документа "ВыдачаОборудованияНаСпецтехнику" с единственной табличной частью "ОборудованиеИКомплектующие" разработанного в конфигурации КА2. . . .	Functional First Web Framework Suave DevAlt 30.03.2026 Sauve. IO Апнулись до NET10. Из зависимостей один пакет, работает одинаково хорошо как в режиме проекта так и в интерактивном режиме. из сложностей - чисто функциональный подход. Решил. . .	Автоматическое создание документа при проведении другого документа Maks 29.03.2026 Реализация из решения ниже выполнена на нетиповых документах, разработанных в конфигурации КА2. Есть нетиповой документ "ЗаявкаНаРемонтСпецтехники" и нетиповой документ "ПланированиеСпецтехники". В. . .	Настройка движения справочника по регистру сведений Maks 29.03.2026 Решение ниже реализовано на примере нетипового справочника "ТарифыМобильнойСвязи" разработанного в конфигурации КА2, с целью учета корпоративной мобильной связи в коммерческом предприятии. . . .
Автозаполнение реквизита при выборе элемента справочника Maks 27.03.2026 Программный код из решения ниже на примере нетипового документа "ЗаявкаНаРемонтСпецтехники" разработанного в конфигурации КА2. При выборе "Спецтехники" (Тип Справочник. Спецтехника), заполняется. . .	Сумматор с применением элементов трёх состояний. Hrethgir 26.03.2026 Тут. https:/ / fips. ru/ EGD/ ab3c85c8-836d-4866-871b-c2f0c5d77fbc Первый документ красиво выглядит, но без схемы. Это конечно не даёт никаких плюсов автору, но тем не менее. . . всё может быть. . .	Автозаполнение реквизитов при создании документа Maks 26.03.2026 Программный код из решения ниже размещается в модуле объекта документа, в процедуре "ПриСозданииНаСервере". Алгоритм проверки заполнения реализован для исключения перезаписи значения реквизита,. . .	Команды формы и диалоговое окно Maks 26.03.2026 1. Команда формы "ЗаполнитьЗапчасти". Программный код из решения ниже на примере нетипового документа "ЗаявкаНаРемонтСпецтехники" разработанного в конфигурации КА2. В качестве источника данных. . .

@radlif 44 / 44 / 3 Регистрация: 18.12.2011 Сообщений: 577
	16.09.2013, 14:39 [ТС]
	Забыл добавить ошибка вылазит в первой функции где добавляем файлы в TreeView Добавлено через 56 минут Стоп советы, разобрался 0

Dragokas 18033 / 7736 / 892 Регистрация: 25.12.2011 Сообщений: 11,502 Записей в блоге: 16
	16.09.2013, 16:55
	А чем проблема была? 0

@The trick Модератор 10057 / 3902 / 884 Регистрация: 22.02.2013 Сообщений: 5,853 Записей в блоге: 79
	18.09.2013, 10:03
	1. Можно удалить при схлопывании и это будет правильней, т.к. если какие-то папки удалиись, то их не будет в дереве. 2. Проверять название узла и папки/файла 3. У узла есть свойство Tag заноси в него что хочешь и проверяй его 1