AW: TreeView Control - Nodes verschieben, Drag&Drop
17.08.2003 23:07:53
Michael Brüggemann
Hallo Jochen,
hier ein Beispiel aus der Hilfedatei zu den MS Common Controls. Danach sind Ereignisse und Methoden vorgesehen, jedoch offensichtlich mit VBA nicht benutzbar:
' Declare global variables.
Dim indrag As Boolean ' Flag that signals a Drag Drop operation.
Dim nodX As Object ' Item that is being dragged.
Private Sub Form_Load()
' Load a bitmap into an Imagelist control.
Dim imgX As ListImage
Dim BitmapPath As String
BitmapPath = "icons\mail\mail01a.ico"
Set imgX = ImageList1.ListImages.Add(, , LoadPicture(BitmapPath))
' Initialize TreeView control and create several nodes.
TreeView1.ImageList = ImageList1
Dim nodX As Node ' Create a tree.
Set nodX = TreeView1.Nodes.Add(, , , "Parent1", 1)
Set nodX = TreeView1.Nodes.Add(, , , "Parent2", 1)
Set nodX = TreeView1.Nodes.Add(1, tvwChild, , "Child 1", 1)
Set nodX = TreeView1.Nodes.Add(1, tvwChild, , "Child 2", 1)
Set nodX = TreeView1.Nodes.Add(2, tvwChild, , "Child 3", 1)
Set nodX = TreeView1.Nodes.Add(2, tvwChild, , "Child 4", 1)
Set nodX = TreeView1.Nodes.Add(3, tvwChild, , "Child 5", 1)
nodX.EnsureVisible ' Expand tree to show all nodes.
End Sub
Private Sub TreeView1_MouseDown(Button As Integer, Shift As Integer, x As Single, y As Single)
Set nodX = TreeView1.SelectedItem ' Set the item being dragged.
Set TreeView1.DropHighlight = Nothing
End Sub
Private Sub TreeView1_MouseMove _
(Button As Integer, Shift As Integer, x As Single, y As Single)
If Button = vbLeftButton Then ' Signal a Drag operation.
indrag = True ' Set the flag to true.
' Set the drag icon with the CreateDragImage method.
TreeView1.DragIcon = TreeView1.SelectedItem.CreateDragImage
TreeView1.Drag vbBeginDrag ' Drag operation.
End If
End Sub
Private Sub TreeView1_DragDrop(Source As Control, x As Single, y As Single)
' If user didn't move mouse or released it over an invalid area.
If TreeView1.DropHighlight Is Nothing Then
indrag = False
Exit Sub
Else
' Set dragged node's parent property to the target node.
On Error GoTo checkerror ' To prevent circular errors.
Set nodX.Parent = TreeView1.DropHighlight
Cls
Print TreeView1.DropHighlight.Text & _
" is parent of " & nodX.Text
' Release the DropHighlight reference.
Set TreeView1.DropHighlight = Nothing
indrag = False
Exit Sub ' Exit if no errors occured.
End If
checkerror:
' Define constants to represent Visual Basic errors code.
Const CircularError = 35614
If Err.Number = CircularError Then
Dim msg As String
msg = "A node can't be made a child of its own children."
' Display the message box with an exclamation mark icon
' and with OK and Cancel buttons.
If MsgBox(msg, vbExclamation & vbOKCancel) = vbOK Then
' Release the DropHighlight reference.
indrag = False
Set TreeView1.DropHighlight = Nothing
Exit Sub
End If
End If
End Sub
Private Sub TreeView1_DragOver(Source As Control, x As Single, y As Single, State As Integer)
Set TreeView1.DropHighlight = TreeView1.HitTest(x, y)
End Sub
CIAO
Michael