equivalente VB6 a la lista <someclass>

Question

Quiero saber si existe un equivalente de (.net)

list<somefixedclass> 

en VB6

Sé que existe recogida en VB6 pero utiliza objeto (variante) en lugar de un objeto específico.

gracias.

Answer 1

No existe un equivalente directo en VB 6 al genérico List<T> que se encuentra en VB.NET. Sin embargo, existe una cosa como Collection en VB 6, que proporciona una funcionalidad similar. La principal diferencia es que un VB 6 Collection es no fuertemente tipado, lo que significa que todos los objetos se almacenan como Variants en la colección. En algunos casos, esto puede ser beneficioso, ya que le permite almacenar muchos tipos diferentes de datos en la misma colección, y de hecho, VB utiliza este objeto internamente. Es bastante fácil usar un Collection y objetos mejorados a medida que se recuperan de la clase, pero hay poco que puede hacer. No es posible implementar colecciones fuertemente tipadas en el tiempo de ejecución de VB.

Habiendo dicho eso, hay una solución que puede implementar. De forma similar a cómo se implementaron las colecciones en las versiones anteriores de VB.NET antes de que se introdujeran los genéricos, puede envolver el Collection en una clase, donde el único acceso al interno Collection es a través de los métodos que expone de esta clase. Este patrón de diseño se conoce comúnmente como "colección personalizada".

Esto tiene la ventaja de manejar automáticamente el casting, y alivia a los consumidores de su código de tener que recordar importar detalles de implementación como este. Se ocupa de la (muy probable) posibilidad de que recorra una colección en tiempo de ejecución que solo se supone que contiene un tipo de objeto, pero accidentalmente se agregó un segundo tipo de objeto incompatible que causa su código lanzar una excepción Por supuesto, la desventaja es que debe volver a implementar la mayor parte de la funcionalidad que ya proporciona el objeto Collection, en forma de métodos públicos en su colección personalizada.

He aquí un ejemplo de cómo puede ir sobre eso:

Public Class CustomerCollection 

    ''#Internal collection, exposed by this class 
    Private m_Customers As Collection 

    Private Sub Class_Initialize() 
     ''#Set up the internal collection 
     Set m_Customers = New Collection 
    End Sub 

    Public Sub Add(ByVal cust as Customer, Optional ByVal key as String) 
     ''#Add the Customer object to the internal collection 
     If IsMissing(key) Then 
      m_Customers.Add cust 
     Else 
      m_Customers.Add cust, key 
     End If 
    End Sub 

    Public Property Get Count() As Integer 
     ''#Return the number of objects in the internal collection 
     Count = m_Customers.Count 
    End Property 

    Public Sub Remove(ByVal index As Variant) 
     ''#Remove the specified object from the internal collection, 
     ''# either by its index or its key 
     m_Customers.Remove index 
    End Sub 

    Public Function Item(ByVal index As Variant) as Customer 
     ''#Return the specified object from the internal collection, 
     ''# either by its index or its key 
     Set Item = m_Customers.Item(index) 
    End Function 

    Public Sub Clear() 
     ''#Removes all objects from the internal collection 
     Set m_Customers = New Collection 
    End Sub 

End Class 

Tenga en cuenta que con el fin de establecer la propiedad de la colección personalizada Item como método predeterminado de la colección (como el incorporado en Collection objeto), es necesario seguir estos pasos en el IDE de VB 6:

1. de los menú "Herramientas", haga clic en "Atributos del procedimiento"

2. Seleccione el nombre de su clase personalizada en el cuadro combinado "Nombre".

3. Cuando aparece el cuadro de diálogo, haga clic en el botón "Avanzado".

4. Seleccione el elemento "(Predeterminado)" en el cuadro combinado "ID de procedimiento".

5. Haga clic en "Aceptar"

Si también le gustaría permitir la enumeración de la clase personalizada utilizando la sintaxis For Each (también como la incorporada en Collection objeto), se puede añadir una NewEnum función de la clase personalizada:

Public Property Get NewEnum() As IUnknown 
    ''#Provides support for enumeration using For Each 
    Set NewEnum = m_Customers.[_NewEnum] 
End Property 

Una vez que hayas hecho esto, es necesario instruir a VB para utilizar esta propiedad:

