SELECT * FROM Vzakladke.net

Статьи об автоматизации и программировании

Генерация дерева элементов в иерархическом представлении в MS Access через компонент TreeView

 

 

ActiveX компонент TreeView в MS Access служит для отображения сложных данных, отображающихся в виде списка или дерева. Уровень вложенности элементов дерева не ограничен. Для работы с этим компонентом нужно подключить ссылку (References) на Microsoft Windows Common Controls 6.0 (SP6).

Для работы с деревом потребуется создать таблицу например с именем Table1. В ней укажем поля - AutoID, Name, ParentID. Пусть будет для удобства автоинкрементное поле AutoID (это необязательно, но тогда придется его вводить вручную соблюдая уникальность значений по этому столбцу). Скрипт, который позволит Вам быстро создать таблицу для примера в MS Access:

CREATE TABLE Table1 
(
 AutoID AUTOINCREMENT  PRIMARY KEY,
 Name TEXT,
 ParentID INTEGER
)
 

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


Option Compare Database
' Объявляем класс Tree с событиями
Public WithEvents Tree As TreeView
Public tbl As String
Public fldParent As String
Public fldKey As String
Public fldText As String
Public createKey As Long

Const Start As String = "0"  ' "0" - это значение ParentID, от которого будет строится дерево. 
 '  Допускается, что в таблице будет несколько таких значений, от которых построятся разные ветки
 '  Как видно, мы запросто ему можем присвоить текстовое значение

Private Sub Class_Initialize()
'Инициализируем переменные класса для работы с таблицей
'Tbl = "Tbl"
'fldParent = "Parent"
'fldKey = "Key"
'fldText = "Text"
End Sub

' События при управлении левой кнопкой мыши
Private Sub Tree_Click()
'    MsgBox Tree.SelectedItem.Key
End Sub

'Добавление основного узла
Public Sub AddBaseNode(Key As String, Text As String)
    idx = Tree.Nodes.Add(, , Key).Index
    With Tree.Nodes(idx)
        .Text = Text
    End With
End Sub

'Добавление дочернего узла
Public Sub AddNode(Parent As String, Key As String, Text As String)
    idx = Tree.Nodes.Add(Parent, tvwChild, Key).Index
    With Tree.Nodes(idx)
        .Text = Text
    End With
End Sub

'Очистка дерева
Public Sub ClearNode()
    Tree.Nodes.Clear
End Sub

Public Sub GenerateRecursive(Parent As String)
Dim r As DAO.Recordset
Dim Key As String
Dim Par As String
Dim Text As String
'========================================================================'
'                РЕКУРСИВНАЯ ГЕНЕРАЦИЯ ДЕРЕВА                    '
'========================================================================'
Set r = CurrentDb.OpenRecordset("SELECT * FROM " & tbl & _
    " WHERE " & fldParent & "='" & Parent & "';", dbOpenDynaset)
If r.EOF And r.BOF Then
Else
    r.MoveFirst
    While Not r.EOF
        Key = "key" & r.Fields(fldKey)
        Par = "key" & r.Fields(fldParent)
        Text = r.Fields(fldText)
        If r.Fields(fldParent) = Start Then
            AddBaseNode Key, Text
        Else
            AddNode Par, Key, Text
        End If
        GenerateRecursive r.Fields(fldKey)
        r.MoveNext
    Wend
End If
'========================================================================
r.Close
Set r = Nothing
End Sub

'Генерация дерева из таблицы
Public Sub GenerateTree()
Dim r As DAO.Recordset
Dim Key As String
Dim Par As String
Dim Text As String

ClearNode

GenerateRecursive Start ' "0"

End Sub

'Получить код элемента
Public Function GetKey() As Long
    GetKey = DelKeyStr(Tree.SelectedItem.Key)
End Function

'Удалить префикс
Private Function DelKeyStr(Text As String) As Long
Dim stroka As String
    stroka = Right(Text, Len(Text) - 3)
DelKeyStr = CLng(stroka)
End Function

'Добавить ветку
Public Sub AddTblNode(Parent As String, Text As String)
Dim Key As String
Dim Par As String
Dim LastId As Long

