' ========================================================================================================================
' ____,__, __, ____,_, _, ____ ____,__, ,____,____,
' (-/_|(-| (-| (-|_,(-|\ | (-|__|-/_|( |_/(-|_,(-|__)
' _/ |,_|__,_|__,_|__,_| \|, _|__)/ |,_| \,_|__,_| \,
'
' 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 ]@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@
' =====================================================================================================================
Copyright © 2012 Allen Baker
|