image
 
image
M039_StackOfObjects.bas


' ========================================================================================================================
'                                 ____,__,  __,  ____,_,  _,  ____ ____,__, ,____,____,
'                                (-/_|(-|  (-|  (-|_,(-|\ |  (-|__|-/_|( |_/(-|_,(-|__)
'                                _/  |,_|__,_|__,_|__,_| \|,  _|__)/  |,_| \,_|__,_|  \,
'
'                                             Copyright 2012 Allen Baker
'
' ------------------------------------------------------------------------------------------------------------------------
' File:          M039_StackOfObjects
' Originator:    Allen Baker (2012.02.19 20:16)
' ------------------------------------------------------------------------------------------------------------------------
' $RCSfile$
' $Revision$
' $Date$
' ========================================================================================================================
'
Option Explicit



' ========================================================================================================================
' Description
'    This module implements a Last-In_First-Out stack data structure for storing entities of type Object.
' ========================================================================================================================



' =====================================================================================================================
' @@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@[  Constants  ]@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@
' =====================================================================================================================



' =====================================================================================================================
' @@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@[  Types  ]@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@
' =====================================================================================================================



' ==============================================================================================
' Note:  All Objects are REFERENCE TYPES in VBA. All the other built-in data types in VBA are
'        VALUE TYPES. In addition, *all user defined types declared with the Type keyword*, all
'        enums, and all arrays are VALUE TYPES.
'
'        Assignment of a VALUE TYPE variable to another variable of the same VALUE TYPE copies
'        the value from one variable to the other so that each variable contains its own
'        separate instance of the value. Assignment of a REFERENCE TYPE variable to another
'        variable of the same REFERENCE TYPE copies the reference from one variable to the other
'        so that both variables "point to" the same instance of the value.
'
'        Notice that this means that assigning an array *copies* the entire contents of the
'        array.
' ----------------------------------------------------------------------------------------------
Public Type StackOfObjects
   mStackOfObjectsValues() As Object
   mTopOfStackOfObjectsIdx As Long
   mStackOfObjectsIsEmpty  As Boolean
End Type



' =====================================================================================================================
' @@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@[  Module Variables  ]@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@
' =====================================================================================================================



' =====================================================================================================================
' @@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@[  Public Routines  ]@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@
' =====================================================================================================================



' ===========================================================================================================
' ===========================================================================================================
' ===========================================================================================================
' This function returns a new empty stackOfObjects.
'
' returns
'    This function returns a new empty stackOfObjects.
' -----------------------------------------------------------------------------------------------------------
Public Function newStackOfObjects() As StackOfObjects
   ReDim newStackOfObjects.mStackOfObjectsValues(0)
   newStackOfObjects.mTopOfStackOfObjectsIdx = 0
End Function



' ===========================================================================================================
' ===========================================================================================================
' ===========================================================================================================
' This function returns True if the StackOfObjects is empty, otherwise, it returns False.
'
' returns
'    This function returns True if the StackOfObjects is empty, otherwise, it returns False.
'
' param
'    pStackOfObjects is the StackOfObjects to operate on
' -----------------------------------------------------------------------------------------------------------
Public Function stackOfObjectsIsEmpty(pStackOfObjects As StackOfObjects) As Boolean
   stackOfObjectsIsEmpty = (pStackOfObjects.mTopOfStackOfObjectsIdx = 0)
End Function



' ===========================================================================================================
' ===========================================================================================================
' ===========================================================================================================
' This subroutine places an object on the top of the StackOfObjects.
'
' param
'    pStackOfObjects is the StackOfObjects to operate on
' param
'    pValue is the object to place on the top of the StackOfObjects
' -----------------------------------------------------------------------------------------------------------
Public Sub pushStackOfObjects(pStackOfObjects As StackOfObjects, pValue As Object)
   If (UBound(pStackOfObjects.mStackOfObjectsValues) <= pStackOfObjects.mTopOfStackOfObjectsIdx) Then
      ReDim Preserve pStackOfObjects.mStackOfObjectsValues(UBound(pStackOfObjects.mStackOfObjectsValues) + 10)
   End If
   pStackOfObjects.mTopOfStackOfObjectsIdx = pStackOfObjects.mTopOfStackOfObjectsIdx + 1
   Set pStackOfObjects.mStackOfObjectsValues(pStackOfObjects.mTopOfStackOfObjectsIdx) = pValue
End Sub



' ===========================================================================================================
' ===========================================================================================================
' ===========================================================================================================
' This function returns the top object on the StackOfObjects.
'
' returns
'    This function returns the top object on the StackOfObjects.
'
' param
'    pStackOfObjects is the StackOfObjects to operate on
' -----------------------------------------------------------------------------------------------------------
Public Function popStackOfObjects(pStackOfObjects As StackOfObjects) As Object
   Set popStackOfObjects = Nothing
   If (Not stackOfObjectsIsEmpty(pStackOfObjects)) Then
      Set popStackOfObjects = pStackOfObjects.mStackOfObjectsValues(pStackOfObjects.mTopOfStackOfObjectsIdx)
      pStackOfObjects.mTopOfStackOfObjectsIdx = pStackOfObjects.mTopOfStackOfObjectsIdx - 1
   End If
End Function



' ===========================================================================================================
' ===========================================================================================================
' ===========================================================================================================
' This function returns a count of the number of objects on the StackOfObjects.
'
' returns
'    This function returns a count of the number of objects on the StackOfObjects.
'
' param
'    pStackOfObjects is the StackOfObjects to operate on
' -----------------------------------------------------------------------------------------------------------
Public Function stackOfObjectsCount(pStackOfObjects As StackOfObjects) As Long
    stackOfObjectsCount = pStackOfObjects.mTopOfStackOfObjectsIdx
End Function
'
'
'
''
'' =====================================================================================================================
'' =====================================================================================================================
'' =====================================================================================================================
'' This routine is a unit test for the StackOfObjects module
'' -----------------------------------------------------------------------------------------------------------
'Public Sub aaaa_StackOfObjectsTest()
'   Dim mStackOfObjects As StackOfObjects
'   mStackOfObjects = newStackOfObjects()
'
'   Call pushStackOfObjects(mStackOfObjects, "Test 1")
'   Call pushStackOfObjects(mStackOfObjects, 2048)
'   Call pushStackOfObjects(mStackOfObjects, True)
'   Call pushStackOfObjects(mStackOfObjects, Now())
'   Call pushStackOfObjects(mStackOfObjects, "Test 5")
'   Dim idx As Long
'   For idx = 1 To 30
'      Call pushStackOfObjects(mStackOfObjects, "Number " & idx)
'   Next idx
'
'   Dim row As Long
'   row = 1
'   Do While Not stackOfObjectsIsEmpty(mStackOfObjects)
'      Cells(row, 1).value = "Pop LastIn: " & stackOfObjectsCount(mStackOfObjects) & " - " & popStackOfObjects(mStackOfObjects)
'      row = row + 1
'   Loop
'   Cells(row, 1).value = "Pop LastIn: " & stackOfObjectsCount(mStackOfObjects) & " - " & popStackOfObjects(mStackOfObjects)
'End Sub



' =====================================================================================================================
' @@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@[  Private Routines  ]@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@
' =====================================================================================================================