Binary Trees in VB

You could use following classes :

'  Used with the clsLinkedList class.

Private m_next As class_ListItem
Private m_prev As class_ListItem
Private m_data As Variant

Public Property Set ItemData(v As Variant)
   Set m_data = v
End Property

Public Property Get NextItem() As class_ListItem
    Set NextItem = m_next
End Property

Public Property Set NextItem(ITem As class_ListItem)
    Set m_next = ITem
End Property

Public Property Get PrevItem() As class_ListItem
    Set PrevItem = m_prev
End Property

Public Property Set PrevItem(ITem As class_ListItem)
    Set m_prev = ITem
End Property

Public Property Get ItemData() As Variant
    If (VarType(m_data) = vbObject) Then
        Set ItemData = m_data
    Else
        ItemData = m_data
    End If
End Property

Public Property Let ItemData(v As Variant)
    If (VarType(v) = vbObject) Then
        Set m_data = v
    Else
        m_data = v
    End If
End Property


Option Explicit

'
'  A simple doublely linked list class
'

Private m_head As class_ListItem
Private m_tail As class_ListItem
Private m_cur  As class_ListItem

Private m_count As Long
'
'  Adds ItemData to the head of the linked list
'
Public Sub AddFirst(ItemData As Variant)
    Dim ITem As New class_ListItem

    If VarType(ItemData) = vbObject Then
       Set ITem.ItemData = ItemData
    Else
       ITem.ItemData = ItemData
    End If

    If (m_head Is Nothing) Then
        Set m_head = ITem
        Set m_tail = ITem
        Set m_cur = ITem
    Else
        Set ITem.NextItem = m_head
        Set ITem.PrevItem = Nothing
        Set ITem.NextItem.PrevItem = ITem
        Set m_head = ITem
    End If
   
    m_count = m_count + 1
End Sub

'
'  Adds ItemData to the end of the linked list.
'
Public Sub AddLast(ItemData As Variant)
    Dim ITem As New class_ListItem

    If VarType(ItemData) = vbObject Then
       Set ITem.ItemData = ItemData
    Else
       ITem.ItemData = ItemData
    End If

    If (m_tail Is Nothing) Then
        Set m_head = ITem
        Set m_tail = ITem
        Set m_cur = ITem
    Else
        Set ITem.PrevItem = m_tail
        Set ITem.NextItem = Nothing
        Set ITem.PrevItem.NextItem = ITem
        Set m_tail = ITem
    End If
   
    m_count = m_count + 1
End Sub

'
'  Returns the number of items in the linked list.
'
Property Get count() As Long
   count = m_count
End Property

'
'  Returns the current item.
'
Property Get CurrentItem() As Variant
   If m_cur Is Nothing Then
      CurrentItem = Null
   Else
      If VarType(m_cur.ItemData) = vbObject Then
         Set CurrentItem = m_cur.ItemData
      Else
         CurrentItem = m_cur.ItemData
      End If
   End If
End Property

'
'  Sets the current item.
'
Property Let CurrentItem(ItemData As Variant)
   If Not m_cur Is Nothing Then
      m_cur.ItemData = ItemData
   End If
End Property
Property Set CurrentItem(ItemData As Variant)
   If Not m_cur Is Nothing Then
      Set m_cur.ItemData = ItemData
   End If
End Property
'
'  Inserts ItemData after the current item in the list.
'
Public Sub InsertAfter(ItemData As Variant)
    Dim ITem As New class_ListItem

    If VarType(ItemData) = vbObject Then
       Set ITem.ItemData = ItemData
    Else
       ITem.ItemData = ItemData
    End If

    If (m_cur Is Nothing) Then
        Set m_head = ITem
        Set m_tail = ITem
        Set m_cur = ITem
    Else
        Set ITem.NextItem = m_cur.NextItem
        Set ITem.PrevItem = m_cur
        Set m_cur.NextItem = ITem
        'Add the following line.
        Set m_cur.NextItem.PrevItem = ITem
       
        If (m_cur.NextItem Is Nothing) Then
            Set m_tail = m_cur
        End If
    End If
   
    m_count = m_count + 1
End Sub

