Hierarchical Data, Recursion, Tree-Views, and a Custom Class to Assist

[dgreen]

I'm am waiting in anticipation. This sounds promising.

 

[dgreen]

If I get time I will test tonight. From what I have read it appears you can load the imagelist at runtime. So I will try that.

Downloaded the file to another computer and the right click works correctly. Not sure how I'm going to isolate what's different in order to fix it.

 

[MajP]

This dynamically loads the images from the folder at runtime.
For the demo purpose I used a folder in the same folder as the application called "Bitmaps". FYI, previously I had to get new bitmaps the ones you provided for some reason would not load. In an application you would probably want a system setting in some table to allow the user to browse and store the default path.

  Dim path As String
  Dim file As String
  Dim PathAndFile As String
  Dim oFile As Variant
  Dim oFiles As Collection
  path = CurrentProject.path & "\" & "bitmaps"
  Set oFiles = AllFiles(path)
  For Each oFile In oFiles
    PathAndFile = path & "\" & oFile
    Me.imageListNodes.listimages.Add , Replace(oFile, ".bmp", ""), LoadPicture(PathAndFile)
    'Debug.Print Me.imageListNodes.listimages.Count
    'Debug.Print PathAndFile
  Next oFile

End Sub
Public Function AllFiles(ByVal FullPath As String) _
  As Collection
'***************************************************
'PURPOSE: Returns all files in a folder using
'the FileSystemObject

'PARAMETER: FullPath = FullPath to folder for
'which you want all files

'************************************************

Dim oFs As New FileSystemObject
Dim sAns As New Collection
Dim oFolder As Folder
Dim oFile As file
Dim lElement As Long

If oFs.FolderExists(FullPath) Then
    Set oFolder = oFs.GetFolder(FullPath)

    For Each oFile In oFolder.Files
      If Right(oFile.Name, 4) = ".bmp" Then
        sAns.Add oFile.Name
      End If
   Next
End If
'Debug.Print sAns.Count
Set AllFiles = sAns
ErrHandler:
    Set oFs = Nothing
    Set oFolder = Nothing
    Set oFile = Nothing
End Function

 

[dgreen]

I'll check it out tmrw am

 

[gemma-the-husky]

shouldn't this be in code samples, say?

 

[dgreen]

Once we get the product to a cleaned up state, then I'd recommend yes. We're close on a beta product but still have to remove the extra tables, queries and comment the vba code.

shouldn't this be in code samples, say?

 

[gemma-the-husky]

I love recursion. One problem with vba is that there is no true pointer data type which makes it hard to represent recursive objects.
It's pretty elegant, for example, to walk a family tree with a handful of lines of code.

fwiw, I constructed a program to play draughts/checkers using a recursive minimax algorithm as my final year degree project. Very educational, if not ever so fast.

 

[dgreen]

Do you have any recommendations on the code that we've been working through and posting on this thread?

I love recursion. One problem with vba is that there is no true pointer data type which makes it hard to represent recursive objects.
It's pretty elegant, for example, to walk a family tree with a handful of lines of code.

fwiw, I constructed a program to play draughts/checkers using a recursive minimax algorithm as my final year degree project. Very educational, if not ever so fast.

 

[dgreen]

It works. I love the dynamic nature it uses to find the picture vice having to load them into the database and tag them individually.

I also tested if you changed a file name, would the code pick up a new picture, when you reopened the treeview form. It worked.
Also, if the nodes picture didn't exist in the folder, what would happen.... you get a blank space before the text and a message saying the value couldn't be located. Seemed reasonable.

This dynamically loads the images from the folder at runtime.
For the demo purpose I used a folder in the same folder as the application called "Bitmaps". FYI, previously I had to get new bitmaps the ones you provided for some reason would not load. In an application you would probably want a system setting in some table to allow the user to browse and store the default path.

  Dim path As String
  Dim file As String
  Dim PathAndFile As String
  Dim oFile As Variant
  Dim oFiles As Collection
  path = CurrentProject.path & "\" & "bitmaps"
  Set oFiles = AllFiles(path)
  For Each oFile In oFiles
    PathAndFile = path & "\" & oFile
    Me.imageListNodes.listimages.Add , Replace(oFile, ".bmp", ""), LoadPicture(PathAndFile)
    'Debug.Print Me.imageListNodes.listimages.Count
    'Debug.Print PathAndFile
  Next oFile
 
