我想写一个循环队列，可以队尾输入数据，从队首删除数据。

大家别吝啬，畅所欲言啊

我等你们回复

在VB里,我知道的有二种实现方式:
都是用数组.只是访问和存储的方式不同

1\每次操作时,都对数据进行移位.
如 数组为 1 to 10
每次从删除数据时,都依次把数据向前移一位,然后最后一个补空.
这种的方法好理解,但占用CPU时间更长.

2\采用计数移位.
1\删除数据时,把首位记数+1 ,如果首位记数等于未尾记数,表示已无数据可删了.
2\增加数据时,未尾记数+1,如果未尾记数追上了首位记数,表示数据已满.
一般推荐使用这种方法.关键是二个函数,二个公用变量.也可以使用类来实现这个.

redim preserve

0 0 0 0 0 0 0 0 0 1
0 0 0 0 0 0 0 0 1 2
0 0 0 0 0 0 0 1 2 3
......
1 2 3 4 5 6 7 8 9 10

2 3 4 5 6 7 8 9 10 11
这样的方法就适合竹子说的第一种方法
1\每次操作时,都对数据进行移位.
如 数组为 1 to 10
每次从删除数据时,都依次把数据向前移一位,然后最后一个补空.
这种的方法好理解,但占用CPU时间更长.

'把下以内容保存成cCyclicBuffer
VERSION 1.0 CLASS
BEGIN
  MultiUse = -1  'True
  Persistable = 0  'NotPersistable
  DataBindingBehavior = 0  'vbNone
  DataSourceBehavior  = 0  'vbNone
  MTSTransactionMode  = 0  'NotAnMTSObject
END
Attribute VB_Name = "cCyclicBuffer"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = False
Attribute VB_Ext_KEY = "SavedWithClassBuilder6" ,"Yes"
Attribute VB_Ext_KEY = "Top_Level" ,"Yes"
'********************************************************************
'*
'*  Class:      cCyclicBuffer.cls
'*
'*  Copyright (c) Com-mania II 2000
'*
'*  Purpose:    Cyclic buffer (queue) implementation with events
'*
'*  Overview:   This is an object-oriented implementation of queue
'*
'*  Revision History:
'*              V.1.0.0 March 2000  Azlan Muhamad Sufian
'*                      Initial version
'*
'********************************************************************

'References:

'Components:

Option Explicit 'All variables must be declared
Option Base 1   'Arrays begin with 1

'To fire this event, use RaiseEvent with the following syntax:
'RaiseEvent BufFull[(arg1, arg2, ... , argn)]
Public Event BufFull()  'Buffer is full
'To fire this event, use RaiseEvent with the following syntax:
'RaiseEvent BufEmpty[(arg1, arg2, ... , argn)]
Public Event BufEmpty() 'Buffer is empty
'To fire this event, use RaiseEvent with the following syntax:
'RaiseEvent OnBuf[(arg1, arg2, ... , argn)]
Public Event OnBuf() 'Fired when iSze >= iThreshold

'local variable(s) to hold property value(s)
Private vItm() As Variant   'Buffer elements
Private iMaxSze As Integer  'Maximum buffer size
Private iSze As Integer     'Current buffer size
Private iHd As Integer  'Pointer to last element or next empty space
Private iTl As Integer  'Pointer to next element to read from

Private mvariThreshold As Integer       'Threshold for firing OnBuf
Private mvarbOverwriteOnFull As Boolean 'Flag whether to overwrite full buffer

Public Property Let iThreshold(ByVal vData As Integer)
'used when assigning a value to the property, on the left side of an assignment.
'Syntax: X.iThreshold = 5
    mvariThreshold = vData
End Property

Public Property Get iThreshold() As Integer
'used when retrieving value of a property, on the right side of an assignment.
'Syntax: Debug.Print X.iThreshold
    iThreshold = mvariThreshold
End Property

Public Property Let bOverwriteOnFull(ByVal vData As Boolean)
'used when assigning a value to the property, on the left side of an assignment.
'Syntax: X.bflushonscheme = 5
    mvarbOverwriteOnFull = vData
End Property

Public Property Get bOverwriteOnFull() As Boolean
'used when retrieving value of a property, on the right side of an assignment.
'Syntax: Debug.Print X.bflushonscheme
    bOverwriteOnFull = mvarbOverwriteOnFull
