Copy Code code as follows:
Class Vector
Private Vector_datas ()
Private initial_capacity ' initialization capacity
Private capacity_increment ' capacity increment
Private element_count ' meta primes
Private max_capacity ' Total capacity
Private Sub Class_Initialize ()
RemoveAll
End Sub
Public Function RemoveAll ()
Element_count = 0
Initial_capacity = 10
Capacity_increment = 10
Max_capacity = initial_capacity
ReDim Vector_datas (initial_capacity)
End Function
Public Property Get Count ()
Count = Element_count
End Property
Public Property Get Capacity ()
Capacity = max_capacity
End Property
Public Property Get Initialcapacity ()
Initialcapacity = initial_capacity
End Property
Public Property Get Capacityincrement ()
Capacityincrement = Capacity_increment
End Property
Public Default Property Get Item (Index)
If IsObject (Vector_datas (index)) Then
Set Item = Vector_datas (index)
Else
Item = Vector_datas (index)
End If
End Property
Public Function ADD (element)
Call Insert (Element_count, Element)
End Function
Public Function Remove (element)
Dim Index
index = Search (Element)
RemoveAt (Index)
Remove = Index
End Function
Public Function RemoveAt (index)
Dim I
For i = index + 1-element_count-1 Step 1
Call Internalelement (i-1, Vector_datas (i))
Next
Element_count = element_count-1
If max_capacity-capacity_increment > Element_count Then
Max_capacity = Max_capacity-capacity_increment
ReDim Preserve Vector_datas (max_capacity)
End If
End Function
Public Function Search (element)
Dim I
For i = 0 to element_count-1 Step 1
If Vector_datas (i) = Element Then
Search = i
Exit Function
End If
Next
Search =-1
End Function
Public Function Insert (index, Element)
If Index > Element_count Then
Err.Raise 20903, "Vector", "Array Index out of Bounds.", "", 0
End If
If element_count = 0 Then
Call Internalelement (0, Element)
ElseIf index = Element_count Then
Call Internalelement (Element_count, Element)
Else
Dim I
For i = Element_count to index + 1 Step-1
Call Internalelement (i, Vector_datas (i-1))
Next
Call Internalelement (index, Element)
End If
Element_count = Element_count + 1
If Element_count = max_capacity Then
max_capacity = Element_count + capacity_increment
ReDim Preserve Vector_datas (max_capacity)
End If
End Function
Public Function setelementat (index, Element)
If Index < 0 Or index > Element_count-1 Then
Err.Raise 20903, "Vector", "Array Index out of Bounds.", "", 0
End If
Call Internalelement (index, Element)
End Function
Private Function internalelement (index, Element)
On Error Resume Next
If IsObject (Element) Then
Set Vector_datas (index) = element
Else
Vector_datas (Index) = element
End If
If err.number <> 0 Then
MsgBox ("Vector internalelement Error:" & vbCrLf & "error Source:" & Err.Source & vbCrLf & "Error Num ber: "& Err.Number & vbCrLf &" Error Description: "& Err.Description & VbCrLf)
Err.Clear ' Clear error message
End If
End Function
Private Sub class_terminate () ' class destroy
Erase Vector_datas ' frees up the array of memory, setting each element to nothing
Initial_capacity = Empty
Capacity_increment = Empty
Element_count = Empty
Max_capacity = Empty
End Sub
End Class
This article from Csdn Blog, reproduced please indicate the source: http://blog.csdn.net/o1o2o3o4o5/archive/2009/10/20/4703033.aspx
