Option ExplicitPrivate Enum ObjectType otNone = 0 otFactory = 1 otGroup = 2 otPerson = 3 otFactory2 = 4 otGroup2 = 5 otPerson2 = 6 End EnumPrivate SourceNode As Object Private SourceType As ObjectType Private TargetNode As Object ' Break a token off of the string. Return the token's ' name and value through variables. Return token_name ' = "" if there are no more trokens. Remove the token ' from the string txt. Public Sub GetToken(txt As String, token_name As String, token_value As String) Dim pos As Integer Dim pos2 As Integer Dim txt_len As Integer Dim ch As String Dim open_parens As Integer ' Remove leading vbCrLfs, spaces, etc. txt_len = Len(txt) pos = 1 For pos = 1 To txt_len ' Find the first visible character. ch = Mid$(txt, pos, 1) If ch > " " And ch <= "~" Then Exit For Next pos
If pos > 1 Then txt = Right$(txt, txt_len - pos + 1) txt_len = Len(txt) End If ' Find the open parenthesis. pos = InStr(txt, "(") If pos <= 1 Then ' No open parenthesis or no name. ' Return no token. txt = "" token_name = "" token_value = "" Exit Sub End If token_name = Left$(txt, pos - 1)
' Find the corresponding close parenthesis. open_parens = 1 For pos2 = pos + 1 To txt_len ch = Mid$(txt, pos2, 1) Select Case ch Case "(" open_parens = open_parens + 1 Case ")" open_parens = open_parens - 1 If open_parens = 0 Then Exit For End Select Next pos2 ' Note: If there is no corresponding close ' parenthesis, pos2 = txt_len + 1. This makes us ' use the rest of the string. token_value = Mid$(txt, pos + 1, pos2 - pos - 1) If pos2 >= txt_len Then txt = "" Else txt = Right$(txt, txt_len - pos2 - 1) End If End Sub ' *********************************************** ' Return the node's object type. ' *********************************************** Private Function NodeType(test_node As Node) As ObjectType Select Case Left$(test_node.Key, 1) Case "f" NodeType = otFactory Case "g" NodeType = otGroup Case "p" NodeType = otPerson End Select End Function ' Return a string representing the TreeView's data. ' Serializations neither begin nor end with vbCrLf. Public Function SerializeTreeView(ByVal tree As TreeView) As String Dim txt As String Dim nl As String Dim root_node As Node txt = "TreeView(" nl = vbCrLf & " "
' Serialize the root nodes. For Each root_node In tree.Nodes If root_node.Parent Is Nothing Then _ txt = txt & nl & "Root(" & vbCrLf & _ SerializeNode(root_node, 2) & _ nl & ")" Next root_node txt = txt & vbCrLf & ")" SerializeTreeView = txt End Function ' Initialize the TreeView's data using a serialization. Public Sub UnSerializeTreeView(ByVal tree As TreeView, ByVal serialization As String) Dim treeview_name As String Dim treeview_value As String Dim root_name As String Dim root_value As String ' Make sure this is a TreeView serialization. GetToken serialization, treeview_name, treeview_value If treeview_name <> "TreeView" Then MsgBox "Error initializing TreeView. This is not a TreeView serialization." Exit Sub End If ' Remove all the nodes. tree.Nodes.Clear GetToken treeview_value, root_name, root_value Do While root_name <> "" ' This better be a root serialization. If root_name <> "Root" Then MsgBox "Error reading TreeView serialization. Expected 'Root' but found '" & _ root_name & ".'" Exit Sub End If ' Unserialize the root. If there's an error, ' stop processing the serialization. If UnSerializeNode(tree, Nothing, root_value) Then Exit Sub ' Get the next root serialization. GetToken treeview_value, root_name, root_value Loop End Sub
' Initialize the Node's data using a serialization. ' Return true if there is an error. Public Function UnSerializeNode(ByVal tree As TreeView, ByVal par As Node, ByVal serialization As String) As Boolean Dim new_node As Node Dim basic_name As String Dim basic_value As String Dim token_name As String Dim token_value As String Dim val_Expanded As Boolean Dim val_ExpandedImage As Variant Dim val_Image As Variant Dim val_Key As String Dim val_Selected As Boolean Dim val_SelectedImage As Variant Dim val_Tag As String Dim val_Text As String ' Assume we will fail. UnSerializeNode = True
' Read the node's basic information. GetToken serialization, basic_name, basic_value If basic_name <> "BasicInfo" Then MsgBox "Error reading Node serialization. Expected 'BasicInfo' but found '" & _ basic_name & ".'" Exit Function End If
' Read the information categories. GetToken basic_value, token_name, token_value Do While token_name <> "" Select Case token_name Case "Expanded" val_Expanded = CBool(token_value) Case "ExpandedImage" If token_value = "" Then val_ExpandedImage = Empty Else val_ExpandedImage = CInt(token_value) End If Case "Image" If token_value = "" Then val_Image = Empty Else val_Image = CInt(token_value) End If Case "Key" val_Key = token_value Case "Selected" val_Selected = CBool(token_value) Case "SelectedImage" If token_value = "" Then val_SelectedImage = Empty Else val_SelectedImage = CInt(token_value) End If Case "Tag" val_Tag = token_value Case "Text" val_Text = token_value End Select ' Get the next value. GetToken basic_value, token_name, token_value Loop ' Create the node. If par Is Nothing Then Set new_node = tree.Nodes.Add( _ , tvwChild, val_Key, val_Text, val_Image, val_SelectedImage) Else Set new_node = tree.Nodes.Add( _ par, tvwChild, val_Key, val_Text, val_Image, val_SelectedImage) End If ' Set the node's other values. new_node.Expanded = val_Expanded new_node.ExpandedImage = val_ExpandedImage new_node.Selected = val_Selected new_node.Tag = val_Tag
' Unserialize the node's children. GetToken serialization, token_name, token_value Do While token_name <> "" If token_name <> "Child" Then MsgBox "Error reading Node serialization. Expected 'Child' but found '" & _ basic_name & ".'" Exit Function End If ' Unserialize the child. If UnSerializeNode(tree, new_node, token_value) Then Exit Function ' Get the next child. GetToken serialization, token_name, token_value Loop ' No error occurred. UnSerializeNode = False End Function ' Return a string representing the Node's data. ' Serializations neither begin nor end with vbCrLf. Public Function SerializeNode(ByVal par As Node, ByVal indent As Integer) As String Dim txt As String Dim child As Node Dim nl As String ' Serialize this node's basic information. txt = Space$(indent * 2) & "BasicInfo(" nl = vbCrLf & Space$((indent + 1) * 2) txt = txt & nl & "Expanded(" & par.Expanded & ")" txt = txt & nl & "ExpandedImage(" & par.ExpandedImage & ")" txt = txt & nl & "Image(" & par.Image & ")" txt = txt & nl & "Key(" & par.Key & ")" txt = txt & nl & "Selected(" & par.Selected & ")" txt = txt & nl & "SelectedImage(" & par.SelectedImage & ")" txt = txt & nl & "Tag(" & par.Tag & ")" txt = txt & nl & "Text(" & par.Text & ")"
nl = vbCrLf & Space$(indent * 2) txt = txt & nl & ")" ' Serialize the node's children. Set child = par.child Do While Not (child Is Nothing) txt = txt & nl & "Child(" & vbCrLf & _ SerializeNode(child, indent + 1) & _ nl & ")" Set child = child.Next Loop SerializeNode = txt End Function
' *********************************************** ' Prepare the ImageList and TreeView controls. ' *********************************************** Private Sub Form_Load() #Const LOAD_FROM_FILE = True ' False Dim i As Integer Dim txt As String Dim fnum As Integer#If LOAD_FROM_FILE Then #Else Dim factory As Node Dim group As Node Dim person As Node #End If ' Load pictures into the ImageList. For i = 1 To 6 TreeImages.ListImages.Add , , TreeImage(i).Picture Next i
' Attach the TreeView to the ImageList. OrgTree.ImageList = TreeImages #If LOAD_FROM_FILE Then ' Load the serialization. fnum = FreeFile Open App.Path & "\treeview.ser" For Input As fnum Input #fnum, txt Close fnum
' Unserialize the TreeView. UnSerializeTreeView OrgTree, txt #Else ' Create some nodes. Set factory = OrgTree.Nodes.Add(, , "f R & D", "R & D", otFactory, otFactory2) Set group = OrgTree.Nodes.Add(factory, tvwChild, "g Engineering", "Engineering", otGroup, otGroup2) Set person = OrgTree.Nodes.Add(group, tvwChild, "p Cameron, Charlie", "Cameron, Charlie", otPerson, otPerson2) Set person = OrgTree.Nodes.Add(group, tvwChild, "p Davos, Debbie", "Davos, Debbie", otPerson, otPerson2) person.EnsureVisible Set group = OrgTree.Nodes.Add(factory, tvwChild, "g Test", "Test", otGroup, otGroup2) Set person = OrgTree.Nodes.Add(group, tvwChild, "p Able, Andy", "Andy, Able", otPerson, otPerson2) Set person = OrgTree.Nodes.Add(group, tvwChild, "p Baker, Betty", "Baker, Betty", otPerson, otPerson2) person.EnsureVisible
Set factory = OrgTree.Nodes.Add(, , "f Sales & Support", "Sales & Support", otFactory, otFactory2) Set group = OrgTree.Nodes.Add(factory, tvwChild, "g Showroom Sales", "Showroom Sales", otGroup, otGroup2) Set person = OrgTree.Nodes.Add(group, tvwChild, "p Gaines, Gina", "Gaines, Gina", otPerson, otPerson2) person.EnsureVisible Set group = OrgTree.Nodes.Add(factory, tvwChild, "g Field Service", "Field Service", otGroup, otGroup2) Set person = OrgTree.Nodes.Add(group, tvwChild, "p Helms, Harry", "Helms, Harry", otPerson, otPerson2) Set person = OrgTree.Nodes.Add(group, tvwChild, "p Ives, Irma", "Ives, Irma", otPerson, otPerson2) Set person = OrgTree.Nodes.Add(group, tvwChild, "p Jackson, Josh", "Jackson, Josh", otPerson, otPerson2) person.EnsureVisible Set group = OrgTree.Nodes.Add(factory, tvwChild, "g Customer Support", "Customer Support", otGroup, otGroup2) Set person = OrgTree.Nodes.Add(group, tvwChild, "p Klug, Karl", "Klug, Karl", otPerson, otPerson2) Set person = OrgTree.Nodes.Add(group, tvwChild, "p Landau, Linda", "Landau, Linda", otPerson, otPerson2) person.EnsureVisible #End If End Sub ' *********************************************** ' Make the TreeView as large as possible. ' *********************************************** Private Sub Form_Resize() OrgTree.Move 0, 0, ScaleWidth, ScaleHeight End Sub ' Save the TreeView data into a file. Private Sub Form_Unload(Cancel As Integer) Dim txt As String Dim fnum As Integer fnum = FreeFile Open App.Path & "\treeview.ser" For Output As fnum txt = SerializeTreeView(OrgTree) Write #fnum, txt Close fnum End Sub ' *********************************************** ' Save the node pressed so we can drag it later. ' *********************************************** Private Sub OrgTree_MouseDown(Button As Integer, Shift As Integer, x As Single, y As Single) Set SourceNode = OrgTree.HitTest(x, y) End Sub' *********************************************** ' Start a drag if one is not in progress. ' *********************************************** Private Sub OrgTree_MouseMove(Button As Integer, Shift As Integer, x As Single, y As Single) If Button = vbLeftButton Then ' Start a new drag. Note that we do not get ' other MouseMove events while the drag is ' in progress.
' See what node we are dragging. SourceType = NodeType(SourceNode) ' Select this node. When no node is highlighted, ' this node will be displayed as selected. That ' shows where it will land if dropped. Set OrgTree.SelectedItem = SourceNode ' Set the drag icon for this source. OrgTree.DragIcon = IconImage(SourceType) OrgTree.Drag vbBeginDrag End If End Sub ' *********************************************** ' The user is dropping. See if the drop is valid. ' *********************************************** Private Sub OrgTree_DragDrop(Source As Control, x As Single, y As Single) If Not (OrgTree.DropHighlight Is Nothing) Then ' It's a valid drop. Set source node's ' parent to be the target node. Set SourceNode.Parent = OrgTree.DropHighlight Set OrgTree.DropHighlight = Nothing End If Set SourceNode = Nothing SourceType = otNone End Sub ' *********************************************** ' The mouse is being dragged over the control. ' Highlight the appropriate node. ' *********************************************** Private Sub OrgTree_DragOver(Source As Control, x As Single, y As Single, State As Integer) Dim target As Node Dim highlight As Boolean ' See what node we're above. Set target = OrgTree.HitTest(x, y)
' If it's the same as last time, do nothing. If target Is TargetNode Then Exit Sub Set TargetNode = target
highlight = False If Not (TargetNode Is Nothing) Then ' See what kind of node were above. If NodeType(TargetNode) + 1 = SourceType Then _ highlight = True End If
If highlight Then Set OrgTree.DropHighlight = TargetNode Else Set OrgTree.DropHighlight = Nothing End If End Sub
otNone = 0
otFactory = 1
otGroup = 2
otPerson = 3
otFactory2 = 4
otGroup2 = 5
otPerson2 = 6
End EnumPrivate SourceNode As Object
Private SourceType As ObjectType
Private TargetNode As Object
' Break a token off of the string. Return the token's
' name and value through variables. Return token_name
' = "" if there are no more trokens. Remove the token
' from the string txt.
Public Sub GetToken(txt As String, token_name As String, token_value As String)
Dim pos As Integer
Dim pos2 As Integer
Dim txt_len As Integer
Dim ch As String
Dim open_parens As Integer ' Remove leading vbCrLfs, spaces, etc.
txt_len = Len(txt)
pos = 1
For pos = 1 To txt_len
' Find the first visible character.
ch = Mid$(txt, pos, 1)
If ch > " " And ch <= "~" Then Exit For
Next pos
If pos > 1 Then
txt = Right$(txt, txt_len - pos + 1)
txt_len = Len(txt)
End If ' Find the open parenthesis.
pos = InStr(txt, "(")
If pos <= 1 Then
' No open parenthesis or no name.
' Return no token.
txt = ""
token_name = ""
token_value = ""
Exit Sub
End If
token_name = Left$(txt, pos - 1)
' Find the corresponding close parenthesis.
open_parens = 1
For pos2 = pos + 1 To txt_len
ch = Mid$(txt, pos2, 1)
Select Case ch
Case "("
open_parens = open_parens + 1
Case ")"
open_parens = open_parens - 1
If open_parens = 0 Then Exit For
End Select
Next pos2
' Note: If there is no corresponding close
' parenthesis, pos2 = txt_len + 1. This makes us
' use the rest of the string. token_value = Mid$(txt, pos + 1, pos2 - pos - 1)
If pos2 >= txt_len Then
txt = ""
Else
txt = Right$(txt, txt_len - pos2 - 1)
End If
End Sub
' ***********************************************
' Return the node's object type.
' ***********************************************
Private Function NodeType(test_node As Node) As ObjectType
Select Case Left$(test_node.Key, 1)
Case "f"
NodeType = otFactory
Case "g"
NodeType = otGroup
Case "p"
NodeType = otPerson
End Select
End Function
' Return a string representing the TreeView's data.
' Serializations neither begin nor end with vbCrLf.
Public Function SerializeTreeView(ByVal tree As TreeView) As String
Dim txt As String
Dim nl As String
Dim root_node As Node txt = "TreeView("
nl = vbCrLf & " "
' Serialize the root nodes.
For Each root_node In tree.Nodes
If root_node.Parent Is Nothing Then _
txt = txt & nl & "Root(" & vbCrLf & _
SerializeNode(root_node, 2) & _
nl & ")"
Next root_node txt = txt & vbCrLf & ")" SerializeTreeView = txt
End Function
' Initialize the TreeView's data using a serialization.
Public Sub UnSerializeTreeView(ByVal tree As TreeView, ByVal serialization As String)
Dim treeview_name As String
Dim treeview_value As String
Dim root_name As String
Dim root_value As String ' Make sure this is a TreeView serialization.
GetToken serialization, treeview_name, treeview_value
If treeview_name <> "TreeView" Then
MsgBox "Error initializing TreeView. This is not a TreeView serialization."
Exit Sub
End If ' Remove all the nodes.
tree.Nodes.Clear GetToken treeview_value, root_name, root_value
Do While root_name <> ""
' This better be a root serialization.
If root_name <> "Root" Then
MsgBox "Error reading TreeView serialization. Expected 'Root' but found '" & _
root_name & ".'"
Exit Sub
End If ' Unserialize the root. If there's an error,
' stop processing the serialization.
If UnSerializeNode(tree, Nothing, root_value) Then Exit Sub ' Get the next root serialization.
GetToken treeview_value, root_name, root_value
Loop
End Sub
' Return true if there is an error.
Public Function UnSerializeNode(ByVal tree As TreeView, ByVal par As Node, ByVal serialization As String) As Boolean
Dim new_node As Node
Dim basic_name As String
Dim basic_value As String
Dim token_name As String
Dim token_value As String
Dim val_Expanded As Boolean
Dim val_ExpandedImage As Variant
Dim val_Image As Variant
Dim val_Key As String
Dim val_Selected As Boolean
Dim val_SelectedImage As Variant
Dim val_Tag As String
Dim val_Text As String ' Assume we will fail.
UnSerializeNode = True
' Read the node's basic information.
GetToken serialization, basic_name, basic_value
If basic_name <> "BasicInfo" Then
MsgBox "Error reading Node serialization. Expected 'BasicInfo' but found '" & _
basic_name & ".'"
Exit Function
End If
' Read the information categories.
GetToken basic_value, token_name, token_value
Do While token_name <> ""
Select Case token_name
Case "Expanded"
val_Expanded = CBool(token_value)
Case "ExpandedImage"
If token_value = "" Then
val_ExpandedImage = Empty
Else
val_ExpandedImage = CInt(token_value)
End If
Case "Image"
If token_value = "" Then
val_Image = Empty
Else
val_Image = CInt(token_value)
End If
Case "Key"
val_Key = token_value
Case "Selected"
val_Selected = CBool(token_value)
Case "SelectedImage"
If token_value = "" Then
val_SelectedImage = Empty
Else
val_SelectedImage = CInt(token_value)
End If
Case "Tag"
val_Tag = token_value
Case "Text"
val_Text = token_value
End Select ' Get the next value.
GetToken basic_value, token_name, token_value
Loop ' Create the node.
If par Is Nothing Then
Set new_node = tree.Nodes.Add( _
, tvwChild, val_Key, val_Text, val_Image, val_SelectedImage)
Else
Set new_node = tree.Nodes.Add( _
par, tvwChild, val_Key, val_Text, val_Image, val_SelectedImage)
End If ' Set the node's other values.
new_node.Expanded = val_Expanded
new_node.ExpandedImage = val_ExpandedImage
new_node.Selected = val_Selected
new_node.Tag = val_Tag
' Unserialize the node's children.
GetToken serialization, token_name, token_value
Do While token_name <> ""
If token_name <> "Child" Then
MsgBox "Error reading Node serialization. Expected 'Child' but found '" & _
basic_name & ".'"
Exit Function
End If ' Unserialize the child.
If UnSerializeNode(tree, new_node, token_value) Then Exit Function ' Get the next child.
GetToken serialization, token_name, token_value
Loop ' No error occurred.
UnSerializeNode = False
End Function
' Return a string representing the Node's data.
' Serializations neither begin nor end with vbCrLf.
Public Function SerializeNode(ByVal par As Node, ByVal indent As Integer) As String
Dim txt As String
Dim child As Node
Dim nl As String ' Serialize this node's basic information.
txt = Space$(indent * 2) & "BasicInfo("
nl = vbCrLf & Space$((indent + 1) * 2) txt = txt & nl & "Expanded(" & par.Expanded & ")"
txt = txt & nl & "ExpandedImage(" & par.ExpandedImage & ")"
txt = txt & nl & "Image(" & par.Image & ")"
txt = txt & nl & "Key(" & par.Key & ")"
txt = txt & nl & "Selected(" & par.Selected & ")"
txt = txt & nl & "SelectedImage(" & par.SelectedImage & ")"
txt = txt & nl & "Tag(" & par.Tag & ")"
txt = txt & nl & "Text(" & par.Text & ")"
nl = vbCrLf & Space$(indent * 2)
txt = txt & nl & ")" ' Serialize the node's children.
Set child = par.child
Do While Not (child Is Nothing)
txt = txt & nl & "Child(" & vbCrLf & _
SerializeNode(child, indent + 1) & _
nl & ")"
Set child = child.Next
Loop SerializeNode = txt
End Function
' Prepare the ImageList and TreeView controls.
' ***********************************************
Private Sub Form_Load()
#Const LOAD_FROM_FILE = True ' False
Dim i As Integer
Dim txt As String
Dim fnum As Integer#If LOAD_FROM_FILE Then
#Else
Dim factory As Node
Dim group As Node
Dim person As Node
#End If ' Load pictures into the ImageList.
For i = 1 To 6
TreeImages.ListImages.Add , , TreeImage(i).Picture
Next i
' Attach the TreeView to the ImageList.
OrgTree.ImageList = TreeImages #If LOAD_FROM_FILE Then
' Load the serialization.
fnum = FreeFile
Open App.Path & "\treeview.ser" For Input As fnum
Input #fnum, txt
Close fnum
' Unserialize the TreeView.
UnSerializeTreeView OrgTree, txt
#Else
' Create some nodes.
Set factory = OrgTree.Nodes.Add(, , "f R & D", "R & D", otFactory, otFactory2)
Set group = OrgTree.Nodes.Add(factory, tvwChild, "g Engineering", "Engineering", otGroup, otGroup2)
Set person = OrgTree.Nodes.Add(group, tvwChild, "p Cameron, Charlie", "Cameron, Charlie", otPerson, otPerson2)
Set person = OrgTree.Nodes.Add(group, tvwChild, "p Davos, Debbie", "Davos, Debbie", otPerson, otPerson2)
person.EnsureVisible
Set group = OrgTree.Nodes.Add(factory, tvwChild, "g Test", "Test", otGroup, otGroup2)
Set person = OrgTree.Nodes.Add(group, tvwChild, "p Able, Andy", "Andy, Able", otPerson, otPerson2)
Set person = OrgTree.Nodes.Add(group, tvwChild, "p Baker, Betty", "Baker, Betty", otPerson, otPerson2)
person.EnsureVisible
Set factory = OrgTree.Nodes.Add(, , "f Sales & Support", "Sales & Support", otFactory, otFactory2)
Set group = OrgTree.Nodes.Add(factory, tvwChild, "g Showroom Sales", "Showroom Sales", otGroup, otGroup2)
Set person = OrgTree.Nodes.Add(group, tvwChild, "p Gaines, Gina", "Gaines, Gina", otPerson, otPerson2)
person.EnsureVisible
Set group = OrgTree.Nodes.Add(factory, tvwChild, "g Field Service", "Field Service", otGroup, otGroup2)
Set person = OrgTree.Nodes.Add(group, tvwChild, "p Helms, Harry", "Helms, Harry", otPerson, otPerson2)
Set person = OrgTree.Nodes.Add(group, tvwChild, "p Ives, Irma", "Ives, Irma", otPerson, otPerson2)
Set person = OrgTree.Nodes.Add(group, tvwChild, "p Jackson, Josh", "Jackson, Josh", otPerson, otPerson2)
person.EnsureVisible
Set group = OrgTree.Nodes.Add(factory, tvwChild, "g Customer Support", "Customer Support", otGroup, otGroup2)
Set person = OrgTree.Nodes.Add(group, tvwChild, "p Klug, Karl", "Klug, Karl", otPerson, otPerson2)
Set person = OrgTree.Nodes.Add(group, tvwChild, "p Landau, Linda", "Landau, Linda", otPerson, otPerson2)
person.EnsureVisible
#End If
End Sub
' ***********************************************
' Make the TreeView as large as possible.
' ***********************************************
Private Sub Form_Resize()
OrgTree.Move 0, 0, ScaleWidth, ScaleHeight
End Sub
' Save the TreeView data into a file.
Private Sub Form_Unload(Cancel As Integer)
Dim txt As String
Dim fnum As Integer fnum = FreeFile
Open App.Path & "\treeview.ser" For Output As fnum
txt = SerializeTreeView(OrgTree)
Write #fnum, txt
Close fnum
End Sub
' ***********************************************
' Save the node pressed so we can drag it later.
' ***********************************************
Private Sub OrgTree_MouseDown(Button As Integer, Shift As Integer, x As Single, y As Single)
Set SourceNode = OrgTree.HitTest(x, y)
End Sub' ***********************************************
' Start a drag if one is not in progress.
' ***********************************************
Private Sub OrgTree_MouseMove(Button As Integer, Shift As Integer, x As Single, y As Single)
If Button = vbLeftButton Then
' Start a new drag. Note that we do not get
' other MouseMove events while the drag is
' in progress.
' See what node we are dragging.
SourceType = NodeType(SourceNode) ' Select this node. When no node is highlighted,
' this node will be displayed as selected. That
' shows where it will land if dropped.
Set OrgTree.SelectedItem = SourceNode ' Set the drag icon for this source.
OrgTree.DragIcon = IconImage(SourceType)
OrgTree.Drag vbBeginDrag
End If
End Sub
' ***********************************************
' The user is dropping. See if the drop is valid.
' ***********************************************
Private Sub OrgTree_DragDrop(Source As Control, x As Single, y As Single)
If Not (OrgTree.DropHighlight Is Nothing) Then
' It's a valid drop. Set source node's
' parent to be the target node.
Set SourceNode.Parent = OrgTree.DropHighlight
Set OrgTree.DropHighlight = Nothing
End If Set SourceNode = Nothing
SourceType = otNone
End Sub
' ***********************************************
' The mouse is being dragged over the control.
' Highlight the appropriate node.
' ***********************************************
Private Sub OrgTree_DragOver(Source As Control, x As Single, y As Single, State As Integer)
Dim target As Node
Dim highlight As Boolean ' See what node we're above.
Set target = OrgTree.HitTest(x, y)
' If it's the same as last time, do nothing.
If target Is TargetNode Then Exit Sub
Set TargetNode = target
highlight = False
If Not (TargetNode Is Nothing) Then
' See what kind of node were above.
If NodeType(TargetNode) + 1 = SourceType Then _
highlight = True
End If
If highlight Then
Set OrgTree.DropHighlight = TargetNode
Else
Set OrgTree.DropHighlight = Nothing
End If
End Sub