End Sub
Public Function AllFiles(ByVal FullPath As String) _
  As Collection
'***************************************************
'PURPOSE: Returns all files in a folder using
'the FileSystemObject

'PARAMETER: FullPath = FullPath to folder for
'which you want all files

'************************************************

Dim oFs As New FileSystemObject
Dim sAns As New Collection
Dim oFolder As Folder
Dim oFile As file
Dim lElement As Long

If oFs.FolderExists(FullPath) Then
    Set oFolder = oFs.GetFolder(FullPath)
 
    For Each oFile In oFolder.Files
      If Right(oFile.Name, 4) = ".bmp" Then
        sAns.Add oFile.Name
      End If
   Next
End If
'Debug.Print sAns.Count
Set AllFiles = sAns
ErrHandler:
    Set oFs = Nothing
    Set oFolder = Nothing
    Set oFile = Nothing
End Function

 

[dgreen]

Our dummy dataset is definitely not my full data load. I also would want to ensure that this loads, updates and refreshes as quickly as possible. Looking forward to seeing how you figure out this option.

 

[gemma-the-husky]

Some years ago, I posted an xml file tree walker previously in the sample databases area. It iterates an xml file, and exports the structure to a table.

It basically walks the xml tree using the msxml dom document model, and extracts all the different nodes it finds with their position in the tree, assuming that the xml file is properly structured - ie consists of n instances of a repeating structure. The library includes a function to check that the file is indeed a valid xml file.

This analysis formed the basis of a system I developed to collect and analyse EDI files into a linear format for subsequent processing.


The biggest problem I found was that vba doesn't give you a pointer type, so you can't simply define a new object as a pointer to a structure, and build a dynamic linked structure in memory. Some said you can, but I just can't get it. With pointers you can simply create a new instance of a record on the heap (or is it stack), and link it into the appropriate order in the of the structure by manipulating the pointers of the previous and next records at the point you want it to be inserted. It doesn't need sorting - it already is sorted logically - Its just hard to do this without a pointer. I believe this is how database maintain their internal indexes, with b-tree structures I imagine.

@MajP
I just checked both an xml file, and a folder structure, and they seem to preload all the nodes. Maybe you need a different mechanism to load your 50K nodes.

 

[MajP]

@MajP
I just checked both an xml file, and a folder structure, and they seem to preload all the nodes. Maybe you need a different mechanism to load your 50K nodes.

Already figured it out, as I predicted it would work. Just add a single child node per level and expand the next lower levenel on the tree view expand event. I am going to make it an optional parameter to load full or load light. That way can compare to see if it makes a big difference, which I expect will be.

 

[MajP]

If interested here is how the light load works and the difference in code. This probably should be the default load method.
Original code that adds all nodes

Public Sub addBranch(rsTree As DAO.Recordset, parentIDValue As Variant, identifier)
On Error GoTo errLable
Dim strCriteria As String
Dim bk As String
Dim currentID As Variant
Dim currentText As String
Dim currentNode As Node
Dim ParentNode As Node
  Dim strKey As String
  strCriteria = mParentIDfield & " = '" & parentIDValue & "'"

'Since it is not a root node must determine the parent node. All node keys are "ID " & the primary key
Set ParentNode = Me.Nodes(parentIDValue)
'MsgBox strCriteria
rsTree.FindFirst (strCriteria)
'MsgBox strCriteria
Do Until rsTree.NoMatch
currentID = rsTree.Fields(mIDfield)
currentText = rsTree.Fields(mNodeTextField)
identifier = rsTree.Fields(mTypeIdentifierField)
Set currentNode = Me.Nodes.Add(ParentNode, tvwChild, currentID, currentText)
currentNode.Tag = identifier
bk = rsTree.Bookmark
Call addBranch(rsTree, currentID, identifier)
rsTree.Bookmark = bk
rsTree.FindNext (strCriteria)
Loop
Exit Sub
errLable:
MsgBox Err.Number & " " & Err.Description & " In addBranch"
If MsgBox("Do you want to exit the loop?", vbYesNo, "Error In Loop") = vbYes Then
Exit Sub
Else
Resume Next
End If
End Sub

Here is the light load. It only loads the first node in a level and any other first nodes for added nodes. This is still a recursive call but only for the first node. Notice the Do until is replaced with a simple if then. That is the only difference. If you did not add at least one child then you would not get the plus sign.

Public Sub addLiteBranch(rsTree As DAO.Recordset, parentIDValue As Variant, identifier)
On Error GoTo errLable
Dim strCriteria As String
Dim bk As String
Dim currentID As Variant
Dim currentText As String
Dim currentNode As Node
Dim ParentNode As Node
  Dim strKey As String
  strCriteria = mParentIDfield & " = '" & parentIDValue & "'"

'Since it is not a root node must determine the parent node. All node keys are "ID " & the primary key
Set ParentNode = Me.Nodes(parentIDValue)
rsTree.FindFirst (strCriteria)
'Only going to get the top node
If Not rsTree.NoMatch Then
currentID = rsTree.Fields(mIDfield)
currentText = rsTree.Fields(mNodeTextField)
identifier = rsTree.Fields(mTypeIdentifierField)
Set currentNode = Me.Nodes.Add(ParentNode, tvwChild, currentID, currentText)
currentNode.Tag = identifier
bk = rsTree.Bookmark
Call addLiteBranch(rsTree, currentID, identifier)
rsTree.Bookmark = bk
rsTree.FindNext (strCriteria)
End If
Exit Sub
errLable:
MsgBox Err.Number & " " & Err.Description & " In addBranch"
If MsgBox("Do you want to exit the loop?", vbYesNo, "Error In Loop") = vbYes Then
Exit Sub
Else
Resume Next
End If
End Sub

When you expand a node the Expand event takes place. Here you have to add all the additional child nodes for the first child level and one child node (if exists) to each node added to get the plus sign. Since the first node exists already you can not add it or you throw a "key already exists" error.

Private Sub mTVW_Expand(ByVal Node As MSComctlLib.Node)
'Flush out any remaining nodes in this expanded level and liteload child level
Dim strCriteria As String
Dim bk As String
Dim currentID As Variant
Dim currentText As String
Dim currentNode As Node
Dim ParentNode As Node
Dim currentIdentifier As String
Dim rsTree As DAO.Recordset
Debug.Print Node.Text & " " & "Selected Node"
Set rsTree = Me.Recordset
strCriteria = mParentIDfield & " = '" & Node.key & "'"
rsTree.FindFirst (strCriteria)
Debug.Print strCriteria
If rsTree.NoMatch Then
MsgBox "There is no record with a Parent ID of " & Node.key
End If
if node.children > 1 then exit sub
Do Until rsTree.NoMatch
currentID = rsTree.Fields(mIDfield)
Debug.Print currentID & " current"
currentText = rsTree.Fields(mNodeTextField)
currentIdentifier = rsTree.Fields(mTypeIdentifierField)
If Node.Child.key = currentID Then
Node.Child.Tag = currentIdentifier
RaiseEvent ExpandedBranch(Node.Child)
Else
Set currentNode = mTVW.Nodes.Add(Node.key, tvwChild, currentID, currentText)
currentNode.Tag = currentIdentifier
RaiseEvent ExpandedBranch(currentNode)
bk = rsTree.Bookmark
Call addLiteBranch(rsTree, currentID, currentIdentifier)
End If
rsTree.Bookmark = bk
rsTree.FindNext (strCriteria)
Loop
End Sub

So I tested this with 10k nodes. It is not even a question if this should be the approach on larger TVs. I could not even load it originally and this is immediate. However, for both methods it seems the issue is more the amount of nodes in a single level. Even in this method if I have over a couple hundred nodes in one level it is slow. But if there are lots of branches and a relatively few (like <100) it is very fast.
So I need to
1) Update the initialize to allow the user to choose full load or light load.
2) Add an optional parameter to define which field the name of the image is located. If you are adding an image often it is defined in the table which image. But this will be an optional parameter.
3) Still need to address updating only the branch autolevel on a drag and drop
4) Reorganize the code and add commentary.
I will post the next update this evening.

 

