ftesttree.frm

树状控件的一些相关操作

Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
'===========================================================================
'
' Form Name:    fTestTree
' Author:       Graeme Grant
' Date:         28/09/2001
' Version:      01.00.03            (Version is inline with cTREEVIEW class)
' Description:  Test/Demo TreeView Handler
' Edit History: 01.00.00 18/09/2001 Initial Release
'               01.00.01 21/09/2001 Added Pop-up Menus
'               01.00.01 21/09/2001 Added Icons
'               01.00.01 21/09/2001 Fixed bug with find code not enabling
'                                   next/previous buttons and continuing the
'                                   search under certain conditions.
'               01.00.03 28/09/2001 Added benchmarking for testing purposes
'                                   to maximise performance
'               01.00.03 28/09/2001 Add new 'Copy Node' Feature
'               01.00.03 28/09/2001 Added pAddNode & pAddRecord
'               01.00.03 28/09/0201 Added Action timer code to track
'                                   performance of routines
'               01.00.03 28/09/2001 Added Cut, Copy, Paste to Node Menu
'               01.00.03 28/09/2001 Made Treeview context menu a submenu of
'                                   node contect menu
'               01.00.03 28/09/2001 Adjusted pExpand Node to handle group
'                                   nodes without 'Dummy' hidden nodes
'
' Notes:        01.00.01 21/09/2001 When working with TreeView & ImageList
'                                   controls with icons, the ImageList
'                                   control doesn't check the screen colour
'                                   depth - it just grabs the first icon
'                                   of the designated size from the captured
'                                   icon file. Not the displayed icon when
'                                   viewing the contents of the ImageList
'                                   control. Threrefore to have the correct
'                                   icon displayed in the TreeView control
'                                   you must extract the correct image from
'                                   the icon (.ICO) file using an icon
'                                   extraction utility.
'
'===========================================================================

Option Explicit

'===========================================================================
' Private: Variables and Declarations声明变量
'
Private Const clPRODCOLOR As Long = &H800080    '@@ v01.00.03

Private WithEvents moTree As cTreeView
Attribute moTree.VB_VarHelpID = -1
Private moSelectedNode    As MSComctlLib.Node 'MSComctlLib是一个类型库，当你引用了Windows Common Control部件时，会自动导入
Private moDestNode        As MSComctlLib.Node
Private msDragTarget      As String
Private msNodeText        As String
Private meMode            As eCommand
Private meFocus           As eTextBox
Private mbIsDirty         As Boolean
Private mbCutOperation    As Boolean            '@@ v01.00.03
Private msCopyKey         As String             '@@

Private Enum eNodeMenu                          '枚举是一个被命名的整型常数的集合

    [Menu Add] = 0
    [Menu Move] = 1
    [Menu Cut] = 3
    [Menu Copy] = 4
    [Menu Paste] = 5
    [Menu Delete] = 7
    [Menu Rename] = 8
End Enum

Private Enum eCommand
    [Add Node] = 0
    [Rename Node] = 1
    [Move Node] = 2
    [Copy Node] = 3
    [Delete Node] = 4
    [Execute Mode] = 5
End Enum

Private Enum eTextBox
    [No Selection] = -1
    [Node Text] = 0
    [Parent Node] = 1
End Enum

Private Enum eCheck
    [Drag Drop] = 0
    [Label Edit] = 1
    [HotTracking] = 2
    [Action Option] = 3
End Enum

Private Enum eCommandFind
    [Find First] = 0
    [Find Next] = 1
    [Find Previous] = 2
End Enum

Private Enum eFindMode
    [Group] = 0
    [Product] = 1
End Enum

'===========================================================================
' Private: ADO Declarations定义SQL查询语句
'
'## Get Groups by Group ID
Private Const mcSQL_GRP1  As String = "SELECT DISTINCTROW Desc, GroupID, PkID " + _
                                      "FROM [Group] " + _
                                      "WHERE ((Active)=True) and ((Type)=0) and ((GroupID)="
Private Const mcSQL_GRP2  As String = ") ORDER BY GroupID, SeqNum, PkID"

'## Get Products by Group ID
Private Const mcSQL_PROD1 As String = "SELECT DISTINCTROW Desc, PkID " + _
                                      "FROM [Product] " + _
                                      "WHERE ((GroupID)="
Private Const mcSQL_PROD2 As String = ") and ((Active)=True) " + _
                                      "ORDER BY Code"

'## Add Group
Private Const mcSQL_AGRP  As String = "INSERT INTO [GROUP] ([Desc], [GroupID], [Type], [Active])" + _
                                      "VALUES (?, ?, ?, ?) "
'## Update Group Link ID
Private Const mcSQL_UGRP1 As String = "UPDATE DISTINCTROW [Group] " + _
                                      "SET [Group].GroupID = "
Private Const mcSQL_UGRP2 As String = " WHERE (((Group.PkID)="
Private Const mcSQL_UGRP3 As String = "))"

