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

📄 ftesttree.frm

📁 树状控件的一些相关操作
💻 FRM
📖 第 1 页 / 共 5 页
字号:

        Case [Menu Delete]
            moTree.CutIconState False                           '@@ v01.00.03
            Set moSelectedNode = tvwDialog.SelectedItem         '## Remember selected node
            cmdDialog_Click [Delete Node]                       '## Press Delete button
            txtDialog([Node Text]).Text = moSelectedNode.Text   '## Update screen with selected item
            cmdDialog_Click [Execute Mode]                      '## Press Go button & start delete action
            mbCutOperation = False                              '@@ v01.00.03
            mnuNode([Menu Paste]).Enabled = False               '@@

    End Select

End Sub

Private Sub mnuTree_Click(Index As Integer)     '@@ v01.00.01

    Select Case Index
        Case 0 To 5                             '## Home/PgUp/Up/ Down/PgDn/End
            cmdMove_Click Index                 '## Press designated TreeView Scroll Button
        Case 7 To 9                             '## Enable/Disable Drag'n'Drop/Label Edit/Hot Tracking
            With chkDialog(Index - 7)
                .Value = Abs(Not CBool(.Value)) '## Flip value
            End With
            chkDialog_Click Index - 7           '## Raise chkDialog Event
    End Select

End Sub

Private Sub tvwDialog_AfterLabelEdit(Cancel As Integer, NewString As String)
    '
    '## Note: TreeView events can also be directly handled from the form
    '
    '##--- ADO Code Start ----------------------------------
    If NewString <> msNodeText Then
        If Not pRenameRecord(tvwDialog.SelectedItem, NewString) Then
            MsgBox "Unable to rename the selected node.", _
                   vbApplicationModal + vbExclamation + vbOKOnly, _
                   "Rename Node"
            moSelectedNode.Text = msNodeText
        End If
        msNodeText = ""
    End If
    '##--- ADO Code End ------------------------------------
    pShowEvent "*Rename*"

End Sub

Private Sub tvwDialog_BeforeLabelEdit(Cancel As Integer)
    Set moSelectedNode = tvwDialog.SelectedItem
    msNodeText = moSelectedNode.Text
    pShowEvent "*Edit*"
End Sub

Private Sub tvwDialog_Collapse(ByVal Node As MSComctlLib.Node)
    Dim oTmr As cBenchmark                                  '@@ v01.00.03
    Set oTmr = New cBenchmark                               '@@
    oTmr.Start                                              '@@
    oTmr.Finish                                             '@@
    pShowTimer oTmr.ElapsedTime                             '@@
    pShowNodeDetails Node
    pShowEvent "*Collapsed*"
End Sub

Private Sub tvwDialog_Expand(ByVal Node As MSComctlLib.Node)

    Dim oTmr As cBenchmark                                  '@@ v01.00.03
    Set oTmr = New cBenchmark                               '@@

    pShowNodeDetails Node
    pShowEvent "*Expanded*"

    oTmr.Start                                              '@@ v01.00.03
    '##--- ADO Code Start ----------------------------------
    pExpandNode Node
    '##--- ADO Code End ------------------------------------
    oTmr.Finish                                             '@@ v01.00.03
    pShowTimer oTmr.ElapsedTime                             '@@
End Sub

Private Sub tvwDialog_KeyUp(KeyCode As Integer, Shift As Integer)
    Select Case KeyCode
        Case vbKeyDelete                                        '## Delete Node
            Set moSelectedNode = tvwDialog.SelectedItem         '## Remember selected node
            cmdDialog_Click [Delete Node]                       '## Press Delete button
            txtDialog([Node Text]).Text = moSelectedNode.Text   '## Update screen with selected item
            cmdDialog_Click [Execute Mode]                      '## Press Go button & start delete action
    End Select
End Sub

Private Sub txtDialog_GotFocus(Index As Integer)
    '
    '## Reset Event Label
    '
    pShowEvent ""
    '
    '## Select all text in the selected Textbox control
    '
    pHiLite txtDialog(Index)
    Select Case Index
        '
        '## First Textbox
        '
        Case [Node Text]
            meFocus = [Node Text]       '## Capture textbox focus
            Select Case meMode
                Case [Add Node]
                    '
                    '## Give user instructions
                    '
                    lblComments.Caption = "Enter the description of the new node."
                Case [Rename Node]
                    lblComments.Caption = "Select/Click the node to be renamed."
                Case [Move Node]
                    lblComments.Caption = "Select/Click the node to be moved."
                Case [Copy Node]                                                    '@@ v01.00.03
                    lblComments.Caption = "Select/Click the node to be copied."     '@@
                Case [Delete Node]
                    lblComments.Caption = "Select/Click the node to be deleted."
            End Select
        '
        '## Second Textbox
        '
        Case [Parent Node]
            meFocus = [Parent Node]     '## Capture textbox focus
            Select Case meMode
                Case [Add Node]
                    lblComments.Caption = "Select/Click the parent node (If not a root node)."
                Case [Rename Node]
                    lblComments.Caption = "Enter the new description of the selected node."
                Case [Move Node], [Copy Node]                                       '@@ v01.00.03
                    lblComments.Caption = "Select/Click the destination node."
            End Select

    End Select