[MajP]

Here is V13. I did a lot of cleaning up of the class so if you are importing I have changed some names.
1. Added the feature to allow you to provide a field in the query with the name of the image if applicable. This reduces additional code to load the images. Made it an optional parameter so it loads as the node loads.
2. Added an optional parameter to do a full load or a light load. The light load caused trickle down problems so I had to write code to address several issues. SInce those nodes are not loaded there are problems with sorting and autolevel and expanding branches. (These features will not work well in a very big tree). If it is a small tree (less then maybe 2k, I would do a full load)
3. Add a "TestData" form demonstrating 10K nodes in a light load. Works well but you will see nodes with several hundred children will run slow. However, this would not work at all any other way.
4. Still demonstrates the dynamic image list load.

This Treeview probably has every bell and whistle I can think of. Any others?

1. Load from common query
2. Drag and drop of nodes and update database
3. Add, edit delete record in database and update tree
4. Delete, edit node and update database
5. Move node up and down in level and update sort order
6. Apply icons to specific records
7. dynamically load icons from folder at runtime
8  Right click on node with pop up command bar
9. Right click off node with different command bar
10. Expand and collapse tree and branch
11. Node selected to synch subform
12. Node double click to add, edit, delete
13. Auto level creates outline numbering
14. Save sort
15. Autolevel levels
16. Full load of nodes or light load and add nodes when expanded

 

[dgreen]

The Search combo seem to be broke.
Recommend Compiling. I'm seeing an issue at createCommandBarPopUpNoNode().

Once the above are resolved.....

Remove the extra tables, queries, forms and vba so it's a clean database.
Implement the dynamic search code, from page 2 of this string, to enable a mid string search.
Anchor the treeview to down and right; anchor the controls and combo search to top right; the subform to bottom left.

 

[dgreen]

Can you get the other things I mentioned above?

I forgot a reference to Office for the command bars. I will repost.

 

[MajP]

@dgreen
I updated the previous file.
1) I added my class module for a Find as you Type combo box which you will find far superior. You will want this for your library because it turns any combobox into a FAYT with one line of code. It also works much better because it handles up and down arrow keys. I instantiate on the load event.
2) The problem with the combo is an issue with a light load. It is searching for a node that is not loaded yet. As I said you probably want to use a full load (modify the initialize method) and will not have an issue, but I put in error checking to explain it. Try now. Pick something like 1.2 (second level) and you will get the error message. Expand that node and then try it.
3) I fixed the select node feature so that it is highlighted blue and not the faint highlight. The method is drop highlight.

All those other features are your specifics, and not necessary for demonstrating the Treeview features. Unless you have additional features or code, do whatever you want formatting and removing of other objects. Some of those buttons are for demo purposes and can be removed because of the combo. You may no longer want to capture the double click event since you can do that off the right click.

 

[dgreen]

Understood.. Thank you for the effort and time. I'll take a look later today. Off to fix a flat tire issue.

@dgreen
I updated the previous file.
1) I added my class module for a Find as you Type combo box which you will find far superior. You will want this for your library because it turns any combobox into a FAYT with one line of code. It also works much better because it handles up and down arrow keys. I instantiate on the load event.
2) The problem with the combo is an issue with a light load. It is searching for a node that is not loaded yet. As I said you probably want to use a full load (modify the initialize method) and will not have an issue, but I put in error checking to explain it. Try now. Pick something like 1.2 (second level) and you will get the error message. Expand that node and then try it.
3) I fixed the select node feature so that it is highlighted blue and not the faint highlight. The method is drop highlight.

All those other features are your specifics, and not necessary for demonstrating the Treeview features. Unless you have additional features or code, do whatever you want formatting and removing of other objects. Some of those buttons are for demo purposes and can be removed because of the combo. You may no longer want to capture the double click event since you can do that off the right click.

 

[dgreen]

Don't see the new zip file where the v13 was????

 

[MajP]

I deleted the previous and added the new one in same location.
FYI,
When creating a new DB it is best to do a fresh import and not delete from an existing. Just remember the three references. I list them out in the class at the very top. So create a brand new db. Import tables first. Then import other objects. Add references. Compact and repair. Anytime a DB starts acting weird I do this especially in development.