Les vectors

[oguruma]

merci à son auteur

Code : Tout sélectionner

Public Class Vector
   array As Variant
   elementLength As Integer
   capacityIncrement As Integer
   Public Sub new()
      elementLength = 0
      ensureCapacity(10)
   End Sub
   Public Sub copyInto(outArray As Variant)
      Dim i As Integer
      For i=Me.size()-1 To 0 Step -1
         outArray(i) = array(i)
      Next i
   End Sub
   Public Sub trimToSize()
      If Me.size() < Me.capacity() Then Redim Preserve array(Me.size()-1)
   End Sub
   Public Sub setCapacityIncrement(increment As Integer)
      Me.capacityIncrement = increment
   End Sub
   Public Sub ensureCapacity(minCapacity As Integer)
      On Error Goto handleError
      Dim newCapacity As Integer
      If capacityIncrement > 0 Then
         newCapacity = Me.capacity() + capacityIncrement
      Else
         newCapacity = Me.capacity() * 2
      End If
      If newCapacity < minCapacity Then newCapacity = minCapacity
      
      If newCapacity > Me.size() Then
         If newCapacity > Me.capacity Then
            If size = 0 Then
               Redim array(newCapacity)
            Else
               Redim Preserve array(newCapacity)
            End If
         End If
      End If
handleExit:
      Exit Sub
      
handleError:
      Print "Error " & Err & ", " & Error & " in line " & Erl & ", function " & Lsi_info(2)
      Resume handleExit
   End Sub
   Public Function setSize(newSize As Integer)
      If newSize < Me.size() Then
         Dim i As Integer
         For i = newSize-1 To Me.size()-1
            If Isobject(array(i)) Then
               Set array(i) = Nothing
            Else
               array(i) = ""
            End If
         Next i
      Elseif newSize > Me.size() Then
         ensureCapacity(newSize)
      End If
      Me.elementLength = newSize
   End Function
   Public Function size() As Integer
      size = elementLength
   End Function
   Public Function capacity() As Integer
      Me.capacity = 0
      If size = 0 Then Exit Function
      Me.capacity = Ubound(array) - Lbound(array) + 1
   End Function
   Public Function isEmpty() As Variant
      Me.isEmpty = (elementLength = 0)
   End Function
   Public Function elements() As Enumeration
      Set elements = New VectorEnumeration(Me)
   End Function
   Public Function contains(element As Variant) As Variant
      contains = False
      If Not indexOf(element) = -1 Then contains = True
   End Function
   Public Function indexOf(element As Variant) As Integer
      On Error Goto handleError
      indexOf = -1
      Dim i As Integer
      For i = 0 To elementLength - 1
         If equals(element, array(i)) Then
            indexOf = i
            Exit Function
         End If
      Next
handleExit:
      Exit Function
