User:Eriksiers/Linked List

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

'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

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).

'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