lotusscript--Vector class

类似于java中的Vector类的功能

应用

Dim v As New Vector() Call v.addElement("Domino") Call v.addElement("Notes") Call v.addElement("R5") Print "Elements are: " & v.toString() 

源代码：

由三个类组成 分别为：Vector VectorEnumeration Enumeration

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

Public Class VectorEnumeration As Enumeration
 v As Vector
 index As Integer
 Public Sub new(v As Vector)
  Set Me.v = v
  index = 0
 End Sub
 Public Function hasMoreElements() As Variant
  hasMoreElements = (index < v.size())
 End Function
 Public Function nextElement() As Variant
  If Isobject(v.elementAt(index)) Then
   Set nextElement = v.elementAt(index)
  Else
   nextElement = v.elementAt(index)
  End If
  index = index + 1
 End Function
End Class

Public Class Enumeration
 Public Function hasMoreElements() As Variant
  Error 2000, Typename(Me) & "." & Lsi_Info(2) & "not implemented"
 End Function
 Public Function nextElement() As Variant
  Error 2000, Typename(Me) & "." & Lsi_Info(2) & "not implemented"
 End Function
End Class