⭐ 欢迎来到虫虫下载站! | 📦 资源下载 📁 资源专辑 ℹ️ 关于我们
⭐ 虫虫下载站

📄 ftesttree.frm

📁 用Treeview来显示每个Field
💻 FRM
📖 第 1 页 / 共 5 页
字号:
    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 + -