VERSION 1.0 CLASS
BEGIN
  MultiUse = -1  'True
  Persistable = 0  'NotPersistable
  DataBindingBehavior = 0  'vbNone
  DataSourceBehavior  = 0  'vbNone
  MTSTransactionMode  = 0  'NotAnMTSObject
END
Attribute VB_Name = "cObjectArray"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = False
Option Explicit
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Gerencia um array de OBJETOS
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''

' Guarda o nome da classe
Private Const ST_MY_NAME As String = "cObjectArray"

' Guarda o array
Private obj_Array()


'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Retorna o número de itens no array
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Public Function Size() As Long
    On Error GoTo ErrTreat:
    
    ' Retorna o tamanho do array
    Size = UBound(obj_Array()) + 1
    
    Exit Function
ErrTreat:
    
    ' Retorna que o array está vazio
    Size = 0
End Function


'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Libera todos os objetos do array e limpa o array
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Public Sub Free(Optional blnNoError As Boolean = False)
    Dim lnI As Long
    On Error GoTo ErrTreat:
    
    ' Varre o vetor
    For lnI = (Size - 1) To 0 Step -1
    
        ' Libera o objeto
        Set obj_Array(lnI) = Nothing
    Next lnI
    
    ' Limpa o array
    Clear
    
    Exit Sub
ErrTreat:
    
    ' Se é para exibir erro
    If Not blnNoError Then
        LogErrMessage Err.Description, ST_MY_NAME + ".Free"
    End If
End Sub


'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Limpa o array sem liberar os objetos contidos nela
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Public Sub Clear()
    On Error GoTo ErrTreat:
    
    ' Libera
    Erase obj_Array()
    
    Exit Sub
ErrTreat:
    LogErrMessage Err.Description, ST_MY_NAME + ".Clear"
End Sub


'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Adiciona um elemento (variante) ao array
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Public Sub Add(varInput)
    Dim lnI As Long
    On Error GoTo ErrTreat:
    
    ' Recupera a última posição
    lnI = Size
    
    ' Redimenciona o array
    ReDim Preserve obj_Array(Size)
    
    ' Seta objeto
    Set obj_Array(lnI) = varInput
    
    Exit Sub
ErrTreat:
    LogErrMessage Err.Description, ST_MY_NAME + ".Add"
End Sub


'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Retorna um elemento de posição Index
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Public Function Element(Index As Long) As Variant
    On Error GoTo ErrTreat:
    
    ' Retorna objeto
    Set Element = obj_Array(Index)
    
    Exit Function
ErrTreat:
    LogErrMessage Err.Description, ST_MY_NAME + ".Element", Index
End Function


'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Troca dois elementos de posição
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Public Sub Swap(Index1 As Long, Index2 As Long)
    Dim vElement As Variant
    On Error GoTo ErrTreat:
    
    ' Copia para auxiliar
    Set vElement = obj_Array(Index2)
            
    ' Copia para posição 2
    Set obj_Array(Index2) = obj_Array(Index1)
    
    ' Copia do auxiliar
    Set obj_Array(Index1) = vElement
    
    Exit Sub
ErrTreat:
    LogErrMessage Err.Description, ST_MY_NAME + ".Swap", CStr(Index1) + ST_SEP + CStr(Index2)
End Sub


'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Remove um elemento de posição Index
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Public Sub Delete(Index As Long)
    Dim lngI As Long
    On Error GoTo ErrTreat:
    
    ' Libera objeto
    Set obj_Array(Index) = Nothing
    
    ' Verifica se index era posição do meio
    If (Index < (Size - 1)) Then
        
        ' Varre o restante do array
        For lngI = Index To (Size - 2)
        
            ' Verifica se a próxima posição é um objeto
            If IsObject(obj_Array(lngI + 1)) Then
                
                ' Copia próximo objeto para este
                Set obj_Array(lngI) = obj_Array(lngI + 1)
                
                ' Libera próxima posição
                Set obj_Array(lngI + 1) = Nothing
            Else
                
                ' Copia elemento
                obj_Array(lngI) = obj_Array(lngI + 1)
            End If
        Next lngI
    End If
      
    ' Calcula novo tamanho do array
    lngI = Size - 1
    
    ' Se tamanho for válido
    If (lngI > 0) Then
        
        ' Redimenciona array
        ReDim Preserve obj_Array(lngI - 1)
    Else
        
        ' Libera array
        Clear
    End If
    
    Exit Sub
ErrTreat:

    ' Exibe erro
    LogErrMessage Err.Description, ST_MY_NAME + ".Delete", Index
End Sub


'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Remove um elemento de posição Index
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Public Sub Remove(Index As Long)
    Dim lngI As Long
    On Error GoTo ErrTreat:
    
    ' Libera objeto
    Set obj_Array(Index) = Nothing
    
    ' Verifica se index era posição do meio
    If (Index < (Size - 1)) Then
        
        ' Varre o restante do array
        For lngI = Index To (Size - 2)
        
            ' Verifica se a próxima posição é um objeto
            If IsObject(obj_Array(lngI + 1)) Then
                
                ' Copia próximo objeto para este
                Set obj_Array(lngI) = obj_Array(lngI + 1)
                
                ' Libera próxima posição
                Set obj_Array(lngI + 1) = Nothing
            Else
                
                ' Copia elemento
                obj_Array(lngI) = obj_Array(lngI + 1)
            End If
        Next lngI
    End If
      
    ' Calcula novo tamanho do array
    lngI = Size - 1
    
    ' Se tamanho for válido
    If (lngI > 0) Then
        
        ' Redimenciona array
        ReDim Preserve obj_Array(lngI - 1)
    Else
        
        ' Libera array
        Clear
    End If
    
    Exit Sub
ErrTreat:

    ' Exibe erro
    LogErrMessage Err.Description, ST_MY_NAME + ".Remove", Index
End Sub


'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Criação da classe
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Private Sub Class_Initialize()
        
    ' Libera o array
    Clear
End Sub


'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Destruição da classe
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Private Sub Class_Terminate()
    
    ' Libera objetos
    Free True
End Sub