handleError:
      Print "Error " & Err & ", " & Error & " in line " & Erl & ", function " & Lsi_info(2)
      Error Err, Error
      Resume handleExit
   End Function
   Public Function lastIndexOf(element As Variant) As Integer
      lastIndexOf = -1
      Dim i As Integer
      For i = Me.size()-1 To 0 Step -1
         If equals(element, array(i)) Then
            lastIndexOf = i
            Exit Function
         End If
      Next
   End Function
   
   Private Function equals(element1 As Variant, element2 As Variant) As Integer
      Me.equals = False
      If Isobject(element1) And Not Isobject(element2) Then Exit Function
      If Isobject(element1) Then
         If element1 Is element2 Then equals = True
      Else
         If element1 = element2 Then equals = True
      End If
   End Function
   
   Public Function elementAt(index As Integer) As Variant
      If (index < 0) Or (index => Me.size()) Then Error 2000, "Array index out of bounds"
      If Isobject(array(index)) Then
         Set elementAt = array(index)
      Else
         elementAt = array(index)
      End If
   End Function
   Public Function firstElement() As Variant
      If Isobject(elementAt(0)) Then
         Set firstElement = elementAt(0)
      Else
         firstElement = elementAt(0)
      End If
   End Function
   Public Function lastElement() As Variant
      If Isobject(elementAt(Me.size()-1)) Then
         Set lastElement = elementAt(Me.size()-1)
      Else
         lastElement = elementAt(Me.size()-1)
      End If
   End Function
   Public Function setElementAt(element As Variant, index As Integer)
      If index >= Me.size() Then Error 2000, "Array index [" & index & "] out of bounds [" & size & "]"
      If Isobject(element) Then
         Set array(index) = element
      Else
         array(index) = element
      End If
   End Function
   Public Function removeElementAt(index As Integer)
      If index >= Me.size() Then Error 2000, "Array index [" & index & "] out of bounds [" & size & "]"
      Dim members As Variant
      Dim i As Integer
      Dim j As Integer
      Redim members(Me.size())
      j=0
      For i = 0 To Me.size-1
         If (i <> index) And (Not j > Me.size()) Then
            members(j) = array(i)
            j = j + 1
         End If
      Next i
      elementLength = elementLength - 1
      array = members
   End Function
   Public Function insertElementAt(element As Variant, index As Integer)
      Dim newSize As Integer
      newSize = Me.size() + 1
      If index >= newSize Then Error 2000, "Array index [" & index & "] out of bounds [" & newSize & "]"
      If newSize > capacity Then ensureCapacity(newSize)
      ' Hmmm... Implement the insertion here. But how?
      Dim target() As Variant
      Redim target(0 To capacity) As Variant
      Dim i As Integer
      For i = 0 To newSize-1
         If i = index Then
            If Isobject(element) Then
               Set target(i) = element
            Else
               target(i) = element
            End If
         Elseif i > index Then
            target(i) = array(i-1)
         Else
            target(i) = array(i)
         End If
      Next i
      array = target
      elementLength = elementLength + 1
   End Function
   Public Sub addElement(element As Variant)
      Dim newSize As Integer
      newSize = Me.size() + 1
      If newSize > capacity Then ensureCapacity(newSize)
      
      If Isobject(element) Then
         Set array(Me.size()) = element
      Else
         array(Me.size()) = element
      End If
      elementLength = elementLength + 1
   End Sub
   Public Sub addElements(elements As Variant)
      ' Adds all elements in the specified array or list
      If Not Isarray(elements) And Not Islist(elements) Then
         Call Me.addElement(elements)
      Else
         Forall x In elements
            Call Me.addElement(x)
         End Forall
      End If
   End Sub
   Public Function removeElement(element As Variant) As Variant
      removeElement = False
      Dim i As Integer
      i = indexOf(element)
      If i >= 0 Then
         removeElementAt(i)
         removeElement = True
         Exit Function
      End If
   End Function
   Public Sub removeAllElements()
      Dim i As Integer
      For i = 0 To Me.size() - 1
         If Isobject(array(i)) Then
            Set array(i) = Nothing
         Else
            array(i) = ""
         End If
      Next i
   End Sub
   Public Function implode(Byval separator As String) As String
      ' Creates a string of all elements in array, and the argument as separator.
      Me.implode = ""
      If Me.size <= 0 Then Exit Function
      Dim i As Integer
      Dim s As String
      For i = 0 To Me.size-2
         If Typename(Me.array(i)) = "STRING" Then
            s = s & Me.array(i) & separator
         Elseif Isobject(array(i)) Then
            s = s & Me.array(i).toString() & separator
         Else
            s = s & Cstr(Me.array(i)) & separator
         End If
      Next
      s = s & Me.array(size-1)      ' Do not append the separator to the last element
      Me.implode = s
   End Function
   Sub unique()
      ' Removes all duplicates in the internal array. Somewhat slow on really big arrays...
      If Me.isEmpty() Then Exit Sub
      Dim v As New Vector()
      Dim i As Integer
      For i = 0 To Me.size-1
         If Not v.contains(Me.array(i)) Then Call v.addElement(Me.array(i))
      Next i
      Dim a As Variant
      Redim a(v.size()-1)
      Call v.copyInto(a)
      Me.array = a
      Me.elementLength = Ubound(array) - Lbound(array) + 1
      Set v = Nothing
   End Sub
   
   Public Function toString() As String
      toString = Me.implode(", ")
   End Function
End Class