CurrentDb.Execute "INSERT INTO " & tbl & " ( [" & fldText & "], " & fldParent & _
" ) SELECT """ & Text & """ AS Txt, " & DelKeyStr(Parent) & " AS Prn;"
LastId = DMax(fldKey, tbl, "")

createKey = LastId
Key = "key" & LastId
If DelKeyStr(Parent) = 0 Then
    AddBaseNode Key, Text
Else
    AddNode Parent, Key, Text
End If
End Sub

'Обновить ветку
Public Sub UpdateTblNode(Key As String, UpdText As String)
CurrentDb.Execute "UPDATE " & tbl & " SET " & fldText & "=""" & UpdText & """ WHERE " & fldKey & "=" & _
DelKeyStr(Key) & ";"
Tree.Nodes.Item(Key).Text = UpdText
End Sub

'Удалить ветку
Public Sub DelTblNode(Key As String)
CurrentDb.Execute "DELETE * FROM " & tbl & " WHERE " & fldKey & "=" & _
DelKeyStr(Key) & ";"
Tree.Nodes.Remove Key
End Sub

'Рекурсивное удаление ветки (если есть дочерние и внучатые ветки)
Public Sub RecursiveDelTblNode(Key As String)
Dim r As Recordset

Set r = CurrentDb.OpenRecordset("SELECT * FROM " & tbl & _
    " WHERE " & fldParent & "=" & DelKeyStr(Key) & ";", dbOpenDynaset)
If r.EOF And r.BOF Then
    CurrentDb.Execute "DELETE * FROM " & tbl & " WHERE " & _
        fldKey & "=" & DelKeyStr(Key) & ";"
    Tree.Nodes.Remove Key
Else
    r.MoveFirst
    While Not r.EOF
        RecursiveDelTblNode "key" & r.Fields(fldKey)
        r.MoveNext
    Wend
    CurrentDb.Execute "DELETE * FROM " & tbl & " WHERE " & _
        fldKey & "=" & DelKeyStr(Key) & ";"
    Tree.Nodes.Remove Key
End If

r.Close
Set r = Nothing
End Sub

 

В самой форме, где добавлен компонент TreeView, мы в загрузку помещаем объект с ссылкой на наш класс и инициализируем наши переменные:

Private Sub Form_Load()

 Dim tr As Object
 Set tr = New cTreeClass
 Set tr.Tree = Me.xTree.Object
 tr.tbl = "Table1"
 tr.fldKey = "AutoID"
 tr.fldParent = "ParentID"
 tr.fldText = "Name"  

 tr.GenerateTree

End Sub

 


Чтобы назначить обработчик на дерево нужно будет написать такой код:

Private Sub TrView_Click()
 MsgBox Me.xTree.SelectedItem.Key
End Sub

При нажатии на любой элемент в списке мы получим сообщение с номером присвоенного ключа. 

 

 

 

Дата публикации: 2015-06-11 21:05:54

MS Access, VBA

0

Отзывы:

Влад
Попробовал воспользоваться. Не работает. Несоответствие типов в Private Sub Form_Load() Dim tr As Object Set tr = New cTreeClass *Set tr.Tree = Me.xTree.Object* tr.tbl = "Table1" tr.fldKey = "AutoID" tr.fldParent = "ParentID" tr.fldText = "Name" tr.GenerateTree End Sub
Димон
Потому что класс надо назвать cTreeClass а не Class1 как по умолчанию
Димон
И не забудь что ParentID у корневого элемента должен быть равен 0. Дерево по умолчанию будет свернутым. Можно его сразу раскрыть: Dim nodThis As MSComctlLib.Node For Each nodThis In Me.xTree.Nodes ' loop through all nodes nodThis.Expanded = True Next nodThis With Me.xTree .selecteditem.EnsureVisible .SetFocus End With
Evgeniy
Добрый день ! На строке *Set tr.Tree = Me.xTree.Object* выдает сообщение: "Object doesn't support this property or method"
Диман
А компонент MSComctlLib добавили: C:\Windows\System32\MSCOMCTL.OCX или C:\Windows\SysWOW64\MSCOMCTL.OCX (для 64-х разрядной ОС) ?
Леша Умный
Иногда нужно сбросить счетчик: ALTER TABLE Table1 ALTER COLUMN AutoID COUNTER (1, 1)

Ваше имя:

Ваш e-mail (необязательно):

Сообщение:

Captcha