发一个很久以前写的循环列队的类
类模块:
程序代码：
'//! Name:CircularQueue.cls
'//! Intro:循环队列
Option Explicit
Private m_Type As VbVarType
Private m_Size As Integer
Private m_Count As Integer
Private m_Data() As Variant
Private iFront As Integer
Private iRear As Integer
Private Const MIN_SIZE As Integer = 0
Private Const MAX_SIZE As Integer = 1000
Private Const DEF_SIZE As Integer = 10
Private Const DEF_TYPE As Integer = vbVariant
Private Const ERROR_USER As Integer = 531
Private Sub Class_Initialize()
m_Type = DEF_TYPE
m_Size = DEF_SIZE
m_Count = 0
ReDim m_Data(m_Size-1) As Variant
iFront = 0
iRear = 0
End Sub
Private Sub Class_Terminate()
Dim i As Integer
If m_Type = vbObject Then
For i = 0 To m_Size-1
Set m_Data(i) = Nothing
Next
End If
Erase m_Data
End Sub
Public Property Get DataType() As VbVarType
DataType = m_Type
End Property
Public Property Let DataType(ByVal value As VbVarType)
m_Type = value
End Property
Public Property Get Size() As Integer
Size = m_Size
End Property
Public Property Let Size(ByVal value As Integer)
If value > MIN_SIZE And value < MAX_SIZE Then
m_Size = value
Else
m_Size = DEF_SIZE
End If
ReDim Preserve m_Data(m_Size - 1) As Variant
End Property
Public Property Get Count() As Integer
Count = m_Count
End Property
Public Property Get IsQueueEmpty() As Boolean
IsQueueEmpty = (m_Count = 0)
End Property
Public Property Get IsQueueFull() As Boolean
IsQueueFull = (m_Count = m_Size)
End Property
Public Function EnQueue(ByVal value As Variant) As Long
On Error GoTo errHandler
If VarType(value) <> m_Type Then
Err.Raise ERROR_USER, , "数据类型不符合队列要求"
End If
If IsQueueFull() Then
Call DeQueue
End If
If m_Type = vbObject Then
Set m_Data(iRear) = value
Else
m_Data(iRear) = value
End If
m_Count = m_Count + 1
iRear = (iRear + 1) Mod m_Size
EnQueue = 0
Exit Function
errHandler:
Debug.Print "in EnQueue()," & Err.Description
EnQueue = -1
End Function
Public Function DeQueue() As Variant
On Error GoTo errHandler
Dim tmp As Variant
If IsQueueEmpty() Then
Err.Raise ERROR_USER, , "队列为空"
End If
If m_Type = vbObject Then
Set tmp = m_Data(iFront)
Set DeQueue = tmp
Set tmp = Nothing
Else
tmp = m_Data(iFront)
DeQueue = tmp
End If
m_Count = m_Count - 1
iFront = (iFront + 1) Mod m_Size
Exit Function
errHandler:
Debug.Print "in DeQueue()," & Err.Description
If m_Type = vbObject Then
Set DeQueue = Nothing
End If
End Function
Public Function GetQueueFront() As Variant
On Error GoTo errHandler
If IsQueueEmpty() Then
Err.Raise ERROR_USER, , "队列为空"
End If
If m_Type = vbObject Then
Set GetQueueFront = m_Data(iFront)
Else
GetQueueFront = m_Data(iFront)
End If
Exit Function
errHandler:
Debug.Print "in GetQueueFront()," & Err.Description
If m_Type = vbObject Then
Set GetQueueFront = Nothing
End If
End Function
Public Function GetQueue() As Variant()
On Error GoTo errHandler
Dim i As Integer
Dim n As Integer
Dim tmp() As Variant
If IsQueueEmpty() Then
Err.Raise ERROR_USER, , "队列为空"
End If
ReDim tmp(m_Count - 1) As Variant
If m_Type = vbObject Then
If iFront + m_Count <= m_Size Then
For i = 0 To m_Count - 1
Set tmp(i) = m_Data(i + iFront)
Next
Else
n = 0
For i = iFront To m_Size - 1
Set tmp(n) = m_Data(i)
n = n + 1
Next
For i = 0 To iRear - 1
Set tmp(n) = m_Data(i)
n = n + 1
Next
End If
GetQueue = tmp
Else
If iFront + m_Count <= m_Size Then
For i = 0 To m_Count - 1
tmp(i) = m_Data(i + iFront)
Next
Else
n = 0
For i = iFront To m_Size - 1
tmp(n) = m_Data(i)
n = n + 1
Next
For i = 0 To iRear - 1
tmp(n) = m_Data(i)
n = n + 1
Next
End If
GetQueue = tmp
End If
Exit Function
errHandler:
Debug.Print "in GetQueue()," & Err.Description
End Function
测试：
程序代码：Dim q As CircularQueue
Dim i As Integer
Dim s As String
Set q = New CircularQueue
q.DataType = vbString
q.Size = 10
For i = 0 To 12
s = String(Rnd() * 10 + 1, Chr(Rnd() * 26 + 97))
Debug.Print "enqueue:", s
q.EnQueue s
Debug.Print "queue Count="; q.Count
Next
Debug.Print "isQueueFull()="; q.IsQueueFull（）
Debug.Print
While q.Count > 0
Debug.Print "dequeue:", q.DeQueue
Wend
Debug.Print "isQueueEmpty()="; q.IsQueueEmpty()
Set q = Nothing以前写的，可能与数据结构的课本上用c语言的struct做的有稍微的差别，不过思路都是相通的。
[ 本帖最后由 jiashie 于 2010-7-9 14:47 编辑 ]
