ctreeview.cls

用Treeview来显示每个Field

VERSION 1.0 CLASS
BEGIN
  MultiUse = -1  'True
  Persistable = 0  'NotPersistable
  DataBindingBehavior = 0  'vbNone
  DataSourceBehavior  = 0  'vbNone
  MTSTransactionMode  = 0  'NotAnMTSObject
END
Attribute VB_Name = "cTreeView"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = False
'===========================================================================
'
' Class Name:   cTreeView
' Author:       Graeme Grant
' Date:         18/09/2001
' Version:      01.00.02
' Description:  Advanced TreeView Handler
' Edit History: 01.00.00 09/09/01 Initiail Release
'               01.00.01 18/09/01 Added CodeScroll: Home/PgUp/Up/
'                                                   End/PgDn/Down
'               01.00.01 18/09/01 Added Node First/Last Viewable
'               01.00.01 18/09/01 Added Drag Auto-scrolling
'               01.00.02 21/09/01 Fixed Drag mode Icon
'
'===========================================================================

Option Explicit

'===========================================================================
' Debugging... Saves adding the debug statements to the form events
'
#Const DEBUGMODE = 1                    '## 0=No debug
                                        '   1=debug
#Const MOUSEEVENTS = 1                  '## 0=No mouse events
                                        '   1=Mouse Up & Mouse Down
                                        '   2=All Mouse events
#If DEBUGMODE = 1 Then
    Private dbgCtrlName  As String
#End If

'===========================================================================
' Public: Variables and Declarations
'
Public Enum eContextMenuMode
    [Before Click] = 0
    [After Click] = 1
End Enum

Public Enum eCodeScrollView         '@@ v01.00.01
    [Home] = 0
    [Page Up] = 1
    [Up] = 2
    [Down] = 3
    [Page Down] = 4
    [End] = 5
End Enum

'===========================================================================
' Private: Variables and Declarations
'
Private WithEvents oTree  As MSComctlLib.TreeView
Attribute oTree.VB_VarHelpID = -1
Private meContextMenuMode As eContextMenuMode
Private mbDragEnabled     As Boolean
Private mbStartDrag       As Boolean
Private mbInDrag          As Boolean
Private mlNodeHeight      As Long               '## Physical node height (pixels) @@ v01.00.01
Private moFindNode        As MSComctlLib.Node
Private moDragNode        As MSComctlLib.Node

'===========================================================================
' Private: Used By pClearTreeviewNodes
'
Private Declare Function SendMessageLong Lib "user32" Alias "SendMessageA" _
                                        (ByVal hWnd As Long, _
                                         ByVal Msg As Long, _
                                         ByVal wParam As Long, _
                                         ByVal lParam As Long) As Long

Private Const WM_SETREDRAW    As Long = &HB
Private Const TV_FIRST        As Long = &H1100
Private Const TVM_GETNEXTITEM As Long = (TV_FIRST + 10)
Private Const TVM_DELETEITEM  As Long = (TV_FIRST + 1)
Private Const TVGN_ROOT       As Long = &H0

'===========================================================================
' Private: cTreeView Events
'
Public Event StartDrag(SourceNode As MSComctlLib.Node)
Public Event Dragging(SourceNode As MSComctlLib.Node, TargetParent As MSComctlLib.Node)
Public Event Dropped(SourceNode As MSComctlLib.Node, TargetParent As MSComctlLib.Node)

Public Event ContextMenu(Node As MSComctlLib.Node, X As Single, Y As Single)
Public Event Selected(Node As MSComctlLib.Node)

'===========================================================================
' TreeView: Events
'
Private Sub oTree_AfterLabelEdit(Cancel As Integer, NewString As String)
#If DEBUGMODE = 1 Then
    Debug.Print dbgCtrlName; "::AfterLabelEdit -> Cancel="; CStr(Cancel); "  NewString="; NewString
#End If
End Sub

Private Sub oTree_BeforeLabelEdit(Cancel As Integer)
    #If DEBUGMODE = 1 Then
        Debug.Print dbgCtrlName; "::BeforeLabelEdit -> Cancel="; CStr(Cancel)
    #End If

End Sub

Private Sub oTree_Click()
    #If DEBUGMODE = 1 Then
        Debug.Print dbgCtrlName; "::Click"
    #End If

End Sub

Private Sub oTree_Collapse(ByVal Node As MSComctlLib.Node)
    #If DEBUGMODE = 1 Then
        Debug.Print dbgCtrlName; "::Collapse -> Node="; Node.Text
    #End If

