VB实现List集合

Option Explicit'***********************List集合 CArrayList.cls*****************************Private Declare Function SafeArrayGetDim Lib "oleaut32.dll" (ByRef psa() As Any) As LongPrivate mArray()        As Variant'添加元素
Public Sub Add(E As Variant)Dim Size As LongSize = Count()ReDim Preserve mArray(Size)mArray(Size) = E
End Sub'插入元素
Public Sub Insert(ByVal Index As Long, E As Variant)Dim Size        As LongDim i           As LongSize = Count()ReDim Preserve mArray(Size)For i = Size To Index + 1 Step -1mArray(i) = mArray(i - 1)Next imArray(Index) = E
End Sub'删除元素，通过索引
Public Sub Remove(ByVal Index As Long)If Count() = 0 ThenErr.Raise vbError, , "下标越界"Exit SubEnd IfIf Index < 0 Or Index > UpBound() ThenErr.Raise vbError, , "下标越界"Exit SubEnd IfDim i   As LongFor i = Index To UpBound() - 1mArray(i) = mArray(i + 1)Next iIf UpBound() > 0 ThenReDim Preserve mArray(UpBound() - 1)ElseErase mArrayEnd If
End Sub'删除项目
Public Sub RemoveItem(E As Variant)If Count() = 0 ThenExit SubEnd IfDim i   As LongFor i = 0 To UpBound()If mArray(i) = E ThenRemove iExit ForEnd IfNext i
End Sub'元素数量
Public Function Count() As LongCount = UpBound() + 1
End Function'元素上限
Public Function UpBound() As LongIf SafeArrayGetDim(mArray) > 0 ThenUpBound = UBound(mArray)ElseUpBound = -1End If
End Function'是否为空
Public Function IsEmpty() As BooleanIsEmpty = (Count() = 0)
End Function'清除
Public Sub Clear()If Count() > 0 Then Erase mArray
End Sub'获取项目值
Public Property Get Item(ByVal Index As Long) As VariantItem = mArray(Index)
End Property'设置项目值
Public Property Let Item(ByVal Index As Long, E As Variant)mArray(Index) = E
End Property'查找项目位置
Public Function IndexOf(E As Variant) As LongDim i   As LongFor i = 0 To UpBound()If Item(i) = E ThenIndexOf = iExit FunctionEnd IfNext iIndexOf = -1
End Function'包含项目
Public Function Contains(E As Variant) As BooleanContains = (IndexOf(E) <> -1)
End Function'包含集合
Public Function ContainsAll(List As CArrayList) As BooleanIf List Is Nothing ThenExit FunctionEnd IfDim i   As LongFor i = 0 To List.UpBound()If Not Contains(List.Item(i)) ThenExit FunctionEnd IfNext iContainsAll = True
End Function'移除集合
Public Sub RemoveAll(List As CArrayList)If List Is Nothing ThenExit SubEnd IfIf IsEmpty() ThenExit SubEnd IfDim i   As LongFor i = 0 To List.UpBound()RemoveItem List.Item(i)Next i
End Sub'添加集合
Public Sub AddAll(List As CArrayList)If List Is Nothing ThenExit SubEnd IfDim i   As LongFor i = 0 To List.UpBound()Add List.Item(i)Next i
End Sub'获取迭代器
Public Function Iterator() As CIteratorDim It As New CIteratorIt.SetList MeSet Iterator = It
End Function

Option Explicit'*****************迭代器 CIterator.cls************************Private Declare Function SafeArrayGetDim Lib "oleaut32.dll" (ByRef psa() As Any) As LongPrivate mList           As CArrayList
Private mIndex          As Long
Private HasElement      As BooleanPrivate Sub Class_Initialize()mIndex = -1
End SubPublic Sub SetList(List As CArrayList)Set mList = List
End Sub'是否有下一个元素
Public Function HasNext() As BooleanIf mIndex + 1 <= mList.UpBound() ThenHasNext = TrueEnd If
End Function'下一个元素
Public Function NextItem() As VariantmIndex = mIndex + 1NextItem = mList.Item(mIndex)HasElement = True
End Function'删除当前元素
Public Function Remove()If Not HasElement ThenErr.Raise vbError, , "迭代器无引用"Exit FunctionEnd IfmList.Remove mIndexmIndex = mIndex - 1HasElement = False
End Function