1. Al igual que antes, abra el diálogo "Atributos del procedimiento" en el menú "Herramientas"

2. Seleccione el nombre de la clase personalizada en el cuadro combinado "Nombre".

3. Cuando aparece el cuadro de diálogo, haga clic en el botón "Avanzado".

4. Escriba el número "-4" en el cuadro combinado "ID de procedimiento".

5. Haga clic en "Aceptar"

Answer 2

VB6 es un lenguaje antiguo. No contiene tipos de plantilla como los hay en los idiomas modernos (C++, C#, Java). Por lo tanto, deberá almacenar sus objetos como variantes en la colección y luego volver a enviarlos a su tipo de objeto.

Answer 3

EDIT: si la solución de Cody Gray es también de gran tamaño para sus necesidades, puede intentar en su lugar "lista de los pobres" solución de la forma siguiente:

Dim l() as somefixedclass 
Redim l(0) 

'... 
'increase size dynamically: 
Redim Preserve l(ubound(l)+1) 
'... 

Por supuesto, un List<somefixedclass> (en C#) o un List(Of somefixedclass) en VB.NET es mucho más "fácil de usar" porque tiene métodos como Buscar, Eliminar, Agregar Rango y algunas otras cosas útiles. La antigua construcción VB6 trata muy mal con el caso de la "lista vacía". No lo olvides, List < ..> el incremento tiene un rendimiento mucho mejor para listas grandes (tamaño> 1000).

Answer 4

Aquí es nuestra implementación de ArrayList. Puede usarlo como una base (no a través de la herencia, obviamente, sino a través de la composición como se expresa en la respuesta de CodyGray) para una clase fuertemente tipada, pero si no necesita seguridad tipo es mucho mejor que la clase Collection.

Option Explicit 

Private mavInternalArray() As Variant 
Private mlArraySize As Long 
Private mlCount As Long 
Private mlGrowSize As Long 
Private mfZeroIndex As Boolean 

'--------------------------------------------------------------------------------------- 
' Procedure Clear 
'--------------------------------------------------------------------------------------- 
Public Sub Clear() 
      Dim index As Long 

     For index = 0 To mlCount - 1 
      If IsObject(mavInternalArray(index)) Then 
       Set mavInternalArray(index) = Nothing 
      End If 
     Next index 
     mlCount = 0 

End Sub 



'--------------------------------------------------------------------------------------- 
' Procedure Swap 
'--------------------------------------------------------------------------------------- 
Public Sub Swap(Index1 As Long, index2 As Long) 
      Dim vTmp As Variant 


     If IsObject(mavInternalArray(index2)) Then 
      Set vTmp = mavInternalArray(index2) 
     Else 
      vTmp = mavInternalArray(index2) 
     End If 

     If IsObject(mavInternalArray(Index1)) Then 
      Set mavInternalArray(index2) = mavInternalArray(Index1) 
     Else 
      mavInternalArray(index2) = mavInternalArray(Index1) 
     End If 

     If IsObject(vTmp) Then 
      Set mavInternalArray(Index1) = vTmp 
     Else 
      mavInternalArray(Index1) = vTmp 
     End If 


End Sub 

Public Property Get ZeroIndex() As Boolean 
     ZeroIndex = mfZeroIndex 
End Property 

Public Property Let ZeroIndex(fZeroIndex As Boolean) 
     mfZeroIndex = fZeroIndex 
End Property 

Public Property Get GrowSize() As Long 
     GrowSize = mlGrowSize 
End Property 

Public Property Let GrowSize(lNewSize As Long) 
     Debug.Assert lNewSize > 0 
     mlGrowSize = lNewSize 
End Property 

Private Sub Class_Initialize() 
     mlGrowSize = 50 
     mlArraySize = mlGrowSize 
     mfZeroIndex = True 
     mlCount = 0 


     ReDim mavInternalArray(0 To mlGrowSize - 1) 

End Sub 

'--------------------------------------------------------------------------------------- 
' Procedure Remove 
'--------------------------------------------------------------------------------------- 
Public Sub Remove(index As Long) 
     Dim index2 As Long 


     For index2 = index To mlCount - 2 
      If IsObject(mavInternalArray(index2 + 1)) Then 
       Set mavInternalArray(index2) = mavInternalArray(index2 + 1) 
      Else 
       mavInternalArray(index2) = mavInternalArray(index2 + 1) 
      End If 
     Next index2 
      If mlCount <= 0 Then 
      Exit Sub 
      End If 
     mlCount = mlCount - 1 
     If IsObject(mavInternalArray(mlCount)) Then 
      Set mavInternalArray(mlCount) = Nothing 
     Else 
      mavInternalArray(mlCount) = False 
     End If 
End Sub 

'--------------------------------------------------------------------------------------- 
' Procedure Items 
'--------------------------------------------------------------------------------------- 
Public Function Items(index As Long) As Variant 
     If Not mfZeroIndex Then 
      index = index - 1 
     End If 

     If index < mlCount And index >= 0 Then 
      If IsObject(mavInternalArray(index)) Then 
       Set Items = mavInternalArray(index) 
      Else 
       Items = mavInternalArray(index) 
      End If 
     End If 
End Function 

Public Sub SetItem(index As Long, Item As Variant) 
     If Not mfZeroIndex Then 
      index = index - 1 
     End If 
     If IsObject(Item) Then 
      Set mavInternalArray(index) = Item 
     Else 
      mavInternalArray(index) = Item 
     End If 
End Sub 

'--------------------------------------------------------------------------------------- 
' Procedure Add 
'--------------------------------------------------------------------------------------- 
Public Function Add(vItem As Variant) As Long 

     mlCount = mlCount + 1 
     If mlCount > mlArraySize Then 
      mlArraySize = mlArraySize + mlGrowSize 
      ReDim Preserve mavInternalArray(0 To mlArraySize - 1) 
     End If 

     If IsObject(vItem) Then 
      Set mavInternalArray(mlCount - 1) = vItem 
     Else 
      mavInternalArray(mlCount - 1) = vItem 
     End If 

     Add = mlCount - 1 

End Function 

'--------------------------------------------------------------------------------------- 
' Procedure ItemArray 
'--------------------------------------------------------------------------------------- 
Public Function ItemArray() As Variant 
     Dim vReturnArray As Variant 

     vReturnArray = mavInternalArray 
     ReDim Preserve vReturnArray(0 To mlCount - 1) 
     ItemArray = vReturnArray 
End Function 

Public Function Count() As Long 
     Count = mlCount 
End Function 


'--------------------------------------------------------------------------------------- 
' Procedure Insert 
'--------------------------------------------------------------------------------------- 
Public Function Insert(index As Long, vItem As Variant) As Long 
     Dim index2 As Long 

     'Make sure array is large enough for a new item 
     mlCount = mlCount + 1 
     If mlCount > mlArraySize Then 
      mlArraySize = mlArraySize + mlGrowSize 
      ReDim Preserve mavInternalArray(0 To mlArraySize - 1) 
     End If 

     'Bump all the items with a higher index up one spot 

     If index >= mlCount - 1 Then 
      If IsObject(vItem) Then 
       Set mavInternalArray(mlCount - 1) = vItem 
      Else 
       mavInternalArray(mlCount - 1) = vItem 
      End If 
     Else 

      For index2 = mlCount - 1 To index + 1 Step -1 
       If IsObject(vItem) Then 
        Set mavInternalArray(index2) = mavInternalArray(index2 - 1) 
       Else 
        mavInternalArray(index2) = mavInternalArray(index2 - 1) 
       End If 
      Next index2 

      If IsObject(vItem) Then 
       Set mavInternalArray(index) = vItem 
      Else 
       mavInternalArray(index) = vItem 
      End If 
     End If 
     Insert = mlCount - 1 

End Function 


Public Sub Clone(ByRef cDestinationDynamicArray As clsDynamicArray) 
     Dim index As Long 

     If cDestinationDynamicArray Is Nothing Then 
      Set cDestinationDynamicArray = New clsDynamicArray 
     End If 

     cDestinationDynamicArray.Clear 

     For index = 0 To mlCount - 1 
      Call cDestinationDynamicArray.Add(mavInternalArray(index)) 
     Next index 

End Sub 

Public Property Get NewEnum() As IUnknown 
    ''#Provides support for enumeration using For Each 
    Set NewEnum = m_Customers.[_NewEnum] 
End Property