'
'  Delete's the
'
Public Sub DeleteAll()
   Dim M As class_ListItem
   Dim m2 As class_ListItem
   
   M = m_head
   
   Do While Not (M Is Nothing)
      Set m2 = M.NextItem
      Set M.NextItem = Nothing
      Set M.PrevItem = Nothing
      Set M = m2
   Loop
   
   m_head = Nothing
   m_tail = Nothing
   m_cur = Nothing
   m_count = 0
End Sub
   
Public Sub DeleteCurrent()
    Dim tmp As class_ListItem

    If (m_cur Is Nothing) Then
        Exit Sub
    End If

    If (m_cur.PrevItem Is Nothing) Then
        '
        ' Delete head of list
        '
        Set m_head = m_cur.NextItem
        If (m_head Is Nothing) Then
            '
            ' Also deleting tail, list becomes empty
            '
            Set m_tail = Nothing
            Set m_cur = Nothing
        Else
            Set m_head.PrevItem = Nothing
            Set m_cur = m_head
        End If
    ElseIf (m_cur.NextItem Is Nothing) Then
        '
        ' Deleting end of list
        '
        Set m_tail = m_cur.PrevItem
        If (m_tail Is Nothing) Then
            '
            ' Also deleting head, list becomes empty
            '
            Set m_head = Nothing
            Set m_cur = Nothing
        Else
            Set m_cur = m_tail
            Set m_cur.NextItem = Nothing
        End If
    Else
        '
        ' Delete somewhere inside of list
        '
        Set tmp = m_cur.NextItem
        Set m_cur.PrevItem.NextItem = m_cur.NextItem
        Set m_cur.NextItem.PrevItem = m_cur.PrevItem
        Set m_cur = tmp
    End If
   
    m_count = m_count - 1
End Sub
'
'  Return's the first item in the list.
'
Public Function FirstItem() As Variant
    If (m_head Is Nothing) Then
        FirstItem = Null
    Else
        If (VarType(m_head.ItemData) = vbObject) Then
            Set FirstItem = m_head.ItemData
        Else
            FirstItem = m_head.ItemData
        End If
        Set m_cur = m_head
    End If
End Function


'
'  Returns the next item in the list.
'
Public Function NextItem() As Variant
    If (m_cur Is Nothing) Then
        NextItem = Null
        Debug.Print "First Null"
    Else
        If (m_cur Is Nothing) Then
            NextItem = Null
        Else
            Set m_cur = m_cur.NextItem
            If (VarType(m_cur.ItemData) = vbObject) Then
                Set NextItem = m_cur.ItemData
            Else
                NextItem = m_cur.ItemData
            End If
        End If
    End If
End Function

'
' Returns the last item in the list.
'
Public Function LastItem() As Variant
    If (m_tail Is Nothing) Then
        LastItem = Null
    Else
        Set m_cur = m_tail
        If (VarType(m_cur.ItemData) = vbObject) Then
            Set LastItem = m_cur.ItemData
        Else
            LastItem = m_cur.ItemData
        End If
    End If
End Function

'
'  Returns the previous item in the list.
'
Public Function PrevItem() As Variant
    If (m_cur Is Nothing) Then
        PrevItem = Null
    Else
        If (m_cur.PrevItem Is Nothing) Then
            PrevItem = Null
        Else
            Set m_cur = m_cur.PrevItem
            If (VarType(m_cur.ItemData) = vbObject) Then
                Set PrevItem = m_cur.ItemData
            Else
                PrevItem = m_cur.ItemData
            End If
        End If
    End If
End Function

If you really want to know...  Buy this book.

Title: Visual Basic Algorithms
       by Kenneth Stephens
ISBN:  0471242683

VB Does allow "pointers".   Not like in C, where you can add to them to move your memory pointer up, but an object reference is considered a pointer to an object.  Unless you are using Orbix or Corba, but that's another story for another day.

Waty's solution , after a quick browse looks good.  I have a activeX dll that implements a binary tree if you would like it.  It also allows you to produce an AVL tree (balanced tree).  This was all done in VB5

for anthonyc,

is it possibnle to have this activeX dll which implements binary trees.


Nniol