Option Explicit'**********************测试 frm_Test.frm**************************Dim List As CArrayList
Dim i   As LongPrivate Sub cmdAdd_Click()List.Add 100List.Add 101List.Add 102List.Add 103
End SubPrivate Sub cmdAddAll_Click()Dim mList As New CArrayListmList.Add 300mList.Add 400List.AddAll mList
End SubPrivate Sub cmdClear_Click()List.Clear
End SubPrivate Sub cmdContains_Click()Dim mList As New CArrayListmList.Add 100mList.Add 105MsgBox List.ContainsAll(mList)
End SubPrivate Sub cmdEnum_Click()Debug.Print "========="For i = 0 To List.UpBound()Debug.Print List.Item(i)Next i
End SubPrivate Sub cmdFind_Click()MsgBox List.IndexOf(200)
End SubPrivate Sub cmdInsert_Click()List.Insert 4, 300
End Sub'迭代，可在遍历时删除
Private Sub cmdIterator_Click()Dim It As CIteratorSet It = List.IteratorDim v As LongDebug.Print "it================"While It.HasNextv = It.NextItemDebug.Print vIf v = 101 ThenIt.RemoveEnd IfWend
End SubPrivate Sub cmdRemove_Click()List.Remove 1
End SubPrivate Sub cmdRemoveItem_Click()List.RemoveItem 102
End SubPrivate Sub cmdSet_Click()List.Item(1) = 200
End SubPrivate Sub cmdSize_Click()MsgBox "size: " & List.Count() & ",ubound: " & List.UpBound
End SubPrivate Sub Command1_Click()Dim mList As New CArrayListmList.Add 100mList.Add 102List.RemoveAll mList
End SubPrivate Sub Form_Load()Set List = New CArrayListEnd Sub

VB实现List集合相关推荐

vb.net controls集合
vb.net中每一个form窗体中都包含一个controls集合,它包含了自动获取窗体的控件,即窗体中有什么控件它里面就有什么控件,例如它包含Text,ListText,comboBox,botton ...
STL之set（集合）详解
STL之set(集合)详解一.基本概念二.常用函数 2.1.构造/析构函数 2.1.1.构造函数 2.1.2.析构函数 2.1.3.等号操作符 2.2.迭代器 2.3.容量 2.4.元素插入.删除 ...
VB开发源码+视频教程大集合
2019独角兽企业重金招聘Python工程师标准>>> VB开发源码+视频教程大集合有人说:VB已死,已经退出了这个更新换代飞快的编程世界.但是有谁能说这是个绝对正确的结论呢?虽然 ...
vb趣味编程弹球小游戏_最好玩的微信小游戏集合，总有一款是你没玩过的
大家好,这里是小雅龙生活趣味时间,自从17年微信推出小游戏程序以来,微信小游戏行业可谓是炙手可热,知道2019年不断有许许多多的微信小游戏如雨后春笋般的生根发芽.下面就由我带大家来看看今年最好玩,最受 ...
【VB】学生信息管理系统4——数据库的发展
由于连接数据的时候出现了很多不懂得问题,为什么要连接,它是怎么连接的,查着查着,就越看越多.又不舍得就这么放过这些问题,所以就耐心看看究竟是怎么回事! 1.自从出现数据库,人们渴望用数据和应用程序做交 ...
机房收费系统（VB.NET）——超具体的报表制作过程
之前做机房收费系统用的报表是Grid++Report,这次VB.NET重构中用到了VisualStudio自带的报表控件. 刚開始当然对这块功能非常不熟悉,只是探究了一段时间后还是把它做出来了. 以下 ...
.NET/C#中对自定义对象集合进行自定义排序的方法
一个集合可否排序,要看系统知不知道排序的规则,像内建的系统类型,int ,string,short,decimal这些,系统知道怎么排序,而如果一个集合里面放置的是自定义类型,比如自己定义了一个Car ...
201803考试批次2C 程序设计语言,201803考试批次2可视化程序设计（VB）D卷
201803考试批次2可视化程序设计(VB)D卷 2018-12-15 903 201803考试批次2可视化程序设计(VB)D卷可视化程序设计(VB) 一 .单项选择题 (共 10 题.0 / 20 ...
VB.NET 数组的定义动态使用多维数组
我们都知道在全部程序设计语言中数组都是一个非常重要的概念,数组的作用是同意程序猿用同一个名称来引用多个变量,因此採用数组索引来区分这些变量.非常多情况下利用数组索引来设置一个循环,这样就能够高效地处理 ...
VB.net版机房收费系统——结账功能实现（调错与优化）
调错部分上一篇博客<VB.net版机房收费系统--结账功能实现(代码部分>说的是结账功能的实现,亮出了代码.是在为这篇博客做铺垫.尽管结账功能代码是借鉴的巨人的博客.可是自己比着葫芦画瓢 ...

VB实现List集合

VB实现List集合相关推荐

最新文章

热门文章