Option Compare Database
Option Explicit
Dim tv As MSComctlLib.TreeView
Dim db As DAO.Database
Dim rst As DAO.Recordset
Dim imgListObj As MSComctlLib.ImageList
Const KeyPrfx As String = "X"
Private Sub Form_Open(Cancel As Integer)
Set tv = Me.TreeView0.Object
Set imgListObj = Me.ImageList1.Object
tv.ImageList = imgListObj
LoadTreeView
End Sub
Sub LoadTreeView()
Dim strKey As String
Dim strPKey As String
Dim strText As String
Dim strsQL As String
strsQL = "SELECT * FROM Sample ORDER BY ID"
Set db = CurrentDb
Set rst = db.OpenRecordset(strsQL, dbOpenDynaset)
tv.Nodes.Clear
'Add all Items are added as Root Nodes
Do While Not rst.BOF And Not rst.EOF
strKey = KeyPrfx & CStr(rst!ID)
strText = rst!desc
tv.Nodes.Add , , strKey, strText
With tv.Nodes.Item(strKey)
.Image = 1
.SelectedImage = 4
End With
rst.MoveNext
Loop
'Prepare to update the Parent-Key of Nodes
'wherever applicable to move and position the Child Nodes
strPKey = ""
rst.MoveLast
Do While Not rst.BOF
strPKey = Nz(rst!parentid, "")
If Len(strPKey) > 0 Then
strPKey = KeyPrfx & strPKey
strKey = KeyPrfx & CStr(rst!ID)
strText = rst!desc
'Move the Child Node under it's Parent-Node
Set tv.Nodes.Item(strKey).Parent = tv.Nodes.Item(strPKey)
'Update Image and SelectedImage Properties
'with ImageList Index numbers
With tv.Nodes.Item(strKey)
.Image = 2
.SelectedImage = 3
End With
End If
rst.MovePrevious
Loop
rst.Close
Set rst = Nothing
Set db = Nothing
End Sub
Private Sub TreeView0_NodeClick(ByVal Node As Object)
Dim SelectionNode As MSComctlLib.Node
'Ensure that the clicked node equals the selected node in the tree
If Not Node Is Nothing Then
Set SelectionNode = Node
If SelectionNode.Expanded = True Then
SelectionNode.Expanded = False
Else
SelectionNode.Expanded = True
End If
End If
End Sub
Private Sub cmdCollapse_Click()
Dim tmpnod As MSComctlLib.Node
For Each tmpnod In tv.Nodes
If tmpnod.Expanded = True Then
tmpnod.Expanded = False
End If
Next
End Sub
Private Sub cmdExpand_Click()
Dim tmpnod As MSComctlLib.Node
For Each tmpnod In tv.Nodes
If tmpnod.Expanded = False Then
tmpnod.Expanded = True
End If
Next
End Sub
Private Sub TreeView0_OLEStartDrag(Data As Object, AllowedEffects As Long)
Set Me.TreeView0.SelectedItem = Nothing
End Sub
Private Sub TreeView0_OLEDragOver(Data As Object, _
Effect As Long, _
Button As Integer, _
Shift As Integer, _
x As Single, _
y As Single, _
State As Integer)
Dim SelectedNode As MSComctlLib.Node
Dim nodOver As MSComctlLib.Node
If tv.SelectedItem Is Nothing Then
'Select a node if one is not selected
Set SelectedNode = tv.HitTest(x, y)
If Not SelectedNode Is Nothing Then
SelectedNode.Selected = True
End If
Else
If tv.HitTest(x, y) Is Nothing Then
'do nothing
Else
'Highlight the node the mouse is over
Set nodOver = tv.HitTest(x, y)
Set tv.DropHighlight = nodOver
End If
End If
End Sub
Private Sub TreeView0_OLEDragDrop(Data As Object, _
Effect As Long, _
Button As Integer, _
Shift As Integer, _
x As Single, _
y As Single)
Dim sourceNode As MSComctlLib.Node
Dim SourceParentNode As MSComctlLib.Node
Dim targetNode As MSComctlLib.Node
Dim tmpRootNode As MSComctlLib.Node
Dim strtmpNodKey As String
Dim ChildNode As MSComctlLib.Node
Dim strSPKey As String
Dim strTargetKey As String
Dim strsQL As String
Dim intKey As Integer
Dim intPKey As Integer
On Error Resume Next
Select Case Screen.ActiveControl.Name
Case TreeView0.Name
Set sourceNode = tv.SelectedItem
End Select
'Get Source Parent Node & Target Node Reference
Set SourceParentNode = sourceNode.Parent
Set targetNode = tv.HitTest(x, y)
'If any errors then exit
If Err <> 0 Then
MsgBox Err & " : " & Err.Description, vbInformation + vbCritical, "OLEDragDrop()"
Err.Clear
Exit Sub
Else
On Error GoTo 0
End If
'Get/define Source parent Node Key to compare it with Target Node Key
If SourceParentNode Is Nothing Then
strSPKey = "Empty"
Else
strSPKey = SourceParentNode.Key
End If
'Check the Target Node/Location and define the Key
Select Case True
Case targetNode Is Nothing
strTargetKey = "Empty"
'if targetNode have a zero length String as Key
Case targetNode.Key = ""
strTargetKey = "Empty"
Set targetNode = Nothing
Case Else
strTargetKey = targetNode.Key
End Select
'Make sure the Target Node is not the source Node's own parent
If strTargetKey = strSPKey Then Exit Sub
'Track User's Node move action, check for error.
On Error Resume Next
If targetNode Is Nothing Then
'If target Node is Nothing (the Node dropped in the empty area),
'then the Node must be moved to the Root-level
'save the original sourceNode.Key
strtmpNodKey = sourceNode.Key
'Modify the source Node Key, with addition of some text, say 'Empty', like 'X5Empty'
'So that a temporary Node can be created with the original source Node key.
'Note: Two Nodes with the same Key cannot remain in memory at the same time.
'The Source Node with key 'X5Empty' deleted later,
'temporary Node takes it's droped location.
sourceNode.Key = sourceNode.Key & strTargetKey
'Create the temporary Root Node, with original sourceNode Key
Set tmpRootNode = tv.Nodes.Add(, , strtmpNodKey, sourceNode.Text)
'define the Root Node image indexes
With tmpRootNode
.Image = 1
.SelectedImage = 4
End With
'Move all child Nodes from SourceNode,if any,
'as tmpRootNode's Children
Do Until sourceNode.Children = 0
Set sourceNode.Child.Parent = tmpRootNode
'modify Node image indexes
With sourceNode
.Image = 2
.SelectedImage = 3
End With
Loop
'Delete the Source Node with modified Key from TreeView
tv.Nodes.Remove sourceNode.Index
'Move the tmpRootNode with original Key
'to the dropped location on TreeView
Set sourceNode = tmpRootNode
Else
'Move the sourceNode under targetNode as child
Set sourceNode.Parent = targetNode
'modify Node image indexes
With sourceNode
.Image = 2
.SelectedImage = 3
End With
End If
'Notify, if there was an Error then Exit, else Update PrentID of related Record.
If Err <> 0 Then
MsgBox Err & " : " & "Unable to move:" & vbCrLf & Err.Description, vbInformation + vbCritical, "DragDrop2()"
Exit Sub
Else
'Build and execute the SQL statement to update the record
If targetNode Is Nothing Then
intKey = Val(Mid(sourceNode.Key, 2))
strsQL = "UPDATE Sample SET ParentID = Null" & _
" WHERE ID = " & intKey
Else
intKey = Val(Mid(sourceNode.Key, 2))
intPKey = Val(Mid(targetNode.Key, 2))
strsQL = "UPDATE sample SET ParentID = " & intPKey & _
" WHERE ID = " & intKey
End If
'Modify the table records
CurrentDb.Execute strsQL, dbFailOnError
'If an error raised then refresh TreeView and exit
If Err <> 0 Then
MsgBox Err & " : " & Err.Description
LoadTreeView 'Refresh/display TreeView without changes
Else
'Sort Nodes
If sourceNode.Parent Is Nothing Then
sourceNode.Root.Sorted = True
Else
sourceNode.Parent.Sorted = True
End If
tv.Nodes(sourceNode.Key).Selected = True
End If
End If
cmdExpand_Click
On Error GoTo 0
End Sub
Private Sub TreeView0_OLECompleteDrag(Effect As Long)
'Turn off the drophighlight
Set tv.DropHighlight = Nothing
End Sub
Private Sub Form_Close()
Set tv = Nothing
End Sub
