ftesttree.frm

用Treeview来显示每个Field

         TabIndex        =   27
         Top             =   1260
         Width           =   1275
      End
      Begin VB.Label lblDetail 
         Alignment       =   1  'Right Justify
         BackColor       =   &H00808080&
         Caption         =   "Text: "
         BeginProperty Font 
            Name            =   "Tahoma"
            Size            =   8.25
            Charset         =   0
            Weight          =   700
            Underline       =   0   'False
            Italic          =   0   'False
            Strikethrough   =   0   'False
         EndProperty
         ForeColor       =   &H8000000E&
         Height          =   300
         Index           =   0
         Left            =   105
         TabIndex        =   23
         Top             =   315
         Width           =   1275
      End
   End
   Begin VB.CommandButton cmdDialog 
      Caption         =   "Delete"
      Height          =   315
      Index           =   3
      Left            =   5985
      TabIndex        =   12
      Top             =   105
      Width           =   750
   End
   Begin VB.CommandButton cmdDialog 
      Caption         =   "Move"
      Height          =   315
      Index           =   2
      Left            =   5145
      TabIndex        =   11
      Top             =   105
      Width           =   750
   End
   Begin VB.CommandButton cmdDialog 
      Caption         =   "Rename"
      Height          =   315
      Index           =   1
      Left            =   4305
      TabIndex        =   10
      Top             =   105
      Width           =   750
   End
   Begin VB.CommandButton cmdDialog 
      Caption         =   "Add"
      Enabled         =   0   'False
      Height          =   315
      Index           =   0
      Left            =   3465
      TabIndex        =   9
      Top             =   105
      Width           =   750
   End
   Begin VB.Frame fraDialog 
      Height          =   1485
      Left            =   3465
      TabIndex        =   15
      Top             =   500
      Width           =   5790
      Begin VB.TextBox txtDialog 
         Appearance      =   0  'Flat
         Height          =   315
         Index           =   1
         Left            =   1575
         TabIndex        =   19
         Top             =   630
         Visible         =   0   'False
         Width           =   3165
      End
      Begin VB.CommandButton cmdDialog 
         Caption         =   "Go"
         Height          =   330
         Index           =   4
         Left            =   4830
         TabIndex        =   20
         Top             =   630
         Visible         =   0   'False
         Width           =   750
      End
      Begin VB.TextBox txtDialog 
         Appearance      =   0  'Flat
         Height          =   315
         Index           =   0
         Left            =   1575
         TabIndex        =   17
         Top             =   210
         Visible         =   0   'False
         Width           =   3165
      End
      Begin VB.Label lblComments 
         Alignment       =   2  'Center
         Appearance      =   0  'Flat
         BackColor       =   &H80000018&
         BeginProperty Font 
            Name            =   "Tahoma"
            Size            =   9.75
            Charset         =   0
            Weight          =   400
            Underline       =   0   'False
            Italic          =   0   'False
            Strikethrough   =   0   'False
         EndProperty
         ForeColor       =   &H000000FF&
         Height          =   330
         Left            =   210
         TabIndex        =   21
         Top             =   1050
         Width           =   5370
      End
      Begin VB.Label lblDialog 
         Alignment       =   1  'Right Justify
         BackColor       =   &H00C0C0C0&
         Caption         =   "Node Text: "
         Height          =   315
         Index           =   0
         Left            =   210
         TabIndex        =   16
         Top             =   210
         Visible         =   0   'False
         Width           =   1275
      End
      Begin VB.Label lblDialog 
         Alignment       =   1  'Right Justify
         BackColor       =   &H00C0C0C0&
         Caption         =   "Parent Node: "
         Height          =   315
         Index           =   1
         Left            =   210
         TabIndex        =   18
         Top             =   630
         Visible         =   0   'False
         Width           =   1275
      End
   End
   Begin VB.Label lblEvent 
      Alignment       =   2  'Center
      Appearance      =   0  'Flat
      BackColor       =   &H80000018&
      BorderStyle     =   1  'Fixed Single
      ForeColor       =   &H80000008&
      Height          =   315
      Index           =   1
      Left            =   7980
      TabIndex        =   14
      Top             =   105
      Width           =   1275
   End
   Begin VB.Label lblEvent 
      Alignment       =   1  'Right Justify
      BackColor       =   &H80000010&
      Caption         =   "Last Event: "
      ForeColor       =   &H80000014&
      Height          =   315
      Index           =   0
      Left            =   6825
      TabIndex        =   13
      Top             =   105
      Width           =   1065
   End
   Begin VB.Menu mnuPopNode 
      Caption         =   "PopNode"
      Visible         =   0   'False
      Begin VB.Menu mnuNode 
         Caption         =   "&Add"
         Enabled         =   0   'False
         Index           =   0
      End
      Begin VB.Menu mnuNode 
         Caption         =   "&Rename"
         Index           =   1
      End
      Begin VB.Menu mnuNode 
         Caption         =   "&Move"
         Index           =   2
      End
      Begin VB.Menu mnuNode 
         Caption         =   "&Delete"
         Index           =   3
      End
   End
   Begin VB.Menu mnuPopTree 
      Caption         =   "PopTree"
      Visible         =   0   'False
      Begin VB.Menu mnuTree 
         Caption         =   "&Home"
         Index           =   0
      End
      Begin VB.Menu mnuTree 
         Caption         =   "&Page Up"
         Index           =   1
      End
      Begin VB.Menu mnuTree 
         Caption         =   "&Up"
         Index           =   2
      End
      Begin VB.Menu mnuTree 
         Caption         =   "&Down"
         Index           =   3
      End
      Begin VB.Menu mnuTree 
         Caption         =   "P&age Down"
         Index           =   4
      End
      Begin VB.Menu mnuTree 
         Caption         =   "&End"
         Index           =   5
      End
      Begin VB.Menu mnuTree 
         Caption         =   "-"
         Index           =   6
      End
      Begin VB.Menu mnuTree 
         Caption         =   "All&ow Drag'n'Drop"
         Checked         =   -1  'True
         Index           =   7
      End
      Begin VB.Menu mnuTree 
         Caption         =   "Allow &Label Edit"
         Checked         =   -1  'True
         Index           =   8
      End
      Begin VB.Menu mnuTree 
         Caption         =   "&Hot Tracking Cursor"
         Checked         =   -1  'True
         Index           =   9
      End
   End
End
Attribute VB_Name = "fTestTree"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
'===========================================================================
'
' Form Name:    fTestTree
' Author:       Graeme Grant
' Date:         18/09/2001
' Version:      01.00.00
' 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.
'
' 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 WithEvents moTree As cTreeView
Attribute moTree.VB_VarHelpID = -1
Private moSelectedNode    As MSComctlLib.Node
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 Enum eCommand
    [Add Node] = 0
    [Rename Node] = 1
    [Move Node] = 2
    [Delete Node] = 3
    [Execute Mode] = 4
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
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
'
'## 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 [Code] + ' - ' + [Desc] AS Desc1, PkID " + _
                                      "FROM [Product] " + _
                                      "WHERE ((GroupID)="
Private Const mcSQL_PROD2 As String = ") and ((Active)=True) " + _
                                      "ORDER BY Code"

'## 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 = "))"

'## 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 " + _