Hierarchical Data, Recursion, Tree-Views, and a Custom Class to Assist (2 Viewers)

dgreen

Member
Local time
Today, 10:49
Joined
Sep 30, 2018
Messages
397
I'm am waiting in anticipation. This sounds promising.
 

dgreen

Member
Local time
Today, 10:49
Joined
Sep 30, 2018
Messages
397
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

You've got your good things, and you've got mine.
Local time
Today, 11:49
Joined
May 21, 2018
Messages
8,463
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.

Code:
  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
 
Last edited:

dgreen

Member
Local time
Today, 10:49
Joined
Sep 30, 2018
Messages
397
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

Super Moderator
Staff member
Local time
Today, 15:49
Joined
Sep 12, 2006
Messages
15,614
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

Member
Local time
Today, 10:49
Joined
Sep 30, 2018
Messages
397
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

Member
Local time
Today, 10:49
Joined
Sep 30, 2018
Messages
397
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.

Code:
  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
 

Attachments

  • Capture.PNG
    Capture.PNG
    13.4 KB · Views: 140

MajP

You've got your good things, and you've got mine.
Local time
Today, 11:49
Joined
May 21, 2018
Messages
8,463
The biggest feature I would still like to add is a "Light Load". Currently it loads all of the nodes on open. In this example no problem. I have a tree with 50K nodes and that can take a real long time. Ideally you would simply add the top level, and then when the user expands a node it only loads the next level for that node. Unfortunately there is a problem doing that. If you do not add the child node (at least 1) there is no plus symbol so you do not know to expand it. The trick I am thinking is adding the first child node per each node in the level. That one is going to take some thinking but I think it is doable. That is not specific to your case
For your's need to try to update the autolevel values on drag and drop without having to reload the whole tree.
Besides that I think you have covered about as many features as you can cram into a tree view.
 

dgreen

Member
Local time
Today, 10:49
Joined
Sep 30, 2018
Messages
397
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

Super Moderator
Staff member
Local time
Today, 15:49
Joined
Sep 12, 2006
Messages
15,614
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.
 
Last edited:

MajP

You've got your good things, and you've got mine.
Local time
Today, 11:49
Joined
May 21, 2018
Messages
8,463
@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

You've got your good things, and you've got mine.
Local time
Today, 11:49
Joined
May 21, 2018
Messages
8,463
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
Code:
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.
Code:
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.
Code:
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

You've got your good things, and you've got mine.
Local time
Today, 11:49
Joined
May 21, 2018
Messages
8,463
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?

Code:
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

Member
Local time
Today, 10:49
Joined
Sep 30, 2018
Messages
397
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.
 
Last edited:

MajP

You've got your good things, and you've got mine.
Local time
Today, 11:49
Joined
May 21, 2018
Messages
8,463
@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

Member
Local time
Today, 10:49
Joined
Sep 30, 2018
Messages
397
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.
 

Users who are viewing this thread

Top Bottom