User:Eriksiers/Linked List

This is a linked list class for Visual Basic & VBA. It should work at least as far back as VB4.

<lang vb>'This class is in the Public Domain. Private Type Node

   data As Variant
   nPrv As Variant
   nNxt As Variant

End Type

Public Enum BeforeOrAfter

   Before = 0
   After = 1

End Enum

Private nodes() As Node Private curNode As Variant, listEmpty As Boolean

Private Sub Class_Initialize()

   listEmpty = True
   curNode = -1

End Sub

Public Property Get nodeData() As Variant

   If listEmpty Then
       Error 9
   Else
       nodeData = nodes(curNode).data
   End If

End Property

Public Property Let nodeData(ByVal vNewValue As Variant)

   If listEmpty Then
       Error 9
   Else
       nodes(curNode).data = vNewValue
   End If

End Property

Public Property Get isEmpty() As Boolean

   isEmpty = listEmpty

End Property

Public Property Get currentNode() As Variant

   currentNode = curNode

End Property

Public Property Get nodeCount() As Variant

   If listEmpty Then
       nodeCount = 0
   Else
       nodeCount = UBound(nodes) + 1
   End If

End Property

Public Function insertNode(Optional where As BeforeOrAfter, Optional data As Variant) As Boolean

   If listEmpty Then
       ReDim nodes(0)
       listEmpty = False
       curNode = 0
       nodes(0).nPrv = 0
       nodes(0).nNxt = 0
   Else
       Dim tmp As Variant
       tmp = UBound(nodes) + 1
       ReDim Preserve nodes(tmp)
       'this If block splices the new node into the list
       If Before = where Then
           nodes(nodes(curNode).nNxt).nPrv = tmp
           nodes(tmp).nNxt = nodes(curNode).nNxt
           nodes(tmp).nPrv = curNode
           nodes(curNode).nNxt = tmp
       Else
           nodes(nodes(curNode).nPrv).nNxt = tmp
           nodes(tmp).nNxt = curNode
           nodes(tmp).nPrv = nodes(curNode).nPrv
           nodes(curNode).nPrv = tmp
       End If
       curNode = tmp
   End If
   nodes(curNode).data = data
   insertNode = True

End Function

Public Function deleteNode() As Boolean

   If listEmpty Then
       Error 9
   Else
       If UBound(nodes) = curNode Then
           If UBound(nodes) > 0 Then
               'patch the surrounding elements together
               nodes(nodes(curNode).nPrv).nNxt = nodes(curNode).nNxt
               nodes(nodes(curNode).nNxt).nPrv = nodes(curNode).nPrv
               'select the appropriate nNxt item
               curNode = nodes(curNode).nNxt
               'finally, the actual delete
               ReDim Preserve nodes(UBound(nodes) - 1)
           Else
               'only item on list, so...
               ReDim nodes(0)
               listEmpty = True
               curNode = -1
           End If
       Else
           'patch the surrounding elements together
           nodes(nodes(curNode).nPrv).nNxt = nodes(curNode).nNxt
           nodes(nodes(curNode).nNxt).nPrv = nodes(curNode).nPrv
           'swap with node at end of list
           Dim tmp As Node
           tmp = nodes(UBound(nodes))
           nodes(UBound(nodes)) = nodes(curNode)
           nodes(curNode) = tmp
           'patch the list
           nodes(nodes(curNode).nPrv).nNxt = curNode
           nodes(nodes(curNode).nNxt).nPrv = curNode
           'select the appropriate nNxt item
           If UBound(nodes) <> nodes(UBound(nodes)).nNxt Then curNode = nodes(UBound(nodes)).nNxt
           'finally, the actual delete
           ReDim Preserve nodes(UBound(nodes) - 1)
       End If
       deleteNode = True
   End If

End Function

Public Function nextnode() As Boolean

   curNode = nodes(curNode).nNxt

End Function

Public Function prevNode() As Boolean

   curNode = nodes(curNode).nPrv

End Function</lang>

Simplified

This is a variation of the above class that relies on VB's array handling to keep the elements in order. It's much simpler than the above version, but will slow significantly with larger lists. (How large and how slow are largely dependent on the machine it's running on.)

With minor modifications, this could conceivably work under QBasic (though obviously not as a class).

<lang vb>'This class is in the Public Domain. Public Enum BeforeOrAfter

   Before = 0
   After = 1

End Enum

Private nodes() As Variant Private curNode As Variant, listEmpty As Boolean

Private Sub Class_Initialize()

   listEmpty = True
   curNode = -1

End Sub

Public Property Get nodeData() As Variant

   If listEmpty Then
       Error 9
   Else
       nodeData = nodes(curNode)
   End If

End Property

Public Property Let nodeData(ByVal vNewValue As Variant)

   If listEmpty Then
       Error 9
   Else
       nodes(curNode) = vNewValue
   End If

End Property

Public Property Get isEmpty() As Boolean

   isEmpty = listEmpty

End Property

Public Property Get currentNode() As Variant

   currentNode = curNode

End Property

Public Property Get nodeCount() As Variant

   If listEmpty Then
       nodeCount = 0
   Else
       nodeCount = UBound(nodes) + 1
   End If

End Property

Public Function insertNode(Optional where As BeforeOrAfter, Optional data As Variant) As Boolean

   If listEmpty Then
       ReDim nodes(0)
       listEmpty = False
       curNode = 0
   Else
       ReDim Preserve nodes(UBound(nodes) + 1)
       Dim L0 As Variant
       curNode = curNode + where
       For L0 = UBound(nodes) To curNode + 1 Step -1
           nodes(L0) = nodes(L0 - 1)
       Next
   End If
   nodes(curNode) = data
   insertNode = True

End Function

Public Function deleteNode() As Boolean

   If listEmpty Then
       Error 9
   Else
       Dim L0 As Variant
       For L0 = curNode To UBound(nodes) - 1
           nodes(L0) = nodes(L0 + 1)
       Next
       If UBound(nodes) < 1 Then
           listEmpty = True
           curNode = -1
       Else
           ReDim Preserve nodes(UBound(nodes) - 1)
       End If
       deleteNode = True
   End If

End Function

Public Function nextNode() As Boolean

   If curNode < UBound(nodes) Then
       curNode = curNode + 1
   Else
       curNode = 0
   End If
   nextNode = True

End Function

Public Function prevNode() As Boolean

   If curNode > 0 Then
       curNode = curNode - 1
   Else
       curNode = UBound(nodes)
   End If
   prevNode = True

End Function</lang>