VERSION 1.0 CLASS
BEGIN
MultiUse = -1 'True
Persistable = 0 'NotPersistable
DataBindingBehavior = 0 'vbNone
DataSourceBehavior = 0 'vbNone
MTSTransactionMode = 0 'NotAnMTSObject
END
Attribute VB_Name = "clsCollectionBuffer"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = True
' Application : ColBuffer (CollectionBuffer Utility Object Library)
' Object : clsCollectionBuffer
' Purpose : Defines the CollectionBuffer utility object.
Option Explicit
' Identifies the point in the buffered string where the data actually
' starts.
Private Const mc_intDataStartingPosition As Integer = 9
' Member instance of the type_CollectionAttributes global UDT.
Private m_udtAttributes As type_CollectionAttributes
' Member string containing the current data buffer.
Public m_strBuffer As String
' Member long containing the current insertion point in the data buffer.
Public m_lngPosition As Long
' Member boolean indicating whether or not an instance of the
' CollectionBuffer has been initialized.
Public m_blnInitialized As Boolean
Public Sub AddItem(ByVal strData As String)
' Purpose : Adds a data string to the data buffer.
' Accepts : strData A string containing the Item to be added to the
' data buffer.
' Returns : n/a
' If the CollectionBuffer has not been initialized, then return to
' the calling procedure and report the error.
If Not m_blnInitialized Then
Err.Raise Number:=vbObjectError + gc_lngNotInitialized, _
Source:=App.Title & "::" & TypeName(Me) & ":AddItem", _
Description:="Object not initialized"
Else
With m_udtAttributes
' If the data buffer is full, then increase it enough for the
' new Item to be added.
If .lngCount = .lngMaximumCount Then
m_strBuffer = m_strBuffer & Space$(.intLength)
.lngMaximumCount = .lngMaximumCount + 1
End If
' Add the Item to the data buffer
Mid$(m_strBuffer, m_lngPosition, .intLength) = strData
' Set the new current insertion point within the data buffer.
m_lngPosition = m_lngPosition + .intLength
' Increment the Item count.
.lngCount = .lngCount + 1
End With
End If
End Sub
Public Function Count() As Long
' Purpose : Returns the number of Items in the CollectionBuffer.
' Accepts : n/a
' Returns : A long indicating the number of Items in the data buffer.
' If the CollectionBuffer has not been initialized, then return zero.
If Not m_blnInitialized Then
Count = 0
ElseIf m_udtAttributes.lngCount > 2090000 Then
Count = 0
' Return the number of Items in the data buffer.
Else
Count = m_udtAttributes.lngCount
End If
End Function
Public Function GetData() As String
' Purpose : Returns the data buffer to the calling procedure.
' Accepts : n/a
' Returns : A string containing the data buffer.
Dim udtBuffer As type_CollectionAttributesBuffer
' Copy the CollectionBuffer attributes to a buffered string.
LSet udtBuffer = m_udtAttributes
' Set the reserved space of the data buffer to the CollectionBuffer
' attributes.
If m_strBuffer <> "" Then
Mid$(m_strBuffer, 1, Len(udtBuffer)) = udtBuffer.strBuffer
' Record the data buffer to be returned.
GetData = Left$(m_strBuffer, m_lngPosition)
Else
GetData = ""
End If
End Function
Public Sub Initialize(ByVal intLength As Integer, _
ByVal lngEstimatedCount As Long)
' Purpose : Initializes the CollectionBuffer making it ready to
' receive and store data.
' Accepts : intLength An integer indicating the length of
' each Item to be added to the data
' buffer.
' lngEstimatedCount A long indicating the estimated
' number of Items that will be added
' to the data buffer
' Returns : n/a
' If the CollectionBuffer has already been initialized, then don't let
' it be initialized again.
If m_blnInitialized Then Exit Sub
With m_udtAttributes
' Set the attributes for the CollectionBuffer
.intLength = intLength
.lngEstimatedCount = lngEstimatedCount
.lngMaximumCount = lngEstimatedCount
' Create a buffered string big enough to hold the estimated number
' of Items.
m_strBuffer = Space$((mc_intDataStartingPosition + _
.lngMaximumCount) * .intLength)
' Set the current insertion point for the data buffer.
m_lngPosition = mc_intDataStartingPosition
End With
' Indicate that the CollectionBuffer has been initialized
m_blnInitialized = True
End Sub
Public Function IsInitialized() As Boolean
' Purpose : Returns whether or not the CollectionBuffer has been
' initialized.
' Accepts : n/a
' Returns : A boolean indicating whether or not the CollectionBuffer
' has been initialized.
IsInitialized = m_blnInitialized
End Function
Public Function Item(ByVal lngIndex As Long) As String
' Purpose : Returns the Item for the specified position within the
' data buffer.
' Accepts : lngIndex A long indicating which Item to return.
' Returns : A string containing the Item from the data buffer.
' If the CollectionBuffer has not been initialized, then an empty
' string to the calling procedure.
If Not m_blnInitialized Then
Item = ""
Else
With m_udtAttributes
' Attempt to return the requested Item from the data buffer.
Item = Mid$(m_strBuffer, mc_intDataStartingPosition + _
(lngIndex - 1) * .intLength, .intLength)
End With
End If
End Function
Public Sub SetData(ByVal strDataBuffer As String)
' Purpose : Populates an unpopulated CollectionBuffer with a data
' buffer.
' Accepts : strDataBuffer A string containing the data buffer to
' bo stored.
' Returns : n/a
Dim udtBuffer As type_CollectionAttributesBuffer
' Retrieve the CollectionBuffer attributes from the data buffer.
udtBuffer.strBuffer = Mid$(strDataBuffer, 1, Len(udtBuffer.strBuffer))
LSet m_udtAttributes = udtBuffer
' Store the data buffer.
m_strBuffer = strDataBuffer
' Indicate that the CollectionBuffer has been initialized.
m_blnInitialized = True
End Sub
Private Sub Class_Initialize()
' Purpose : Initialize variables and objects used by this Class.
' Accepts : n/a
' Returns : n/a
' Initialize the CollectionBuffer attributes.
With m_udtAttributes
.intLength = 0
.lngEstimatedCount = 0
.lngMaximumCount = 0
.lngCount = 0
End With
End Sub
Private Sub Class_Terminate()
' Purpose : Destroys variables and objects used by this Class.
' Clear the CollectionBuffer attributes.
With m_udtAttributes
.intLength = 0
.lngEstimatedCount = 0
.lngMaximumCount = 0
.lngCount = 0
End With
End Sub
Reply With Quote
2009 - 2016
Hahahaha...and some people know what my feeling on that is...