| |
| Treeview - Relocation (drag-drop) |
It might not make much sense to copy a node.
You could simply insert a new node.
But what if there is a sublist, or an entire subtree, which you want to duplicate.
It's a job you might want to put off if you had to imagine doing it manually.
Let's say the heirarchy is the chapters and paragraphs, by page, of a book
in Italian. You have entered all the Italian text and footnotes.
But you want to translate to English.
If you copy the whole heirarchy of the Italian book, and just give the superior
node another name, you can begin your translation, just that fast.
But this duplication can also just be trivially piggybacked on the drag-drop sequence
used to relocate a node.
So the relocation bit is shown first, which will include the duplication (and which will then be explained last).
When you click on a node, you can then drag it elsewhere in the same treeview,
or to a different treeview on the form or subform, entirely.
The question is, where to drop it?
Since these are not sorted listed, but are simply automatically sorted alphabetically, the sort
order is predetermined.
That leaves only the question of whether to drop at the same list/level,
or to drop to the sublist.
So the standard/default was chosen, here, to drop to the sublist under the target node.
First, drag and drop on a treeview requires a little setup:
|
Private Sub tvw_MouseDown(ByVal Button As Integer, ByVal Shift As Integer, ByVal x As Long, ByVal Y As Long)
Me!tvw.Object.SelectedItem = Me!tvw.Object.HitTest(x, Y)
End Sub
Private Sub tvw_OLEStartDrag(data As Object, AllowedEffects As Long)
Dim nod As node
Set nod = Me!tvw.SelectedItem
If Not nod Is Nothing Then data.SetData nod.Text & "," & Mid(nod.Key, 2) & "," & nod.Tag & ",tblExtLinkList," & CATA_LINK
End Sub
|
On the mousedown event, the hit test is read to identify the selected node.
This might seem counterintuitive, since the node in question should be tagged as the selected node just
by clicking on it.
But perhaps that doesn't happen until the mouse button is released.
So using the "object.HitTest(X,Y)" syntax, the SelectedItem is set by the program.
The start drag would be triggered by a mousedown and likely just moving the mouse one pixel.
And this event is caught as "OLEStartDrag".
Since the selected item was just set, the properties, like its key, can now be read out.
And whatever info you might need is passed or held in a class named, dataobject, by its SetData method, and using
the syntax here - data.SetData .
Here, the text, key and tag are held, separated by commas (which assumes no commas are used in the tag).
After you have picked/selected the node, and are moving it to another location in the hierarchy,
another routine is being called:
|
Public Const SB_LINEUP = 0
Public Const SB_LINELEFT = 0
Public Const SB_LINEDOWN = 1
Public Const SB_LINERIGHT = 1
Public Const WM_HSCROLL = &H114
Public Const WM_VSCROLL = &H115
Public Declare Function SendMessage Lib "user32" Alias "SendMessageA" _
(ByVal hWnd As Long, _
ByVal wMsg As Long, _
ByVal wParam As Long, _
lParam As Any) As Long
Private Sub tvw_OLEDragOver(data As Object, Effect As Long, _
Button As Integer, Shift As Integer, x As Single, Y As Single, _
State As Integer)
Dim objtree As TreeView, lngMsg As Long, lngUpDwn As Long
Set objtree = Me!tvw.Object
Set objtree.DropHighlight = objtree.HitTest(x, Y)
lngMsg = WM_VSCROLL
lngUpDwn = IIf(Y < Me!tvw.Height / 2, SB_LINEUP, SB_LINEDOWN)
If Y < 250 Or Y > Me!tvw.Height - 250 Then
SendMessage Me!tvw.hWnd, lngMsg, lngUpDwn, vbNull
End If
End Sub
|
SendMessage was already noted in passing. It can be extremely useful for controlling things
which are not exposed by the typical 'wrappers' and covers which are used as API calls.
Here it seemed essential, however.
It's used to send a message to the treeview to scroll up or down, depending,
if the item/cursor gets within 250 pixels of the top or bottom of the treeview box.
That is, if you try to drag off the top, and the display doesn't scroll with you, how
could you drop the item where you wished?
Since such scrolling is not built-in to the treeview, it has to be provided programmatically.
You can also see the same HitTest used to find a drop highlight all along the way.
If you move off of the text, the selected item with which you started is again highlighted, without releasing the button.
If you drop back on to other nodes, then each is highlighted, in turn, as you move over them
without releasing the mouse button, and the selected item just has a thin box around it.
So only one node at a time is highlighted in the treeview.
Then you've found the new location, and you release the button:
|
Private Sub tvwExL_OLEDragDrop(data As Object, Effect As Long, Button As Integer, Shift As Integer, x As Single, Y As Single)
sTvwDragDrop Me!tvw.Object, "tblSelfRefData", Shift
End Sub
|
Heh, heh, perhaps. That's just a cover function.
Fact is, you might have many treeviews on the same form, say in a tab control (and you tab to each of the different treeviews).
So you pass control with data specific to this treeview to a routine that handles the drop, generally, from any form or subform:
|
' The 'drop code' for a MS Treeview control. Mouse button is released.
' Needs the object reference to the Treeview control, and the name of the table which is being read into the control.
Public Sub sTvwDragDrop(objtree As Object, strTableName As String, Optional Shift As Integer)
On Error GoTo ErrAtvTree_OLEDragDrop
Dim strKey As String, strText As String, i
Dim lngNewAnID As Long, lngOldSupID As Long, lngNewIDtvw As Long
Dim nodNew As node, nodDragged As node
Dim rst As DAO.Recordset, rstCopy As DAO.Recordset
Set rst = fGetThisDB.OpenRecordset(strTableName, dbOpenDynaset)
If Not objtree.SelectedItem Is Nothing Then
Set nodDragged = objtree.SelectedItem
strKey = nodDragged.Key
strText = nodDragged.Text
'nothing if dragged to empty space - make top level cat
If objtree.DropHighlight Is Nothing Then
objtree.Nodes.Remove nodDragged.Index
'update underlying record
rst.FindFirst "[anID]=" & Mid(strKey, 2)
rst.Edit
rst![lngSupID] = 0
rst.Update
' update treeview, starting with new node position
Set nodNew = objtree.Nodes.Add(, , strKey, strText)
objtree.Nodes(nodNew.Index).Sorted = True
' fill in the branches again
sAddBranches objtree, nodNew, rst
ElseIf nodDragged.Index <> objtree.DropHighlight.Index Then
If fCantMoveUnder(Mid(nodDragged.Key, 2), Mid(objtree.DropHighlight.Key, 2), False, "lngSupID", "anID", strTableName) Then
MsgBox "You can't place this beneath, because the one beneath would 'look' for this at some point, above," & _
" and suddenly would not find it! So it can't work", vbCritical, "WON'T WORK"
' Shift-key is down - full sub-tree is copied, rather than moved.
Else
If (Shift And acShiftMask) > 0 Then
' place subtree copy or routine call, here
' otherwise just change the one way link
Else
rst.FindFirst "[anID]=" & Mid(nodDragged.Key, 2)
rst.Edit
rst![lngSupID] = Mid(objtree.DropHighlight.Key, 2)
rst.Update
Set nodDragged.Parent = objtree.DropHighlight
objtree.Nodes(nodDragged.Parent.Index).Sorted = True
End If
End If
End If
End If
Set nodDragged = Nothing
ExitAtvTree_OLEDragDrop:
Set objtree.DropHighlight = Nothing
rst.Close
Set rst = Nothing
Set nodNew = Nothing
Exit Sub
ErrAtvTree_OLEDragDrop:
If Err.Number = 35614 Then
MsgBox "Error 35614.", vbCritical, "Move Cancelled"
ElseIf Err.Number = 3022 Then
MsgBox "You already have a sub-category of that same name under this category.", vbCritical, "Move Cancelled"
Else
MsgBox "An error occurred while trying to move the node. " & vbCrLf & Error.Number, vbCritical, "Move Cancelled"
End If
Resume ExitAtvTree_OLEDragDrop
End Sub
Public Function fCantMoveUnder(lngMoveID As Long, ByVal lngNextSupID As Long, ysnRtn As Boolean, _
strSupIDField As String, strPKfield As String, strTable As String)
Dim dum
lngNextSupID = fLookUp(strSupIDField, strTable, strPKfield & "=" & lngNextSupID)
If lngNextSupID < 1 Or IsNull(lngNextSupID) Then
ysnRtn = False
ElseIf lngNextSupID = lngMoveID Then
ysnRtn = True
Else
dum = fCantMoveUnder(lngMoveID, lngNextSupID, ysnRtn, strSupIDField, strPKfield, strTable)
End If
fCantMoveUnder = ysnRtn
End Function
|
A placeholder is here used for the duplication code, which will be explained, just below.
You can see the key and text properties of a node are read into
variables (variable constants, as used here), and that mid is used to strip off the prefixed letter from the key.
The decision was made that the attempt to drag a node off the screen, or just
to an empty area in the treeview, was not going to be interpreted as an attempt to delete that
node and its subtrees.
Plus, there was no other way to relocate to the top level (which might have only one 'root' node, otherwise, under which any other could be dropped).
So the drag-out or drag-off motion is interpreted as the wish to place the node and its sublists at the top
level in the treeview.
That means an entire list might be at the top level of the treeview.
Any 'root' is implied as being above those, and is imagined and unseen.
So the node and its sublists in the treeview are "Removed".
That doesn't change the underlying table. It just removes all the entries from the treeview.
So the uplink, the lngSupID, is changed to 0 for the node.
And the decision was also made, obviously, to use the full branch routine to put the relocated node in the treeview, rather than the routine that was limited to a certain depth.
If there is, however, a target node, a drop highlight, then if you aren't dropping on the same
node with which you began, then the question is whether it's just a simple relocation of node and sublists,
or a full copy of same.
The shift key is used. If the shift key is being held - full copy. Duplication.
If not, it's a simple relocation, like that above, but instead of setting the uplink to 0, it's
set to the unique key number of the drop/target node (which is the unique key for its underlying record, in this scheme).
And it's even easier than that above. No remove is needed. No repaint of the treeview.
Just change the relationship so that the dragged node is now immediately under the target node, and resort.
It's that simple to change both the treeview display and the underlying data, by this scheme, when all
you want to do is relocate the node and all of its sublists.
You'll notice the test before that, as well. What if you tried to drop a superior node underneath one of its own sublists?
What would reference what?
So it's not allowed. The message you see is pretty self-explanatory.
And so that leaves only - duplication.
Continue
|