End Sub

Private Sub oTree_DblClick()
    #If DEBUGMODE = 1 Then
        Debug.Print dbgCtrlName; "::DblClick"
    #End If

End Sub

Private Sub oTree_DragDrop(Source As Control, X As Single, Y As Single)
    #If DEBUGMODE = 1 Then
        Debug.Print dbgCtrlName; "::DragDrop -> Source="; Source.Name; "  X="; CStr(X); "  Y="; CStr(Y)
    #End If

    If mbDragEnabled Then
        With oTree
            If Not (.DropHighlight Is Nothing) Then                 '## Did we drop a node?
                If moDragNode <> .DropHighlight Then                '## Yes. Did we drag the node onto itself?
                    RaiseEvent Dropped(moDragNode, .DropHighlight)  '## Notify programmer & Reset
                End If
            End If
            '## Reset
            Set .DropHighlight = Nothing
            Set moDragNode = Nothing
            mbInDrag = False
            mbStartDrag = False
        End With
    End If

End Sub

Private Sub oTree_DragOver(Source As Control, X As Single, Y As Single, State As Integer)
    #If DEBUGMODE = 1 Then
        Debug.Print dbgCtrlName; "::DragOver -> Source="; Source.Name; "  X="; CStr(X); "  Y="; CStr(Y)
    #End If

    If mbDragEnabled Then
        With oTree
            If mbStartDrag = True Then
                If mbInDrag = True Then
                    '## Set DropHighlight to the mouse's coordinates.
                    Set .DropHighlight = .HitTest(X, Y)
                    If Y > (.GetVisibleCount - 2) * mlNodeHeight Then       '@@ v01.00.01
                        pScrollToNextNode(1).EnsureVisible                  '@@ Autoscroll during
                    ElseIf Y < 2 * mlNodeHeight Then                        '@@ Dragging operation
                        pScrollToPrevNode(1).EnsureVisible                  '@@ if near top or
                    Else                                                    '@@ bottom of control
                        If Not (.DropHighlight Is Nothing) Then
                            '## We're over a node
                            RaiseEvent Dragging(moDragNode, .DropHighlight)
                        End If                                              '@@ v01.00.01
                    End If
                End If
            End If
        End With
    End If

End Sub

Private Sub oTree_Expand(ByVal Node As MSComctlLib.Node)
    #If DEBUGMODE = 1 Then
        Debug.Print dbgCtrlName; "::Expand -> Node="; Node.Text
    #End If

End Sub

Private Sub oTree_GotFocus()
    #If DEBUGMODE = 1 Then
        Debug.Print dbgCtrlName; "::GotFocus"
    #End If

End Sub

Private Sub oTree_KeyDown(KeyCode As Integer, Shift As Integer)
    #If DEBUGMODE = 1 Then
        Debug.Print dbgCtrlName; "::KeyDown -> KeyCode="; CStr(KeyCode); "  Shift="; CStr(Shift)
    #End If

End Sub

Private Sub oTree_KeyPress(KeyAscii As Integer)
    #If DEBUGMODE = 1 Then
        Debug.Print dbgCtrlName; "::KeyPress -> KeyAscii="; CStr(KeyAscii)
    #End If

End Sub

Private Sub oTree_KeyUp(KeyCode As Integer, Shift As Integer)
    #If DEBUGMODE = 1 Then
        Debug.Print dbgCtrlName; "::KeyUp -> KeyCode="; CStr(KeyCode); "  Shift="; CStr(Shift)
    #End If

End Sub

Private Sub oTree_LostFocus()
    #If DEBUGMODE = 1 Then
        Debug.Print dbgCtrlName; "::LostFocus"
    #End If

End Sub

Private Sub oTree_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
    #If DEBUGMODE = 1 Then
        #If MOUSEEVENTS = 1 Or MOUSEEVENTS = 2 Then
            Debug.Print dbgCtrlName; "::MouseDown -> Button="; CStr(Button); "  Shift="; CStr(Shift); "  X="; CStr(X); "  Y="; CStr(Y)
        #End If
    #End If

    With oTree
        If mbDragEnabled Then                               '## Is drag'n'drop allowed?
            If Button = vbLeftButton Then
                Set moDragNode = .HitTest(X, Y)             '## Capture the node to be dragged
            End If
        End If

        '## Fire ContextMenu event before click event?
        If meContextMenuMode = [Before Click] Then
            If Button = vbRightButton Then
                Set .SelectedItem = .HitTest(X, Y)
                RaiseEvent ContextMenu(.SelectedItem, X, Y)
            End If
        End If
    End With

