Treeview with Drag and Drop?

[Turbo]

OK, I have been reading threads for hours and found lots of helpful ideas about treeview and drag/drop. However, I am trying to use the two in conjucntion with each other. I want to create a treeview of say a school with departments then subdepartmnets then rooms then the equipment in these rooms. Something like this:

School School
|-Science '-Departments
| |+Biology '-SubDepartments
| '-Chemistry '-Rooms
| |+Lab '-Equipment
| |+Storage
| '-Office
| |-Desk
| '-Chair
|
|+Mathmatics
|+Language Arts
'+Liberal Arts

Now take this tree and use it as a template to drag from. Make a duplicate tree that has empty nodes to drop to. I'd like to be able to view these trees in the same form and drag a COPY of any node from the template to the empty tree structure. As I drag this data it needs to bring any child node with it. Using the example above, say I drag "Chemistry", I need it to drag "Lab", "Storage", and "Office" as well as any levels down. The data the nodes pulls from is in a table or query. I will also want to be able to add and delete from the treeview.

The point behind all of this is to allow the user to visual design an school layout rather than forms with multiple subforms.

Please advise,


Turbo

"There is a fine line between confidence and conceit" - Ken Mai

 

[SMerrill]

Naturally, you should be considering the concept of holding down the Ctrl key while you drag to make a copy of the node. Have you solved this yet?

Take care,
--Shaun

"I wish that my room had a floor; I don't care so much for a door.
But this crawling around without touching the ground is getting to be quite a bore!" -- Gelett Burgess

 

[gol4]

Here is some working code allows you to add and drag and drop on same tree does most of what you ask
will need to adjust code to move to another tree if you want. (To reduce posting space I eliminated spaces so will be hard to read)

Data loads from a table that looks like this named Listfeed

itemid item parentitemid
1 main 0
2 bldq 1
3 bld2 1
4 bld3 1
5 bld4 1
6 floor2 2
7 floor1 2

treeview control is named xtree

'paste into forms code section
Private Sub Form_Load()
loadlist
End Sub
Private Sub loadlist()
Dim db As Database, rst As Recordset, nodcurrent As Node
Dim objtree As TreeView, strtext As String
Dim bk As String
Set db = CurrentDb
Set rst = db.OpenRecordset("listfeed", dbOpenDynaset)
Set objtree = Me!xtree.Object
rst.FindFirst "[parentitemid] = 0"
Do Until rst.NoMatch
strtext = rst!Item
Set nodcurrent = objtree.Nodes.Add(, , "a" & rst!itemid, strtext)
bk = rst.Bookmark
addchildren nodcurrent, rst
rst.Bookmark = bk
rst.FindNext "[parentitemid] = 0"
Loop
rst.CLOSE
End Sub
Sub addchildren(nodbos As Node, rst As Recordset)
Dim nodcurrent As Node
Dim objtree As TreeView, strtext As String, bk As String
Set objtree = Me!xtree.Object
rst.FindFirst "parentitemid = " & Mid(nodbos.Key, 2)
Do Until rst.NoMatch
strtext = rst!Item
Set nodcurrent = objtree.Nodes.Add(nodbos, tvwChild, "a" & rst!itemid, strtext)
bk = rst.Bookmark
addchildren nodcurrent, rst
rst.Bookmark = bk
rst.FindNext "parentitemid = " & Mid(nodbos.Key, 2)
Loop
End Sub
Private Sub xtree_AfterLabelEdit(Cancel As Integer, NewString As String)
Dim db As Database, rst As Recordset, Parid As String
Set db = CurrentDb
Set rst = db.OpenRecordset("listfeed", dbOpenDynaset)
Parid = Me!xtree.Object.SelectedItem.Key
With rst
.FindFirst "itemid = " & Mid(Parid, 2)
If NewString = "" Then
.Delete
.CLOSE
xtree.Nodes.Remove Parid
Exit Sub
End If
.Edit
!Item = NewString
.Update
.CLOSE
End With
Set db = Nothing
End Sub
Private Sub xtree_DblClick()
Dim db As Database, rst As Recordset, strtxt As String
Dim Parid As String, keyid As String
strtxt = InputBox("Enter Item To Add", "Adding Item to list&quot
If strtxt = "" Then Exit Sub
Set db = CurrentDb
Set rst = db.OpenRecordset("listfeed&quot
Parid = Me!xtree.Object.SelectedItem.Key
rst.AddNew
rst!Item = strtxt
rst!parentitemid = Mid(Parid, 2)
rst.Update
rst.MoveLast
keyid = rst!itemid
xtree.Nodes.Add Parid, tvwChild, "a" & keyid, strtxt
rst.CLOSE
Set db = Nothing
End Sub
Private Sub xtree_OLEstartdrag(Data As Object, AllowedEffects As Long)
Me!xtree.Object.SelectedItem = Nothing
End Sub
Private Sub xtree_oledragover(Data As Object, Effect As Long, Button As Integer, _
Shift As Integer, x As Single, y As Single, State As Integer)
Dim otree As TreeView
Set otree = Me.xtree.Object
If otree.SelectedItem Is Nothing Then
Set otree.SelectedItem = otree.HitTest(x, y)
End If
Set otree.DropHighlight = otree.HitTest(x, y)
End Sub
Private Sub xtree_oledragdrop(Data As Object, Effect As Long, Button As Integer, _
Shift As Integer, x As Single, y As Single)
On Err GoTo Errxtree_oledragdrop
Dim otree As TreeView, strkey As String, strtext As String
Dim nodnew As Node, noddragged As Node
Dim db As Database, rs As Recordset
Set db = CurrentDb
Set rs = db.OpenRecordset("listfeed", dbOpenDynaset)
Set otree = Me!xtree.Object
If otree.SelectedItem Is Nothing Then
Else
Set noddragged = otree.SelectedItem
If otree.DropHighlight Is Nothing Then
strkey = noddragged.Key
strtext = noddragged.Text
otree.Nodes.Remove noddragged.Index
rs.FindFirst "[itemid] = " & Mid(strkey, 2)
rs.Edit
rs.Update
Set nodnew = otree.Nodes.Add(, , strkey, strtext, 1)
addchildren nodnew, rs
ElseIf noddragged.Index <> otree.DropHighlight.Index Then
Set noddragged.Parent = otree.DropHighlight
rs.FindFirst &quot;[itemid]=&quot; & Mid(noddragged.Key, 2)
rs.Edit
rs![parentitemid] = Mid(otree.DropHighlight.Key, 2)
rs.Update
End If
End If
Set noddragged = Nothing
Set otree.DropHighlight = Nothing
Exitxtree_oledragdrop:
Exit Sub
Errxtree_oledragdrop:
If Err.Number = 35614 Then
MsgBox &quot;Cant do that&quot;, _
vbCritical, &quot;move cancelled&quot;
Else
MsgBox &quot;an error occurred while trying to move the node. &quot; & _
&quot; please try again. &quot; & vbCrLf & Error.Description
End If
Resume Exitxtree_oledragdrop
End Sub