ctreeview.cls

树状控件的一些相关操作

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         (requires mTreeView.BAS)
' Author:       Graeme Grant
' Date:         28/09/2001
' Version:      01.00.03
' Description:  Advanced TreeView Handler
' Edit History: 01.00.00 09/09/01 Initial 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
'               01.00.03 28/09/01 Added FlatBorder property
'               01.00.03 28/09/01 Add IsChildNode function
'               01.00.03 28/09/01 Added NodeCopy function, CancelCopy
'                                 property and CopyNode Event.
'               01.00.03 28/09/01 Added 'Cut Icon State' [Thanks to
'                                 Brad Martinez]
'               01.00.03 28/09/01 Fixed problem if TreeView adjusts
'                                 the display of nodes between MouseDown
'                                 and MouseUp events causing a VB Error
'                                 in MouseMove event.
'               01.00.03 28/09/01 Fixed Move node when node was not
'                                 Expanded and loaded - bug only when
'                                 loading branches on demand. Worked fine
'                                 if TreeView was prelaoded fully before
'                                 move operation was performed.
'
'===========================================================================

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

Public Enum eNodeDepth              '@@ v01.00.03
    [First Branch] = 0
    [All Branches] = 1
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 mbCancelCopy      As Boolean
Private moCopyNode        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)

Public Event CopyNode(DestNode As MSComctlLib.Node, SrcNode As MSComctlLib.Node)    '@@ v01.00.03

'===========================================================================
' 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_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_DragDrop(Source As Control, x As Single, y As Single)

    If mbDragEnabled Then
        With oTree
            '是否Drop了一个节点
            If Not (.DropHighlight Is Nothing) Then
                If moDragNode <> .DropHighlight Then
                    RaiseEvent Dropped(moDragNode, .DropHighlight)
                End If
            End If
            '重新设置
            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 mbDragEnabled Then
        With oTree
            If mbStartDrag = True Then
                If mbInDrag = True Then
                    '设置高亮显示
                    Set .DropHighlight = .HitTest(x, y)
                    If y > (.GetVisibleCount - 2) * mlNodeHeight Then
                        '自动滚动
                        pScrollToNextNode(1).EnsureVisible
                    ElseIf y < 2 * mlNodeHeight Then
                        pScrollToPrevNode(1).EnsureVisible
                    Else
                        If Not (.DropHighlight Is Nothing) Then
                            '是否正在一个节点上方
                            RaiseEvent Dragging(moDragNode, .DropHighlight)
                        End If
                    End If
                End If
            End If
        End With
    End If

End Sub
Private Sub oTree_MouseDown(Button As Integer, Shift As Integer, _
x As Single, y As Single)

    With oTree
        '是否允许Drag&Drop操作
        If mbDragEnabled Then
            If Button = vbLeftButton Then
                '被Drag的节点
                Set moDragNode = .HitTest(x, y)
            End If
        End If

        '激活右键菜单
        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)

    On Error GoTo ErrorHandler
    '是否允许Drag&Drop操作
    If mbDragEnabled Then
        If Button = vbLeftButton Then
            With oTree
                '是否选择一个节点
                If Not (.HitTest(x, y) Is Nothing) Then
                    mbInDrag = True
                    '设置拖拽图标
                    .DragIcon = moDragNode.CreateDragImage
                    '开始Drag操作
                    .Drag vbBeginDrag
                    If Not (moDragNode Is Nothing) Then
                        RaiseEvent StartDrag(moDragNode)
                        mbStartDrag = True
                    End If
                End If
            End With
        End If
    End If
    Exit Sub

ErrorHandler:
    mbInDrag = False
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

Private Sub oTree_OLESetData(Data As MSComctlLib.DataObject, DataFormat As Integer)
    #If DEBUGMODE = 1 Then
        Debug.Print dbgCtrlName; "::OLESetData -> Effect="; CStr(DataFormat)
    #End If

End Sub

Private Sub oTree_OLEStartDrag(Data As MSComctlLib.DataObject, AllowedEffects As Long)
    #If DEBUGMODE = 1 Then
        Debug.Print dbgCtrlName; "::OLEStartDrag -> AllowedEffects="; CStr(AllowedEffects)
    #End If

End Sub

Private Sub oTree_Validate(Cancel As Boolean)
    #If DEBUGMODE = 1 Then