End Sub

Private Sub oTree_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
    #If DEBUGMODE = 1 Then
        #If MOUSEEVENTS = 2 Then
            Debug.Print dbgCtrlName; "::MouseMove -> Button="; CStr(Button); "  Shift="; CStr(Shift); "  X="; CStr(X); "  Y="; CStr(Y)
        #End If
    #End If

    If mbDragEnabled Then                                   '## Is drag'n'drop allowed?
        If Button = vbLeftButton Then                       '## Yes. Signal a Drag operation.
            With oTree
                If Not (.HitTest(X, Y) Is Nothing) Then     '## Do we have a node selected?
                    mbInDrag = True                         '## Yes. Set the flag to true.
                    '## Set the drag icon with the CreateDragImage method.
                    '.DragIcon = .SelectedItem.CreateDragImage
                    .DragIcon = moDragNode.CreateDragImage  '@@ v01.00.02
                    .Drag vbBeginDrag                       '## Signal VB to start drag operation.
                    If Not (moDragNode Is Nothing) Then
                        RaiseEvent StartDrag(moDragNode)    '## Notify programmer starting drag operation
                        mbStartDrag = True
                    End If
                End If
            End With
        End If
    End If

End Sub

Private Sub oTree_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
    #If DEBUGMODE = 1 Then
        #If MOUSEEVENTS = 1 Or MOUSEEVENTS = 2 Then
            Debug.Print dbgCtrlName; "::MouseUp -> Button="; CStr(Button); "  Shift="; CStr(Shift); "  X="; CStr(X); "  Y="; CStr(Y)
        #End If
    #End If

    '## Fire ContextMenu event after click event?
    If meContextMenuMode = [After Click] Then
        If Button = vbRightButton Then
            With oTree
                Set .SelectedItem = .HitTest(X, Y)
                RaiseEvent ContextMenu(.SelectedItem, X, Y)
            End With
        End If
    End If

End Sub

Private Sub oTree_NodeCheck(ByVal Node As MSComctlLib.Node)
    #If DEBUGMODE = 1 Then
        Debug.Print dbgCtrlName; "::NodeCheck -> Node="; Node.Text
    #End If

End Sub

Private Sub oTree_NodeClick(ByVal Node As MSComctlLib.Node)
    #If DEBUGMODE = 1 Then
        Debug.Print dbgCtrlName; "::NodeClick -> Node="; Node.Text
    #End If

    If mbDragEnabled Then
        '## Cancel if dragging a node
        mbStartDrag = False
        mbInDrag = False
        Set oTree.DropHighlight = Nothing
    End If
    '## Node selected, raise event
    RaiseEvent Selected(Node)
End Sub

Private Sub oTree_OLECompleteDrag(Effect As Long)
    #If DEBUGMODE = 1 Then
        Debug.Print dbgCtrlName; "::OLECompleteDrag -> Effect="; CStr(Effect)
    #End If

End Sub

Private Sub oTree_OLEDragDrop(Data As MSComctlLib.DataObject, Effect As Long, Button As Integer, Shift As Integer, X As Single, Y As Single)
    #If DEBUGMODE = 1 Then
        Debug.Print dbgCtrlName; "::OLEDragDrop -> Effect="; CStr(Effect); "  Button="; CStr(Button); "  Shift="; CStr(Shift); "  X="; CStr(X); "  Y="; CStr(Y)
    #End If

End Sub

Private Sub oTree_OLEDragOver(Data As MSComctlLib.DataObject, Effect As Long, Button As Integer, Shift As Integer, X As Single, Y As Single, State As Integer)
    #If DEBUGMODE = 1 Then
        Debug.Print dbgCtrlName; "::OLEDragOver -> Effect="; CStr(Effect); "  Button="; CStr(Button); "  Shift="; CStr(Shift); "  X="; CStr(X); "  Y="; CStr(Y); "  State="; CStr(State)
    #End If

End Sub

Private Sub oTree_OLEGiveFeedback(Effect As Long, DefaultCursors As Boolean)
    #If DEBUGMODE = 1 Then
        Debug.Print dbgCtrlName; "::OLEGiveFeedback -> Effect="; CStr(Effect); "  DefaultCursors="; CStr(DefaultCursors)
    #End If

End Sub