End Sub

Private Sub txtDialog_KeyPress(Index As Integer, KeyAscii As Integer)
    Select Case Index
        '
        '## First Textbox
        '
        Case [Node Text]
            Select Case meMode
                Case [Rename Node], [Move Node], [Copy Node], [Delete Node] '@@ v01.00.03
'                Case [Rename Node], [Move Node], [Delete Node]
                    '
                    '## We only want the user to click on a node
                    '
                    KeyAscii = 0
                    Beep
            End Select
        '
        '## Second Textbox
        '
        Case [Parent Node]
            Select Case meMode
                Case [Add Node], [Move Node], [Copy Node]                   '@@ v01.00.03
'                Case [Add Node], [Move Node]
                    '
                    '## We only want the user to click on a node
                    '
                    KeyAscii = 0
                    Beep
            End Select

    End Select
End Sub

Private Sub txtDialog_LostFocus(Index As Integer)
    lblComments.Caption = ""
End Sub

'===========================================================================
' Form Events: Find controls
'
Private Sub cmdFind_Click(Index As Integer)

    Dim oBusy As cHourglass

    Set oBusy = New cHourglass
    Select Case Index
        Case [Find First]
            If Not pFindFirst Then
                Set oBusy = Nothing
                MsgBox "No record found.", _
                       vbApplicationModal + vbInformation + vbOKOnly, _
                       "Find Record"
                txtFind.SetFocus
            Else
                tvwDialog.SetFocus
            End If

        Case [Find Next]
            If Not pFindNext Then
                If mbFindNext Then
                    Set oBusy = Nothing
                    MsgBox "No further records found.", _
                           vbApplicationModal + vbInformation + vbOKOnly, _
                           "Find Record"
                Else
                    Set oBusy = Nothing
                    MsgBox "No record found.", _
                           vbApplicationModal + vbInformation + vbOKOnly, _
                           "Find Record"
                End If
                txtFind.SetFocus
            Else
                tvwDialog.SetFocus
            End If

        Case [Find Previous]
            If Not pFindPrevious Then
                If mbFindNext Then
                    Set oBusy = Nothing
                    MsgBox "No further records found.", _
                           vbApplicationModal + vbInformation + vbOKOnly, _
                           "Find Record"
                Else
                    Set oBusy = Nothing
                    MsgBox "No record found.", _
                           vbApplicationModal + vbInformation + vbOKOnly, _
                           "Find Record"
                End If
                txtFind.SetFocus
            Else
                tvwDialog.SetFocus
            End If

    End Select

End Sub

Private Sub optFind_Click(Index As Integer)
    meFindMode = CByte(Abs(optFind([Product]).Value = True))
    pFindReset
End Sub

Private Sub txtFind_Change()
    pFindReset
    cmdFind([Find First]).Enabled = (Len(txtFind.Text) > 0)
End Sub

Private Sub txtFind_GotFocus()
    pHiLite txtFind
End Sub

'===========================================================================
' cTreeView Class Events
'
Private Sub moTree_CopyNode(DestNode As MSComctlLib.Node, SrcNode As MSComctlLib.Node)  '@@ v01.00.03
    '
    '## Raised by moTree.NodeCopy to do the physical operation. Cannot be done from
    '   within the class due to too many external factors. In this case the key
    '   is the same one used in the database with a prefix - therefore needs to
    '   be generated external to the cTreeView class.
    '
    Dim eAddType As eFindMode
    Dim lID      As Long
    Dim oNode    As MSComctlLib.Node

    Select Case Left$(SrcNode.Key, 1)                   '## Extract node type
        Case "N": eAddType = [Group]
        Case "P": eAddType = [Product]
    End Select
    txtDialog([Node Text]).Text = SrcNode.Text          '## Set AddNode Text
    lID = pAddRecord(eAddType, DestNode)                '## Add the SrcNode
    If lID Then                                         '## Did we add it successfully to the Database?
        Set oNode = pAddNode(eAddType, SrcNode.Text, lID, DestNode) '## Yes. Add Node to TreeView
        If Len(msCopyKey) = 0 Then                      '## Have we caputed the first copied node's key?
            msCopyKey = oNode.Key                       '## No. Better do it then. (Used at end to select)
        End If
    Else
        moTree.CancelCopy = True                        '## No. Cancel copying nodes due to DB error!!
    End If

End Sub

Private Sub moTree_ContextMenu(Node As MSComctlLib.Node, x As Single, y As Single)
    '
    '## Right Button was pressed requesting a Context/Popup menu
    '
    Debug.Print ">> "; Me.Name; ".moTree::ContextMenu -> Node.Text = ";

    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]"
        With mnuPopTree                             '@@ v01.00.03
            .Visible = True                         '@@ Required if popup menu is a child of
            .Enabled = True                         '@@ another popup menu
        End With                                    '@@
    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(8).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

⌨️ 快捷键说明

复制代码 Ctrl + C
搜索代码 Ctrl + F
全屏模式 F11
切换主题 Ctrl + Shift + D
显示快捷键 ?
增大字号 Ctrl + =
减小字号 Ctrl + -