'## Rename Group
Private Const mcSQL_RGRP1 As String = "UPDATE DISTINCTROW [Group] " + _
                                      "SET [Group].Desc = '"
Private Const mcSQL_RGRP2 As String = "' WHERE (((Group.PkID)="
Private Const mcSQL_RGRP3 As String = "))"

'## Delete Group
Private Const mcSQL_DGRP1 As String = "DELETE DISTINCTROW Group.PkID " + _
                                      "FROM [Group] " + _
                                      "WHERE (((Group.PkID)="
Private Const mcSQL_DGRP2 As String = "))"

'## Update Product Group Link ID
Private Const mcSQL_UPRD1 As String = "UPDATE DISTINCTROW Product " + _
                                      "SET Product.GroupID = "
Private Const mcSQL_UPRD2 As String = " WHERE (((Product.PkID)="
Private Const mcSQL_UPRD3 As String = "))"

'## Add Product
Private Const mcSQL_APRD  As String = "INSERT INTO [Product] ([Desc], [GroupID], [Active])" + _
                                      "VALUES (?, ?, ?) "

'## Rename Product
Private Const mcSQL_RPRD1 As String = "UPDATE DISTINCTROW Product " + _
                                      "SET Product.Desc = '"
Private Const mcSQL_RPRD2 As String = "' WHERE (((Product.PkID)="
Private Const mcSQL_RPRD3 As String = "))"

'## Delete Product
Private Const mcSQL_DPRD1 As String = "DELETE DISTINCTROW Product.PkID " + _
                                      "FROM Product " + _
                                      "WHERE (((Product.PkID)="
Private Const mcSQL_DPRD2 As String = "))"

'## Find Group By Desc
Private Const mcSQL_FGRP  As String = "SELECT DISTINCTROW PkID, Desc, GroupID " + _
                                      "FROM [Group] " + _
                                      "WHERE ((Active)=True)  AND (Type=0) " + _
                                      "ORDER BY GroupID, SeqNum, PkID"

'## Find Product By Desc
Private Const mcSQL_FPRD  As String = "SELECT DISTINCTROW PkID, Desc, GroupID " + _
                                      "FROM [Product] " + _
                                      "WHERE ((Active)=True) " + _
                                      "ORDER BY Code"

Private moFindRS    As ADODB.Recordset
Private moGrpRS     As ADODB.Recordset
Private mbFindNext  As Boolean
Private meFindMode  As eFindMode    'efindmode为枚举数值
Private mcDB        As cDB          'cdb为类模块
Private mbIsBusy    As Boolean


Private Sub chkDialog_Click(Index As Integer) '复选框选项

    Dim bState As Boolean

    bState = CBool(chkDialog(Index).Value = 1) '返回布尔类型
    With moTree
        Select Case Index                                               '@@ v01.00.03
            Case [Action Option]                                        '@@
                '## Just in case we want to do something here....
            Case Else                                                   '@@
                Select Case Index
                    Case [Drag Drop]:   .DragEnabled = bState
                    Case [Label Edit]:  .Ctrl.LabelEdit = CByte(Abs(bState = False))
                    Case [HotTracking]: .Ctrl.HotTracking = bState
                End Select
                '
                '## mnuTree Pop-up Menu enable/disable checks
                '
                mnuTree(Index + 7).Checked = chkDialog(Index).Value     '@@ v01.00.01 Adjust pop menu checks
            End Select                                                  '@@ v01.00.03
    End With
End Sub

Private Sub cmdDialog_Click(Index As Integer)
    '
    '## Add/Rename/Move/Copy/Delete/Execute
    '
    Action Index        'action(state as integer)方法？

End Sub

Private Sub cmdDialog_GotFocus(Index As Integer)   '当焦点进入对象或子控件时，发生该事件
    pShowEvent ""          'pshowevent(stxt as string)
    meFocus = [No Selection] '已定义meFocus为枚举类型[No Selection] = -1
End Sub

Private Sub cmdMove_Click(Index As Integer)        '移动按钮控制
    
    Dim oTmr As cBenchmark                                  'cBenchmark 为类模块
    Set oTmr = New cBenchmark                               '@@
    oTmr.Start                                              'start
    
    With moTree
        .ScrollView CByte(Index)                            '@@ cTREEVIEW.CLS (v01.00.01) example
        .Ctrl.SetFocus
    End With

    oTmr.Finish                                             'finish
    pShowTimer oTmr.ElapsedTime                             'pshowtimer?  在lable上显示耗时
    Select Case Index                                       '@@ 显示相应操作
        Case [Home]:      pShowEvent "*Move: Home*"         '@@
        Case [Page Up]:   pShowEvent "*Move: PgUp*"         '@@
        Case [Up]:        pShowEvent "*Move: Up*"           '@@
        Case [Down]:      pShowEvent "*Move: Down*"         '@@
        Case [Page Down]: pShowEvent "*Move: PgDn*"         '@@
        Case [End]:       pShowEvent "*Move: End*"          '@@
    End Select                                              '@@