End Property

Public Sub GetAllItems(vItems() As Variant)
'Copy all items into vItems array but do not alter head/tail
    Dim iIndex As Integer
    Dim iTmpHd As Integer
    Dim iTmpTl As Integer
    ReDim vItems(iMaxSze) As Variant
    
    iTmpHd = iHd
    iTmpTl = iTl
    iIndex = 1
    If Not IsEmpty Then
        While iIndex <= iSze
            vItems(iIndex) = vItm(iTmpTl)
            iIndex = iIndex + 1
            iTmpTl = (iTmpTl Mod iMaxSze) + 1
        Wend
    End If
End Sub

Public Sub GetInternalProperties(Optional iMaxSize As Integer, Optional iCurrentSize As Integer, _
    Optional iHead As Integer, Optional iTail As Integer)
'Get internal properties
    iMaxSize = iMaxSze
    iCurrentSize = iSze
    iHead = iHd
    iTail = iTl
End Sub

Public Sub Copy(ByVal cSrcCycBuf As cCyclicBuffer)
'Copy constructor
    Dim iIndex As Integer
    Dim vAllItems() As Variant
    Dim iSrcMxSz As Integer
    
    cSrcCycBuf.GetInternalProperties iSrcMxSz
    Create iSrcMxSz
    mvariThreshold = cSrcCycBuf.iThreshold
    mvarbOverwriteOnFull = cSrcCycBuf.bOverwriteOnFull
    cSrcCycBuf.GetAllItems vAllItems
    CopyItems vAllItems
End Sub

Private Sub CopyItems(vItems() As Variant)
'Push elements from a source array
'The iHd, iTl & iSze will be automatically updated
    Dim iCount As Integer
    Dim vItem As Variant
    
    For iCount = LBound(vItems) To UBound(vItems)
        vItem = vItems(iCount)
        If vItem <> Empty Then
            PutItem vItems(iCount)
        End If
    Next iCount
End Sub

Public Sub Create(iMaxSize As Integer)
'Initialise buffer
    If iMaxSize > 1 Then
        iMaxSze = iMaxSize
        ReDim vItm(iMaxSze) As Variant
        iHd = 1
        iTl = 1
        iSze = 0
        mvariThreshold = 1  'Default threshold value
    Else
        MsgBox "Unable to create. Invalid buffer size.", vbOKOnly + vbExclamation, "Error"
    End If
End Sub

Public Sub PutItem(vItem As Variant)
'Write an element if buffer is not full or
'if buffer is full and bOverwriteScheme is True
    Dim bIsFull As Boolean
    Dim bOverwriteScheme As Boolean
    
    bIsFull = IsFull
    bOverwriteScheme = bIsFull And mvarbOverwriteOnFull
    If (Not bIsFull) Or bOverwriteScheme Then
        vItm(iHd) = vItem
        iSze = iSze + 1
        iHd = (iHd Mod iMaxSze) + 1
        '"Flush" buffer for overwrite scheme
        If bOverwriteScheme And iSze > iMaxSze Then
            iSze = iMaxSze
            iTl = iHd
        End If
        If iSze >= mvariThreshold Then RaiseEvent OnBuf
    End If
End Sub

Public Function GetItem() As Variant
'Read an element if buffer is not empty
    If Not IsEmpty Then
        GetItem = vItm(iTl)
        iSze = iSze - 1
        iTl = (iTl Mod iMaxSze) + 1
    End If
End Function

Public Function IsFull() As Boolean
'Check if buffer is full
    IsFull = False
    If iHd = iTl And iSze = iMaxSze Then
    'full buffer condition
        IsFull = True
        RaiseEvent BufFull
    End If
End Function

Public Function IsEmpty() As Boolean
'Check if buffer is empty
    IsEmpty = False
    If iHd = iTl And iSze = 0 Then
    'empty buffer condition
        IsEmpty = True
        RaiseEvent BufEmpty
    End If
End Function

Public Sub ClearBuffer()
'Clear buffer contents by resetting these:
    iHd = 1
    iTl = 1
    iSze = 0
End Sub

Private Sub Class_Initialize()
'Default settings:
    mvarbOverwriteOnFull = False
End Sub