📄 ftesttree.frm
字号:
pShowNodeDetails Node
pShowEvent "ContextMenu"
If Not (Node Is Nothing) Then
'
'## Show popup menu for the specific node
'
Me.PopupMenu mnuPopNode, _
vbPopupMenuLeftAlign + vbPopupMenuRightButton, _
tvwDialog.Left + X, tvwDialog.Top + Y '@@ v01.00.01
Debug.Print "'"; Node.Text; "'"
Else
'
'## Background clicked instead of node. Show popup menu for TreeView and not a node
'
Me.PopupMenu mnuPopTree, _
vbPopupMenuLeftAlign + vbPopupMenuRightButton, _
tvwDialog.Left + X, tvwDialog.Top + Y '@@ v01.00.01
Debug.Print "[Control Menu]"
End If
End Sub
Private Sub moTree_StartDrag(SourceNode As MSComctlLib.Node)
'
'## We've started dragging a node
'
Debug.Print "++ Start Drag Node = '"; SourceNode.Text; "'"
pShowNodeDetails SourceNode
pShowEvent "StartDrag"
End Sub
Private Sub moTree_Dragging(SourceNode As MSComctlLib.Node, TargetParent As MSComctlLib.Node)
'
'## Node being dragged
'
If msDragTarget <> TargetParent.Text Then '## Only proceed if a different node
Debug.Print "++ Dragging Node = '"; SourceNode.Text; "' with target node = '"; TargetParent.Text; "'"
msDragTarget = TargetParent.Text
If Left$(SourceNode.Key, 1) = "N" Then '@@ v01.00.01
tvwDialog.DragIcon = imgDialog.ListImages(5).Picture '@@ Set drag icon to type of node
Else '@@
tvwDialog.DragIcon = imgDialog.ListImages(7).Picture '@@ Note: This overrides cTREEVIEW
End If '@@ Class DragIcon
pShowEvent "Dragging"
End If
End Sub
Private Sub moTree_Dropped(SourceNode As MSComctlLib.Node, TargetParent As MSComctlLib.Node)
'
'## Node has been dropped - Now what to do with it...
'
Debug.Print "++ Dropped Node = '"; SourceNode.Text; "'"
'
'## Move the dragged node
'
pShowEvent "Dropped"
'If Not moTree.NodeMove(TargetParent, SourceNode) Then
If Not pMoveRecord(SourceNode, TargetParent) Then '!! ADO Code
'
'## Problems with moving the node. Most likely a root node was dragged!
'
MsgBox "Unable to move the selected node.", _
vbApplicationModal + vbExclamation + vbOKOnly, _
App.Title
End If
pShowNodeDetails SourceNode
End Sub
Private Sub moTree_Selected(Node As MSComctlLib.Node)
'
'## A Node has been selected
'
With Node
If InStr(.Key, "P") Then
Debug.Print "## Product = [" + .Text + "]", "PkID = [" + Mid$(.Key, 2) + "]"
Else
Debug.Print "## Node Click = [" + .Text + "]"
End If
End With
pShowNodeDetails Node
pShowEvent "Selected"
'
'## Pass the text of the selected node to the correct Textbox based on the selected action
'
Select Case meFocus
Case [Node Text]
Select Case meMode
Case [Rename Node], [Move Node], [Delete Node]
txtDialog([Node Text]).Text = Node.Text
With txtDialog([Parent Node])
'
'## Set the focus to the next control
'
If .Visible Then
.SetFocus
Else
cmdDialog([Execute Mode]).SetFocus
End If
End With
'
'## Store the selected node
'
Set moSelectedNode = Node
End Select
Case [Parent Node]
Select Case meMode
Case [Add Node], [Move Node]
txtDialog([Parent Node]).Text = Node.Text
cmdDialog([Execute Mode]).SetFocus
If meMode = [Move Node] Then
Set moDestNode = Node
Else
Set moSelectedNode = Node
End If
End Select
End Select
End Sub
'===========================================================================
' Private subroutines and functions
'
Private Sub Action(State As Integer)
Dim sText As String
Dim oNode As MSComctlLib.Node
Select Case State
'
'## Setup user frame and contained controls based on action
'
Case [Add Node]
meMode = [Add Node]
fraDialog.Caption = "Add Node:"
With lblDialog([Node Text])
.Caption = "Node Text: "
.Visible = True
End With
With txtDialog([Node Text])
.Text = ""
.Visible = True
.SetFocus
End With
With lblDialog([Parent Node])
.Caption = "Parent Node: "
.Visible = True
End With
With txtDialog([Parent Node])
.Text = ""
.Visible = True
End With
With cmdDialog([Execute Mode])
.Top = lblDialog([Parent Node]).Top
.Visible = True
End With
Case [Rename Node]
meMode = [Rename Node]
fraDialog.Caption = "Rename Node:"
With lblDialog([Node Text])
.Caption = "Old Node Text: "
.Visible = True
End With
With txtDialog([Node Text])
.Text = ""
.Visible = True
.SetFocus
End With
With lblDialog([Parent Node])
.Caption = "New Node Text: "
.Visible = True
End With
With txtDialog([Parent Node])
.Text = ""
.Visible = True
End With
With cmdDialog([Execute Mode])
.Top = lblDialog([Node Text]).Top
.Visible = True
End With
Case [Move Node]
meMode = [Move Node]
fraDialog.Caption = "Move Node:"
With lblDialog([Node Text])
.Caption = "From Node: "
.Visible = True
End With
With txtDialog([Node Text])
.Text = ""
.Visible = True
.SetFocus
End With
With lblDialog([Parent Node])
.Caption = "To Node: "
.Visible = True
End With
With txtDialog([Parent Node])
.Text = ""
.Visible = True
End With
With cmdDialog([Execute Mode])
.Top = lblDialog([Node Text]).Top
.Visible = True
End With
Case [Delete Node]
meMode = [Delete Node]
fraDialog.Caption = "Delete Node:"
With lblDialog([Node Text])
.Caption = "Node: "
.Visible = True
End With
With txtDialog([Node Text])
.Text = ""
.Visible = True
.SetFocus
End With
lblDialog([Parent Node]).Visible = False
txtDialog([Parent Node]).Visible = False
With cmdDialog([Execute Mode])
.Top = lblDialog([Node Text]).Top
.Visible = True
End With
'
'## Time to put the wheels in motion
'
Case [Execute Mode]
Select Case meMode
Case [Add Node]
On Error Resume Next
If Len(txtDialog([Node Text]).Text) Then
sText = txtDialog([Node Text]).Text
If Len(txtDialog([Parent Node]).Text) Then
'
'## If a destination node then node will be a child
'
If (moTree.NodeFind(oNode, sText, sText)) Then
MsgBox "Node already exists.", _
vbApplicationModal + vbExclamation + vbOKOnly, _
"Add Node"
Else
moTree.NodeAdd moSelectedNode.Key, tvwChild, sText, sText, , , , , , True
End If
Else
'
'## No Destination means node will be a root node
'
If (moTree.NodeFind(oNode, sText, sText)) Then
MsgBox "Node already exists.", _
vbApplicationModal + vbExclamation + vbOKOnly, _
"Add Node"
Else
moTree.NodeAdd , , sText, sText, , , , , , , , True
End If
End If
'
'## NodeAdd had a problem
'
If Err.Number Then
MsgBox "Error adding node.", _
vbApplicationModal + vbExclamation + vbOKOnly, _
"Add Node"
Err.Number = 0
Set moSelectedNode = Nothing
txtDialog([Parent Node]).Text = ""
txtDialog([Node Text]).SetFocus
Else
pShowEvent "[Added]"
tvwDialog.SetFocus
End If
Else
'
'## No text was entered for the new node
'
MsgBox "No new text entered.", _
vbApplicationModal + vbExclamation + vbOKOnly, _
"Add Node"
txtDialog([Node Text]).SetFocus
End If
Case [Rename Node]
If Len(txtDialog([Node Text]).Text) Then
If Len(txtDialog([Parent Node]).Text) Then
'If Not moTree.NodeRename(moSelectedNode, txtDialog([Parent Node]).Text, True) Then
If Not pRenameRecord(moSelectedNode, txtDialog([Parent Node]).Text) Then '!! ADO Code
'
'## Problem with renaming the node
'
MsgBox "Unable to rename the selected node.", _
vbApplicationModal + vbExclamation + vbOKOnly, _
"Rename Node"
txtDialog([Parent Node]).SetFocus
Else
pShowEvent "[Renamed]"
tvwDialog.SetFocus
End If
Else
'
'## No text was entered
'
MsgBox "No new text entered.", _
vbApplicationModal + vbExclamation + vbOKOnly, _
"Rename Node"
txtDialog([Parent Node]).SetFocus
End If
Else
'
'## No node was selected
'
MsgBox "No node to be renamed was selected.", _
vbApplicationModal + vbExclamation + vbOKOnly, _
"Rename Node"
txtDialog([Node Text]).SetFocus
End If
Case [Move Node]
If Len(txtDialog([Node Text]).Text) Then
If Len(txtDialog([Parent Node]).Text) Then
'If Not moTree.NodeMove(moDestNode, moSelectedNode, True) Then
If Not pMoveRecord(moSelectedNode, moDestNode) Then '!! ADO Code
'
'## Problem moving the node. Most likely a root node was selected.
'
MsgBox "Unable to move the selected node.", _
vbApplicationModal + vbExclamation + vbOKOnly, _
"Move Node"
txtDialog([Node Text]).SetFocus
Else
pShowEvent "[Moved]"
tvwDialog.SetFocus
End If
Else
'
'## No destination node selected
'
MsgBox "No Destination node selected.", _
vbApplicationModal + vbExclamation + vbOKOnly, _
"Move Node"
txtDialog([Parent Node]).SetFocus
End If
Else
'
'## No source node selected
'
MsgBox "No Source node selected.", _
vbApplicationModal + vbExclamation + vbOKOnly, _
"Move Node"
txtDialog([Node Text]).SetFocus
End If
Case [Delete Node]
If Len(txtDialog([Node Text]).Text) Then
If (MsgBox("Are you sure?", _
vbApplicationModal + vbDefaultButton2 + vbQuestion + vbYesNo, _
"Delete Node: " + moSelectedNode.Text) = vbYes) Then '!! ADO Code version
' If (MsgBox("Child Nodes will also be deleted. Are you sure?", _
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -