GESTION DE PILE FIFO DANS UNE CLASSE (SANS RECORDSET)

''
' cFifoStack <BR>
'      Class to create a FIFO stack with the option to precise the length of the stack.
'
' @remarks
'      This program is free software; you can redistribute it and/or modify
'      it under the terms of the GNU General Public License as published by
'      the Free Software Foundation; either version 2 of the License, or
'      (at your option) any later version.
'
'      This program is distributed in the hope that it will be useful,
'      but WITHOUT ANY WARRANTY; without even the implied warranty of
'      MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
'      GNU General Public License for more details.
'
'      You should have received a copy of the GNU General Public License
'      along with this program; if not, write to the Free Software
'      Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
'
' @require
' <UL TYPE=SQUARE>
' <LI>     OLE Automation - stdole2.tlb </LI>
' </UL>
' @author David ARNOLD
' @version 1.0
' @date 17-Sep-03

Option Explicit

'' Default stack size
Private Const iDEF_STACK_LENGTH As Integer = 1000

''
' Stack type. Contains the datas and indexes to hold the stack.
'
' @param    iStackIn_Index      Index to input datas
' @param    iStackOut_Index     Index to output datas
' @param    StackDatas          Datas
Private Type Stack
    iStackIn_Index As Integer
    iStackOut_Index As Integer
    StackDatas As Collection
End Type

'' Local stack
Private mStack As Stack
'' Stack length
Private mStackLength As Integer


'----------------------------------------------------------------------------------------------------------------------------------------------------
'                                   Public METHODS
'----------------------------------------------------------------------------------------------------------------------------------------------------


''
' Put a data in the stack.
'
'@param     vData   <B>IN PARAMETER</B>. Data to stack in.
'
'@return    True if stack in has been done (false if not, when the stack is full, data in stack > stack length)
'@remarks
'@see
'@todo
'@bug
'@history
Public Function StackIn(ByVal vData As Variant) As Boolean
Attribute StackIn.VB_Description = "Put a data in the stack."
    Dim tmpIndex As Integer
    
   On Error GoTo StackIn_Error

    tmpIndex = (mStack.iStackIn_Index + 1) Mod mStackLength
    mStack.StackDatas.Add vData, "k" + CStr(tmpIndex)
    mStack.iStackIn_Index = tmpIndex
    StackIn = True
   
   On Error GoTo 0
   Exit Function
StackIn_Error:
    StackIn = False
End Function

''
' Get a data from the stack.
'
'@param     vData   <B>OUT PARAMETER</B>. Data to stack out.
'
'@return    True if stack out has been done (false if not, when the stack is empty, use property DataInStack).
'@remarks
'@see
'@todo
'@bug
'@history
Public Function StackOut(ByRef vData As Variant) As Boolean
Attribute StackOut.VB_Description = "Get a data from the stack."
    Dim tmpIndex As Integer
    
   On Error GoTo StackOut_Error

    tmpIndex = (mStack.iStackOut_Index + 1) Mod mStackLength
    vData = mStack.StackDatas.Item("k" + CStr(tmpIndex))
    mStack.StackDatas.Remove "k" + CStr(tmpIndex)
    mStack.iStackOut_Index = tmpIndex
    StackOut = True

   On Error GoTo 0
   Exit Function
StackOut_Error:
    StackOut = False
End Function


'----------------------------------------------------------------------------------------------------------------------------------------------------
'                                   Public PROPERTIES
'----------------------------------------------------------------------------------------------------------------------------------------------------


''
' Check if datas available in the stack.
'
'@return    True if datas available in the stack.
'@remarks
'@see
'@todo
'@bug
'@history
Public Property Get DataInStack() As Boolean
Attribute DataInStack.VB_Description = "Check if datas available in the stack."
Attribute DataInStack.VB_ProcData.VB_Invoke_Property = ";Data"
    DataInStack = (mStack.StackDatas.Count > 0)
End Property

''
' Let the length of the stack.
'
'@param    iStackLength     Length of the stack.
'@remarks
'   The stack has to be empty to change the length
'@see
'@todo
'@bug
'@history
Public Property Let StackLength(ByVal iStackLength As Integer)
Attribute StackLength.VB_Description = "Let the length of the stack."
Attribute StackLength.VB_ProcData.VB_Invoke_PropertyPut = ";Data"
    If mStack.StackDatas.Count = 0 Then
        mStackLength = iStackLength
        mStack.iStackIn_Index = 0
        mStack.iStackOut_Index = 0
    End If
End Property


'----------------------------------------------------------------------------------------------------------------------------------------------------
'                                   Private METHODS
'----------------------------------------------------------------------------------------------------------------------------------------------------


''
' Standard Initialize class method
'@remarks Set the stack length to the default value.
'@see   iDEF_STACK_LENGTH
'@todo
'@bug
'@history
Private Sub Class_Initialize()
    mStackLength = iDEF_STACK_LENGTH
    mStack.iStackIn_Index = 0
    mStack.iStackOut_Index = 0
    Set mStack.StackDatas = New Collection
End Sub


''
' Standard Terminate class method
'@remarks
'@see
'@todo
'@bug
'@history
Private Sub Class_Terminate()
    mStackLength = 0
    mStack.iStackIn_Index = 0
    mStack.iStackOut_Index = 0
    Set mStack.StackDatas = Nothing
End Sub

Télécharger le zip