代码如下:
显示类clsBaby的代码:
Option Explicit
Private strAddress As String ' 地址属性
Private strCode As String ' 邮政编号属性
Private strMotherName As String ' 母亲姓名属性
Private strFatherName As String ' 父亲姓名属性
Private strBabySex As String ' Baby性别属性
Private lngBabyKilo As Long ' Baby体重属性
Private strTaker As String ' 护理人代码属性
Private strDoctors As String ' 医务人代码属性
' 设置地址
Public Property Let Address(ByVal newValue As String)
strAddress = newValue
End Property
' 获得地址
Public Property Get Address() As String
Address = strAddress
End Property
'****************************************************************************
' 设置邮政编号
Public Property Let Code(ByVal newValue As String)
strCode = newValue
End Property
' 获得邮政编号
Public Property Get Code() As String
Code = strCode
End Property
'****************************************************************************
' 设置母亲姓名
Public Property Let MotherName(ByVal newValue As String)
strMotherName = newValue
End Property
' 获得母亲姓名
Public Property Get MotherName() As String
MotherName = strMotherName
End Property
'****************************************************************************
' 父亲姓名
Public Property Let FatherName(ByVal newValue As String)
strFatherName = newValue
End Property
Public Property Get FatherName() As String
FatherName = strFatherName
End Property
'****************************************************************************
' Baby性别
Public Property Let BabySex(ByVal newValue As String)
strBabySex = newValue
End Property
Public Property Get BabySex() As String
BabySex = strBabySex
End Property
'****************************************************************************
' Baby体重
Public Property Let BabyKilo(ByVal newValue As Long)
lngBabyKilo = newValue
End Property
Public Property Get BabyKilo() As Long
BabyKilo = lngBabyKilo
End Property
'****************************************************************************
' 护理人代码
Public Property Let Taker(ByVal newValue As String)
strTaker = newValue
End Property
Public Property Get Taker() As String
Taker = strTaker
End Property
'****************************************************************************
' 医务人代码
Public Property Let Doctors(ByVal newValue As String)
strDoctors = newValue
End Property
Public Property Get Doctors() As String
Doctors = strDoctors
End Property
'****************************************************************************
最后是初生婴儿窗体的代码：
窗体如下：
代码：
Public Babys As New Collection
Public babyInfor As clsBaby
Private Sub cmdAdd_Click()
' 判断基本数据是否填写
If Trim(txtMotherName.Text) = Empty Then
MsgBox "母亲姓名不能为空", vbInformation + vbOKOnly, "系统提示"
Exit Sub
ElseIf Trim(cboBabySex.Text) = Empty Then
MsgBox "婴儿性别不能为空", vbInformation + vbOKOnly, "系统提示"
Exit Sub
ElseIf Trim(cboTakers.Text) = Empty Then
MsgBox "护理人员不能为空", vbInformation + vbOKOnly, "系统提示"
Exit Sub
End If
Set babyInfor = New clsBaby ' 分配内存空间
' 向babyInfor对象添加数据
babyInfor.Address = Trim(txtAddress.Text)
babyInfor.Code = Trim(txtCode.Text)
babyInfor.MotherName = Trim(txtMotherName.Text)
babyInfor.FatherName = Trim(txtFatherName.Text)
babyInfor.BabySex = Trim(cboBabySex.Text)
If Trim(txtBabyKilo.Text) = Empty Then
babyInfor.BabyKilo = 0
Else
babyInfor.BabyKilo = txtBabyKilo.Text
End If
babyInfor.Taker = Trim(cboTakers.Text)
babyInfor.Doctors = Trim(cboDoctors.Text)
' 将babyInfor对象添加到集合里去
Babys.Add babyInfor
' 清空文本框中的婴儿信息
txtAddress.Text = Empty
txtCode.Text = Empty
txtMotherName.Text = Empty
txtFatherName.Text = Empty
cboBabySex.ListIndex = 0
txtBabyKilo.Text = Empty
cboTakers.ListIndex = 0
cboDoctors.ListIndex = 0
End Sub
Private Sub cmdPrint_Click() ' 在另一个窗体打印baby的信息
Dim i As Integer
If Babys.Count = 0 Then
MsgBox "请至少输入一个婴儿的情况，才能进行打印预览...", vbInformation + vbOKOnly, "系统提示"
Exit Sub
End If
' 初始化打印窗体
frmView.Show
frmView.Cls
frmView.FontSize = 20
frmView.CurrentX = 2000
frmView.CurrentY = 100
frmView.Print "初生婴儿登记情况列表"
frmView.Line (50, 600)-(9000, 600)
frmView.FontSize = 9
frmView.CurrentX = 0
frmView.CurrentY = 700
' 在打印窗口中打印Baby的信息
For i = 1 To Babys.Count
frmView.Print " 母亲姓名：" & Babys.Item(i).MotherName
frmView.Print " 家庭详细住址：" & Babys.Item(i).Address
frmView.Print " 住址邮政编码：" & Babys.Item(i).Code
frmView.Print " 父亲姓名：" & Babys.Item(i).FatherName
frmView.Print " 婴儿性别：" & Babys.Item(i).BabySex
frmView.Print " 婴儿体重：" & Babys.Item(i).BabyKilo
frmView.Print " 护理人员代码：" & Babys.Item(i).Taker
frmView.Print " 医务人员代码：" & Babys.Item(i).Doctors
frmView.Line (50, 700 + 1600 * i)-(9000, 700 + 1600 * i)
Next i
End Sub
Private Sub cmdExit_Click() ' 退出
Unload Me
End Sub
Private Sub Form_Load()
Dim strId As String
Dim i As Integer
' 初始化婴儿性别列表
cboBabySex.AddItem "男"
cboBabySex.AddItem "女"
cboBabySex.ListIndex = 0
' 初始化护理人员代码
For i = 0 To 9
strId = "010" + CStr(i)
cboTakers.AddItem strId
Next i
For i = 10 To 12
strId = "01" + CStr(i)
cboTakers.AddItem strId
Next i
cboTakers.ListIndex = 0
' 初始化医务人员代码
For i = 0 To 9
strId = "030" + CStr(i)
cboDoctors.AddItem strId
Next i
For i = 10 To 20
strId = "01" + CStr(i)
cboDoctors.AddItem strId
Next i
cboDoctors.ListIndex = 0
End Sub
Private Sub txtBabyKilo_LostFocus() ' 判断体重是否为数字
If IsNumeric(txtBabyKilo.Text) = False Then
MsgBox "只能为数字", vbInformation + vbOKOnly, "系统提示"
txtBabyKilo.Text = Empty
End If
End Sub
运行如下：
输入第一个婴儿的资料：
然后按增加按钮，最后在按打印按钮打印：
再次增加婴儿资料：
打印如下：
我的还有一个错误，刚刚发现的，就是第二次打印时没有打印母亲的姓名。和合。
懒得改了。呵呵
评论