VBS与VBA的类及对象 - Office中国论坛/Access中国论坛

Private Sub Class_Initialize()
statements
End Sub

复制代码

Private Sub Class_Terminate()
statements
End Sub

复制代码

Class TestClass
Private Sub Class_Initialize ' 设置 Initialize 事件。
MsgBox("TestClass started")
End Sub
Private Sub Class_Terminate ' 设置 Terminate 事件。
MsgBox("TestClass terminated")
End Sub
End Class
Set X = New TestClass ' 创建一个 TestClass 实例。
Set X = Nothing ' 删除实例。

复制代码

Class Circle
Public r
Private mArea
Public Sub Init(a)
r=a
End Sub
Public Function Area()
If mArea="" Then mArea=Atn(1)*4*r*r
Area=mArea
End Function
Private Sub EchoInfo()
MsgBox "圆的半径是：" & r & vbCrLf & "圆的面积是：" & mArea
End Sub
End Class
Set c = New Circle ' 创建一个 TestClass 实例。
c.Init 2
'Init是在Python中的构造函数名称，你可以定义其他的名称，随你喜欢
'其他语言，如C#，C++都是用类名做为构造函数名称，显然没有Init简单易记
MsgBox c.r
MsgBox c.Area()
'MsgBox c.mArea
'无法访问，因为这个字段是私有的，只能类内部访问，如上面的Area方法
'MsgBox c.EchoInfo()
'无法访问，因为这个方法是私有的，只能类内部访问
Set c = Nothing ' 删除实例

复制代码

Class Student
Private mAge,mName,mNumber,mSex,mLover,mYear,mRank
'这里字段最好都定义为私有的，这样可以更强的控制字段的读写
'并可以在读写时提供一些其他的计算处理
'这里我们假设Lover(情侣)也是一个学生，那么此字段就是一个
'对象类型的字段，请留意它的属性是怎么实现的
Dim Belief '人生信条，这里不指定其可访问性
Sub Init(namestr,sexstr,ageint,rankint)
If mName="" Then '这个判断可以确保实例只被初始化一次
mName=namestr
mSex=sexstr
mAge=ageint
mRank=rankint
Randomize
mNumber=Int(Rnd*10000+1)
mYear=Year(Date)
'这里没有提供mLover字段的初始化，毕竟一见钟情太少
Else
MsgBox "No,you can't initialize a instance twice"
End If
End Sub
Property Get Rank()
Rank=mRank
End Property
Property Let Rank(value)
mRank=value
End Property
'这里的写属性只能是Property Let，不能是Property Set，因为在外部要赋值给属性的是一个int型的
'是值类型，不是对象类型（常说的引用类型）所以不能用Set，外部赋值时也不能用Set语句
Property Get Age()
If mYear<Year(Date) Then
mYear=Year(Date)
mAge=mAge+1
End If
age=mAge
End Property
'Age一经设置只会随着年份增加而改变，毕竟人们生活于同一个时空
Public Default Property Get Name()
Name=mName
End Property
'学生姓名默认是不能更改，当然你也可以改名字，建议在类中定义
'保守的改名方法
'这里定义Name为默认属性，注意使用Default关键字定义默认属性时，必须有Public关键字
Property Get Sex()
Sex=mSex
End Property
'学生性别当然，一经初始化，不会更改，除非蛋疼得跑去变性
Property Get Lover()
Set Lover=mLover
End Property
Property Set Lover(value)
Set mLover=value
End Property
'有Set属性，此子（女）真风流，如果你专情，不妨Private它
'这里写成Property Let也是可以的，不过后面Set stu1.Lover=stu2要把Set去掉
'由此例可以看出Property Let和Property Get定义的属性内部定义都一样的Set语句，但是在外部
'时，如果上面这里定义的是Let属性那么不能用Set语句来赋值，虽然赋值给Lover属性的是一个
'引用类型（即对象类型），如果上面这里是定义的是Set属性，则必须Set语句
'由以上Lover和Rank两个属性知，我们可以得出这样的结论：
'(1)无论是对引用类型字段的封装，还是对值类型字段的封装，都可以用Property Let，而Set
'只能在对引用类型字段封装时出现
'(2)定义类时我们可以根据外部赋值到属性的类型来决定用Set还是用Let，而后定义好了之后，再由
'定义的是Property Let还是Property Set来决定赋值方式，即用不用Set语句
Function Info()
Info="学生信息：" & vbCrLf & _
"学号：" & mNumber & vbCrLf & _
"姓名：" & mName & vbCrLf & _
"性别：" & mSex & vbCrLf & _
"年龄：" & Age & vbCrLf & _
"排名：" & mRank & vbcrlf & _
"情侣：" & mLover
End Function
'这之中Age通过属性来获取以确保每次获取的是正确的年龄
'没有定义Age的写属性，这样就保护了字段，避免非法改写
'外部只能通过Age的读属性来访问，所以确保了外部读取年龄的正确性
'对mLover.Name可以直接用mLover来输出，因为它的Name属性是默认属性
End Class
Dim stu1,stu2
'最好定义变量，这样可以防止全局变量对自定义函数的影响
Set stu1=New Student
Set stu2=New Student
stu1.Init "Jobs","BigBoy",23,13
'stu1.Age=32
'这里运行会报错，因为没有定义Age的写属性，外部无法通过赋值修改年龄
stu2.Init "Joliy","Girl",21,10
Set stu1.Lover=stu2
MsgBox stu1.Info '可访问，说明方法隐式为Public
stu1.Rank=8 '可访问，说明属性隐式为Public
stu1.Belief="No pains,no gains"
MsgBox stu1.Belief '可访问，说明字段隐式为Public
MsgBox "使用默认属性：" & vbcrlf & stu1 & vbcrlf & stu2
Set stu1=Nothing
Set stu2=Nothing

复制代码

Class TestClass
Sub Class_Initialize ' 设置 Initialize 事件。
MsgBox("TestClass started")
End Sub
Sub Class_Terminate ' 设置 Terminate 事件。
MsgBox("TestClass terminated")
End Sub
End Class
Set X = New TestClass ' 创建一个 TestClass 实例。
x.Class_Initialize '可正常运行
Set X = Nothing ' 删除实例。

复制代码