MyTetra Share
Делитесь знаниями!
TreeView - Класс по работе с элементом
16.03.2019
23:43
Раздел: !Закладки - VBA - Access - msa.polarcom.ru - 07 Элементы Управления

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




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

Так же в этом разделе:
 
MyTetra Share v.0.52
Яндекс индекс цитирования