webEvelement 2009-10-20
代码如下:
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 '释放数组占用的内存, ⒚元素都O 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