A quick & simple VBA FIFO Queue Implementation

BorysT

3.75/5 (4 votes)

Apr 5, 2012

CPOL

32539

This is an alternative for "A quick & simple VBA FIFO Queue Implementation"

Introduction

This article is alternative to "A quick & simple VBA FIFO Queue Implementation" article and shows how to implement Queue in VBA based on reference instead of using array. This article includes two classes which implementing containers' adapters; classes use an encapsulated object of a specific container class as its underlying container, providing a specific set of member functions to access its elements. Elements are added into the "tail" of the specific container and removed from its "head".

Using the code

This implementation consist from the two classes: QueueItem and Queue. These classes listed below.


'
' QueueItem Class
'
' Public fields
Public NextItem As New QueueItem
Public Value As Variant

'
' Queue Class
'
' Remarks:
' Represents a first-in, first-out collection of objects.
' Queues are useful for storing messages in the order they were received for sequential processing.
' Objects stored in a Queue are inserted at one end and removed from the other.

' Private fields
Private head As QueueItem
Private tail As QueueItem
Private countQ As Long

'
' Constructor
'

' Initializes a new instance of the Queue class that is empty.
Private Sub Class_Initialize()
    countQ = 0
End Sub

'
' Destructor
'

' Destruct resources and perform other cleanup operations
Private Sub Class_Terminate()
    countQ = 0
    Set head = Nothing
    Set tail = Nothing
End Sub

'
' Properties
'

' Returns a Boolean value indicating whether a Queue has items.
Public Property Get IsEmpty() As Boolean
    IsEmpty = ((head Is Nothing) And (tail Is Nothing))
End Property

' Gets the number of elements contained in the Queue.
Public Property Get Count() As Long
    Count = countQ
End Property

' Returns the object at the beginning of the Queue without removing it.
Public Property Get Peek() As Variant
    Peek = head.Value
End Property

'
' Methods
'

' Adds an object to the end of the Queue.
Public Function Enqueue(v As Variant)
    Dim queueItem As New QueueItem
     
    queueItem.Value = v
    
    If Me.IsEmpty = True Then
        Set head = queueItem
        Set tail = head
    Else
        Set tail.NextItem = queueItem
        Set tail = queueItem
    End If
    
    countQ = countQ + 1
    Set queueItem = Nothing
End Function

' Removes and returns the object at the beginning of the Queue.
Public Function Dequeue() As Variant
    If Me.IsEmpty = True Then
        Dequeue = Null
    Else
        Dequeue = head.Value
        
        If head Is tail Then
            Set head = Nothing
            Set tail = Nothing
            countQ = 0
        Else
            Set head = head.NextItem
            countQ = countQ - 1
        End If
    End If
End Function

' Removes all objects from the Queue.
Public Function Clear()
    countQ = 0
    Set head = Nothing
    Set tail = Nothing
End Function

' Copies the Queue elements to a new array.
Public Function ToArray() As Variant
    Dim sizeQ As Long
    Dim result() As Variant
    Dim index As Long
    Dim tmp As QueueItem
    
    sizeQ = Me.Count - 1

    If sizeQ > -1 Then
        ReDim result(sizeQ)        
        Set tmp = head
        For index = 0 To sizeQ
            result(index) = tmp.Value
            Set tmp = tmp.NextItem
        Next index
        ToArray = result
    Else
        Erase result
    End If
    Set tmp = Nothing
End Function

Using

Listing below shows at the same time example of using and simple tests cases.


Sub TestQueue()
    Dim qQueue As New Queue
    Dim aResult As Variant
    Dim index As Long
    Dim vValue As Variant
    
    #Const ExecuteTestNumberOne = False
    
    Debug.Print "Queue is empty - " & qQueue.IsEmpty
    
    qQueue.Enqueue "Start"
    Debug.Print "Added String: ""Start""; queue size is " & qQueue.Count
    qQueue.Enqueue 123
    Debug.Print "Added Integer: 123; queue size is " & qQueue.Count
    qQueue.Enqueue 123.123
    Debug.Print "Added Double: 123.123; queue size is " & qQueue.Count
    qQueue.Enqueue Null
    Debug.Print "Added Null; queue size is " & qQueue.Count
    qQueue.Enqueue Empty
    Debug.Print "Added Empty; queue size is " & qQueue.Count
    qQueue.Enqueue Err
    Debug.Print "Added Err; queue size is " & qQueue.Count
    qQueue.Enqueue ""
    Debug.Print "Added empty string; queue size is " & qQueue.Count
    qQueue.Enqueue "End"
    Debug.Print "Added last string: ""End""; queue size is " & qQueue.Count
    
    Debug.Print "Queue is empty - " & qQueue.IsEmpty
    
    Debug.Print "Returned the object at the beginning of the Queue without removing it."
    Debug.Print "The object is " & qQueue.Peek & "; queue size is " & qQueue.Count
    
    Debug.Print "Poped up the object: '" & qQueue.Dequeue & "'; queue size is " & qQueue.Count
    
    #If ExecuteTestNumberOne Then
        ' Test #1
        Do While Not qQueue.IsEmpty
            vValue = qQueue.Dequeue
            If IsNull(vValue) Then
                Debug.Print "Value = 'Null' is " & TypeName(vValue)
            ElseIf IsEmpty(vValue) Then
                Debug.Print "Value = 'Empty' is " & TypeName(vValue)
            Else
                Debug.Print "Value = '" & CStr(vValue) & "' is " & TypeName(vValue)
            End If
        Loop
    #Else
        ' Test #2
        aResult = qQueue.ToArray()
        
        Debug.Print "Array aResult size is " & UBound(aResult) + 1
        index = 0
        For Each element In aResult
            If IsNull(element) Then
                Debug.Print "Element(" & index & ") = 'Null' is " & TypeName(element)
            ElseIf IsEmpty(element) Then
                Debug.Print "Element(" & index & ") = 'Empty' is " & TypeName(element)
            Else
                Debug.Print "Element(" & index & ") = '" & CStr(element) & "' is " & TypeName(element)
            End If
            index = index + 1
        Next
        
        Debug.Print "Queue size is " & qQueue.Count
        qQueue.Clear
        Debug.Print "Cleaning queue."
    #End If
    Debug.Print "Queue size is " & qQueue.Count
    ' Cleaning object
    Set qQueue = Nothing 
End Sub

An expected result for test number two

Below you can find expected output result after executing of TestQueue procedure.


Queue is empty - True
Added string: 'Start'; queue size is 1
Added integer: 123; queue size is 2
Added double: 123.123; queue size is 3
Added Null; queue size is 4
Added Empty; queue size is 5
Added Err; queue size is 6
Added empty string; queue size is 7
Added last string: 'End'; queue size is 8
Queue is empty - False
Returned the object at the beginning of the Queue without removing it.
The object is Start; queue size is 8
Poped up the object: Start; queue size is 7
Array aResult size is 7
Element(0) = '123' is Integer
Element(1) = '123.123' is Double
Element(2) = 'Null' is Null
Element(3) = 'Empty' is Empty
Element(4) = '0' is Long
Element(5) = '' is String
Element(6) = 'End' is String
Queue size is 7
Cleaning queue.
Queue size is 0