TreeView - Класс по работе с элементом

По материалам: http://msa.dimsign.ru/

Работа с элементом ActiveX Treeview (деревом)
Иногда без этого элемента не обойтись. Здесь приведен класс по работе с этим элементом.

Собственно, класс. (Не путать с обычным модулем.) Назвать модуль класса можете, как хотите, главное не забыть потом правильно к нему обратиться в формах. У меня модуль класса назван "clsTreeClass".
Преимущество данного модуля, что он цепляется на любую таблицу, если она содержит хотя бы три поля (ключ, название, код родителя).

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

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) = 0 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 "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

Теперь в самой форме, где добавлен элемент, в загрузку поместим инициализацию класса. Еще добавим невидимое поле, в которое будем пихать текущий код элемента в дереве.

Private Sub Form_Load()

Set tr = New clsTreeClass

Set tr.Tree = Me.TrView.Object

tr.Tbl = "baseCats"

tr.fldKey = "idCat"

tr.fldParent = "idParentCat"

tr.fldText = "nmCat"

tr.GenerateTree

End Sub

Private Sub TrView_Click()

Me.Key = tr.GetKey

End Sub

Здесь присутствует необходимый минимум. Думается, сделать остальное будет уже не так сложно.