快速简单的 VBA FIFO 队列实现

BorysT

3.75/5 (4投票s)

2012 年 4 月 5 日

CPOL

32981

这是“一个快速简单的 VBA FIFO 队列实现”的替代方案

引言

本文是 "一个快速简单的 VBA FIFO 队列实现" 文章的替代方案，展示了如何在 VBA 中基于引用而不是使用数组来实现队列。本文包含两个类，它们实现了容器适配器；这些类使用特定容器类的封装对象作为其底层容器，提供一组特定的成员函数来访问其元素。元素被添加到特定容器的“尾部”，并从其“头部”移除。

使用代码

这个实现包含两个类：QueueItem 和 Queue。这些类如下所示。

' ' QueueItem 类 ' ' 公共字段 Public NextItem As New QueueItem Public Value As Variant

' ' Queue 类 ' ' 说明： ' 表示对象的先进先出集合。队列对于按接收顺序存储消息以进行顺序处理非常有用。 ' 存储在队列中的对象从一端插入，从另一端移除。 ' 私有字段 Private head As QueueItem Private tail As QueueItem Private countQ As Long ' ' 构造函数 ' ' 初始化一个空的 Queue 类的新实例。 Private Sub Class_Initialize() countQ = 0 End Sub ' ' 析构函数 ' ' 销毁资源并执行其他清理操作 Private Sub Class_Terminate() countQ = 0 Set head = Nothing Set tail = Nothing End Sub ' ' 属性 ' ' 返回一个布尔值，指示队列是否包含项目。 Public Property Get IsEmpty() As Boolean IsEmpty = ((head Is Nothing) And (tail Is Nothing)) End Property ' 获取队列中包含的元素数量。 Public Property Get Count() As Long Count = countQ End Property ' 返回队列开头的对象，但不将其移除。 Public Property Get Peek() As Variant Peek = head.Value End Property ' ' 方法 ' ' 将对象添加到队列的末尾。 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 ' 移除并返回队列开头的对象。 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 ' 移除队列中的所有对象。 Public Function Clear() countQ = 0 Set head = Nothing Set tail = Nothing End Function ' 将队列元素复制到新的数组。 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

使用

以下列表同时展示了使用示例和简单的测试用例。


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

测试编号二的预期结果

在执行 TestQueue 过程后，您可以在下方找到预期的输出结果。


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