VB中类模块使用简单示例

Eddy 发布于2010-12-12 23:21:41 分类: 程序设计 已浏览loading 网友评论1条 我要评论

'*************************************************************************
'**代码名称:VB类模块演示
'**描 述:VB类模块使用示例[cStack.cls文件]
'**说 明:www.rrgod.com
'**创 建 人:Eddy
'**日 期:2010-12-12
'*************************************************************************

Option Explicit

Private x(10) As Variant '存放堆栈数据
Private tos As Long '栈顶指针
Public Top As Variant '存放栈顶值
Event error(ByVal ErrNum As Long, ByVal ErrMsg As String) '堆栈溢出时被触发

Private Sub Class_Initialize() '初始化
tos = -1
Top = vbNull
End Sub

Public Sub Push(Optional a As Variant) '给堆栈增加一个值
If tos + 1 >= UBound(x) Then
RaiseEvent error(1, "Stack overflow.")
ElseIf IsMissing(a) Then '使用 IsMissing 函数来检测在调用一个程序时是否提供了可选 Variant 参数
tos = tos + 1
x(tos) = Top
Else
tos = tos + 1
x(tos) = a
Top = a
End If
End Sub

Public Function Pop() As Variant '从堆栈中取出一个值
If tos = -1 Then
RaiseEvent error(2, "Stack underflow.")
ElseIf tos = 0 Then
Pop = x(tos)
Top = vbNull
Else
Pop = x(tos)
tos = tos - 1
Top = x(tos)
End If
End Function

'ParamArray只用于 arglist 的最后一个参数,指明最后这个参数是一个 Variant 元素的 Optional 数组。
'使用 ParamArray 关键字可以提供任意数目的参数。
'ParamArray 关键字不能与 ByVal,ByRef,或 Optional 一起使用。
Public Sub PushEx(ParamArray a() As Variant) '一次压入多个值
Dim z As Variant
For Each z In a
If tos + 1 >= UBound(x) Then
RaiseEvent error(1, "Stack overflow.")
Exit Sub
Else
tos = tos + 1
x(tos) = z
End If
Next z
Top = x(tos)
End Sub

Public Sub Clear() '初始化堆栈
tos = -1
End Sub

Public Property Get Count() As Variant '在堆栈中返回顶
Count = tos
End Property

Public Property Let Count(ByVal vNewValue As Variant)
tos = vNewValue
End Property

'*************************************************************************
'**代码名称:VB类模块演示
'**描 述:VB类模块使用示例
'**说 明:www.rrgod.com
'**创 建 人:Eddy
'**日 期:2010-12-12
'*************************************************************************

Option Explicit
Private WithEvents s As cStack
Private Sub Command1_Click()
s.Push Text1.Text
End Sub

Private Sub Command2_Click()
Text1.Text = s.Pop
End Sub

Private Sub Command3_Click()
Text1.Text = s.Top
End Sub

Private Sub Command4_Click()
s.Clear
End Sub

Private Sub Command5_Click()
Text1.Text = s.Count
End Sub

Private Sub Command6_Click()
s.PushEx "rrgod", "eddy", "blog"
End Sub

Private Sub Form_Load()
Set s = New cStack
End Sub

Private Sub Form_Unload(Cancel As Integer)
Set s = Nothing
End Sub

Private Sub s_error(ByVal ErrNum As Long, ByVal ErrMsg As String)
MsgBox ErrNum & ": " & ErrMsg
End Sub

Private Sub Timer1_Timer()
Label1.Caption = "当前栈顶值为:" & s.Top
End Sub

已经有(1)位网友发表了评论,你也评一评吧!
原创文章如转载,请注明:转载自Eddy Blog
原文地址:http://www.rrgod.com/program/678.html     欢迎订阅Eddy Blog

  1. 发表于2010-12-13 13:19:06

    哈哈~~类模块是个非常好玩的东东

    Haha

    Eddy 于 2010-12-13 14:20:01 回复
    没事玩玩COM方面的编程……

记住我的信息,下次不用再输入 欢迎给Eddy Blog留言