End Sub

Private Sub Form_Load()

    Set moTree = New cTreeView 'ctreeview为类模块

    With moTree
        '
        '## Hook treeview control
        '
        .HookCtrl tvwDialog
        .Redraw False
        '
        '##  TreeView控件设置
        '
        With .Ctrl
            .Style = tvwTreelinesPlusMinusPictureText
            .LineStyle = tvwRootLines
            .Indentation = 10
            .ImageList = imgDialog
            .FullRowSelect = False
            .HideSelection = False
            .HotTracking = True
            '##--- ADO Code Start ----------------------------------
            '
            '## Build TreeView data
            '
            pInitData                   'pInitData为本模块自定义过程
            '
            '##--- ADO Code End ------------------------------------
            pShowNodeDetails .SelectedItem
        End With
        .ContextMenuMode = [After Click]
        .DragEnabled = True
        .Redraw True
    End With
    meFocus = [No Selection]        '## Set Textbox focus to nothing
    optFind([Product]).Value = True '## Set find option default to product
    FlatBorder txtFind.hwnd         '## Give the find box a flat border

End Sub

Private Sub Form_Unload(Cancel As Integer)
    Set moTree = Nothing
End Sub

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

    'Set moSelectedNode = tvwDialog.SelectedItem                 '## Remember selected node
    Select Case Index
        Case [Menu Add]
            moTree.CutIconState False                           '@@ v01.00.03
            Set moSelectedNode = tvwDialog.SelectedItem         '## Remember selected node
            cmdDialog_Click [Add Node]                          '## Press Add button
            txtDialog([Parent Node]).Text = moSelectedNode.Text '## Update screen with selected item
            txtDialog([Node Text]).SetFocus                     '## Set focus to the next step
            mbCutOperation = False                              '@@ v01.00.03
            mnuNode([Menu Paste]).Enabled = False               '@@

        Case [Menu Rename]
            moTree.CutIconState False                           '@@ v01.00.03
            Set moSelectedNode = tvwDialog.SelectedItem         '## Remember selected node
            cmdDialog_Click [Rename Node]                       '## Press Rename button
            txtDialog([Node Text]).Text = moSelectedNode.Text   '## Update screen with selected item
            txtDialog([Parent Node]).SetFocus                   '## Set focus to the next step
            mbCutOperation = False                              '@@ v01.00.03
            mnuNode([Menu Paste]).Enabled = False               '@@

        Case [Menu Move]
            moTree.CutIconState False                           '@@ v01.00.03
            Set moSelectedNode = tvwDialog.SelectedItem         '## Remember selected node
            cmdDialog_Click [Move Node]                         '## Press Move button
            txtDialog([Node Text]).Text = moSelectedNode.Text   '## Update screen with selected item
            txtDialog([Parent Node]).SetFocus                   '## Set focus to the next step
            mbCutOperation = False                              '@@ v01.00.03
            mnuNode([Menu Paste]).Enabled = False               '@@

        Case [Menu Cut]                                         '@@ v01.00.03
            moTree.CutIconState True                            '@@
            Set moSelectedNode = tvwDialog.SelectedItem         '@@ Remember selected node
            mbCutOperation = True                               '@@
            cmdDialog_Click [Move Node]                         '@@ Press Move button
            txtDialog([Node Text]).Text = moSelectedNode.Text   '@@ Update screen with selected item
            txtDialog([Parent Node]).SetFocus                   '@@ Set focus to the next step
            mnuNode([Menu Paste]).Enabled = True                '@@

        Case [Menu Paste]                                       '@@ v01.00.03
            moTree.CutIconState False                           '@@
            Set moDestNode = tvwDialog.SelectedItem             '@@ Remember selected node
            txtDialog([Parent Node]).Text = moDestNode.Text     '@@
            If meMode = [Copy Node] Then
                chkDialog([Action Option]).Value = _
                    Abs(CInt(MsgBox("Include all child nodes in Copy Paste operation?", _
                                    vbDefaultButton1 + vbQuestion + vbYesNo, _
                                    "Copy Node(s)") = vbYes))   '@@
            End If                                              '@@
            cmdDialog_Click [Execute Mode]                      '@@ Execute action
            mnuNode([Menu Paste]).Enabled = False               '@@

        Case [Menu Copy]                                        '@@ v01.00.03
            moTree.CutIconState False                           '@@
            Set moSelectedNode = tvwDialog.SelectedItem         '@@ Remember selected node
            cmdDialog_Click [Copy Node]                         '@@ Press Copy button
            txtDialog([Node Text]).Text = moSelectedNode.Text   '@@ Update screen with selected item
            txtDialog([Parent Node]).SetFocus                   '@@ Set focus to the next step
            mbCutOperation = False                              '@@
            mnuNode([Menu Paste]).Enabled = True                '@@