www.pudn.com > ListViewTreeView.rar > cls_TreeView.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 = "cls_TreeView" 
Attribute VB_GlobalNameSpace = False 
Attribute VB_Creatable = True 
Attribute VB_PredeclaredId = False 
Attribute VB_Exposed = False 
 
' ********************************************************************** 
'  描  述：在listbox中实现treeview数效果 
'  Play78.com : 网站导航，源码之家，绝对开源 
'  海阔天空收集整理 
'  网址：http://www.play78.com/ 
'  QQ：13355575 
'  e-mail:hglai@eyou.com 
'  编写日期：2005年07月28日 
' ********************************************************************** 
 
' 
' 
' 
 
Option Explicit 
 
' 
' 
' 
 
Private TreeIndex As New Collection 
 
Private RootNode As cls_Node 
 
Private WithEvents mAttachedlistbox As ListBox 
Attribute mAttachedlistbox.VB_VarHelpID = -1 
 
Public Event SelectionChange(ByRef Key As String) 
 
' 
' 
' 
 
Public Sub Init(ByRef UsedListBox As ListBox) 
 
    Set mAttachedlistbox = UsedListBox 
 
    Set RootNode = New cls_Node 
    RootNode.IsExpanded = True 
 
End Sub 
 
' 
' 
' 
 
Public Sub AddItem(ByVal ParentKey As String, ByVal newDescription As String, ByVal newKey As String, ByVal newValue As String) 
 
    Dim newNode As New cls_Node 
 
    newNode.Description = newDescription 
    newNode.Key = newKey 
    newNode.Value = newValue 
 
    Dim ParentNode As cls_Node 
    Set ParentNode = RootNode.FindByKey(ParentKey) 
     
    If Not ParentNode Is Nothing Then ParentNode.AddChild newNode 
 
End Sub 
 
' 
' 
' 
 
Public Sub Refresh() 
 
    Set TreeIndex = Nothing 
 
    mAttachedlistbox.Visible = False 
    mAttachedlistbox.Clear 
    DisplayNode RootNode, 0 
    mAttachedlistbox.Visible = True 
 
End Sub 
 
' 
' 
' 
 
Private Sub DisplayNode(ByRef ThisNode As cls_Node, ByVal Level As Long) 
 
    Dim tmpNode As cls_Node 
    Set tmpNode = ThisNode 
 
    While Not tmpNode Is Nothing 
        Dim Line As String 
 
        If Level > 0 Then 
            Line = tmpNode.Description 
 
            If Not tmpNode.FirstChild Is Nothing Then 
                Line = IIf(tmpNode.IsExpanded, "(-)", "(+)") & " " & Line 
            End If 
 
            mAttachedlistbox.AddItem String(Level - 1, vbTab) & Line 
            tmpNode.ListIndex = mAttachedlistbox.NewIndex 
            TreeIndex.Add tmpNode, "K" & tmpNode.ListIndex 
 
        End If 
 
        If tmpNode.IsExpanded Then DisplayNode tmpNode.FirstChild, Level + 1 
        Set tmpNode = tmpNode.NextSibling 
 
    Wend 
 
End Sub 
 
' 
' 
' 
 
Private Sub mAttachedlistbox_Click() 
 
    Dim Idx As Long: Idx = mAttachedlistbox.ListIndex 
    If Idx = -1 Then 
        RaiseEvent SelectionChange("") 
    Else 
        RaiseEvent SelectionChange(TreeIndex("K" & Idx).Key) 
    End If 
 
End Sub 
 
' 
' 
' 
 
Private Sub mAttachedlistbox_KeyDown(KeyCode As Integer, Shift As Integer) 
 
    Dim Idx As Long: Idx = mAttachedlistbox.ListIndex: If Idx = -1 Then Exit Sub 
 
    Dim ClickNode As cls_Node: Set ClickNode = TreeIndex("K" & Idx) 
    If Not ClickNode.FirstChild Is Nothing Then 
 
        If KeyCode = vbKeyRight And Not ClickNode.IsExpanded Then 
                ClickNode.IsExpanded = True 
                KeyCode = 0 
        ElseIf KeyCode = vbKeyLeft And ClickNode.IsExpanded Then 
                ClickNode.IsExpanded = False 
                KeyCode = 0 
        Else 
            Exit Sub 
        End If 
 
        Refresh 
        mAttachedlistbox.ListIndex = Idx 
        mAttachedlistbox.SetFocus 
 
    End If 
 
End Sub 
 
' 
' 
' 
 
Private Sub mAttachedlistbox_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single) 
 
    Dim Idx As Long: Idx = mAttachedlistbox.ListIndex: If Idx = -1 Then Exit Sub 
 
    Dim ClickNode As cls_Node: Set ClickNode = TreeIndex("K" & Idx) 
     
    If ClickNode.FirstChild Is Nothing Then _ 
        RaiseEvent SelectionChange(ClickNode.Key): Exit Sub 
 
    ClickNode.IsExpanded = Not ClickNode.IsExpanded 
 
    Refresh 
    mAttachedlistbox.ListIndex = Idx 
 
End Sub 
 
' 
' 
' 
 
Public Sub HighLight(ByVal Key As String) 
 
    Dim nod As cls_Node 
    Set nod = RootNode.FindByKey(Key) 
    If nod Is Nothing Or Key = "" Then mAttachedlistbox.ListIndex = -1: Exit Sub 
 
    nod.EnsureVisible 
    Refresh 
    mAttachedlistbox.ListIndex = nod.ListIndex 
 
End Sub 
 
' 
' 
' 
 
Public Function FindFirstKey(ByVal Desc As String) As String 
 
    Dim nod As cls_Node 
    Set nod = RootNode.FindFirst(Desc) 
    If nod Is Nothing Then Exit Function 
 
    FindFirstKey = nod.Key 
 
End Function 
 
' 
' 
' 
 
Public Function GetValue(ByVal Key As String) As String 
 
    If Key = "" Then Exit Function 
 
    Dim nod As cls_Node 
    Set nod = RootNode.FindFirst(Key) 
    If nod Is Nothing Then Exit Function 
 
    GetValue = nod.Value 
 
End Function