Class Vector 

Private vector_datas() 
Private initial_capacity '初始化容量 
Private capacity_increment '容量增量 
Private element_count '元素數 
Private max_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 To 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 Number: " & Err.Number & vbCrLf & "Error Description: " & Err.Description & vbCrLf) 
Err.Clear '清除錯誤信息 
End If 
End Function 

Private Sub Class_Terminate() '類銷毀 
Erase vector_datas '釋放數組占用的內存, 將每個元素都設為 Nothing 
initial_capacity = Empty 
capacity_increment = Empty 
element_count = Empty 
max_capacity = Empty 
End Sub 

End Class 


本文來自CSDN博客，轉載請標明出處：http://blog.csdn.net/o1o2o3o4o5/archive/2009/10/20/4703033.aspx