I'm working on modernizing Rosetta Code's infrastructure. Starting with communications. Please accept this time-limited open invite to RC's Slack.. --Michael Mol (talk) 20:59, 30 May 2020 (UTC)

User:Eriksiers/Linked List

From Rosetta Code

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[edit]

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