甘肃农业大学信息科学技术学院：Visual?Basic?程序设计（二）：Example-8

【例8-1】 图形浏览器的设计。
Private Sub Dir1_Change()
File1.Path = Dir1.Path
File1.Pattern = "*.jpg;*.bmp;*.wmf;*.ico"
End Sub
Private Sub Drive1_Change()
Dir1.Path = Drive1.Drive
End Sub
Private Sub File1_Click()
Image1.Picture = LoadPicture(File1.Path & "\" & File1.FileName)
End Sub
【例8-2】 使用Dir函数来查找文件。
Private Sub Command1_Click()
Dim strFind As String,fileName As String
strFind = ″c:\windows\*.bmp″
fileName = Dir (strFind)
Do While fileName <> ″″
fileName = Dir
If fileName = ″″ Then Exit Do
List1.AddItem fileName
Loop
End Sub
【例8-3】 随机生成100个1～100间的正整数，并存入到文件“out.dat”中。
Private Sub Command1_Click()
Dim i As Integer,x As Integer
Randomize
Open "out.dat" For Output As #1
For i = 1 To 100
x = Int(Rnd * 100) + 1
Print #1,x;
Next
End Sub
【例8-4】 输入3个学生的学号、姓名、年龄并保存到文件“out.dat”中。
Private Sub Command1_Click()
Dim i As Integer,Age As Integer
Dim Name As String,Num As String
Open "out.dat" For Output As #1
For i = 1 To 3
Num = InputBox("请输入学号：")
Name = InputBox("请输入姓名：")
Age = Val(InputBox("请输入年龄："))
Write #1,Num,Name,Age
Next
Close #1
End Sub
【例8-5】 读入例8-4写入文件“out.dat”中的学号、姓名、年龄，并打印到窗体上。
Private Sub Command1_Click()
Dim Age As Integer
Dim Name As String,Num As String
Open "c:\out.dat" For Input As #1
Print "学号","姓名","年龄"
Do While Not EOF(1)
Input #1,Num,Name,Age
Print Num,Name,Age
Loop
Close #1
End Sub
【例8-6】 在窗体上放置一个文本框（名称为Text1，Multiline属性为True，ScrollBars属性为2）和一个命令按钮（名称为Cmd1，标题为“200－400间素数”），单击按钮把200到400之间的所有素数显示在文本框中，并计算出所有素数的和，把结果保存在“out.dat”文件中。已经给出了一个标准模块mode.bas，其中putdata过程可以把结果存入指定文件。把标准模块mode.bas添加到工程中，利用已经给出的putdata过程存储计算结果。
Sub putdata(t_FileName As String,T_Str As Variant)
Dim sFile As String
sFile = "\" & t_FileName '为得到正确的文件全路径，加“\”
Open App.Path & sFile For Output As #1 '打开文件
Print #1,T_Str '写数据
Close #1
End Sub
标准模块mode.bas如下：
Private Sub Cmd1_Click()
Dim i As Integer,j As Integer
Dim Sum As Integer
Text1.Text = ""
For i = 200 To 400 '求200到400间素数
For j = 2 To Int(Sqr(i)) '判断一个数是否是素数
If i Mod j = 0 Then Exit For
Next
If j > Int(Sqr(i)) Then '如果是素数执行下面操作
Sum = Sum + i '计算累加
Text1.Text = Text1.Text & Str(i) '在文本框中显示所有素数
End If
Next
putdata "out.dat",Sum '把结果写入数据
End Sub
【例8-7】 单击“读取数据”按钮从文件“in.txt”中读取100个整数，存放在一个数组中（下界为1），同时在文本框中显示这100个数。单击“计算保存”按钮，计算前20个数的和并保存到文件中。要求定义一个过程把计算结果保存到“result.txt”中。
Dim a(1 To 100) As Integer '声明一个窗体级数组
Sub putdata(ByVal a As Integer) '定义putdata过程用来把结果写入文件
Dim sFile As String
sFile = "\result.txt" '给出文件名result.txt，前面加“\”
Open App.Path & sFile For Output As #1
Print #1,a;
Close #1
End Sub
Private Sub Cmd1_Click()
Dim i As Integer
Text1.Text = ""
Open App.Path & "\in.txt" For Input As #1 '打开文件
For i = 1 To 100 '利用循环读入100个数据
Input #1,a(i) '读入数据
Text1.Text = Text1.Text & Str(i) '用Text1文本框显示
Next
Close #1
End Sub
Private Sub Cmd2_Click()
Dim sum As Integer,i As Integer
For i = 1 To 20
sum = sum + i
Next '计算前20个元素的和
putdata sum '调用putdata过程存储结果
End Sub
【例8-8】 单击“读取数据”按钮从文件“in.txt”中读取100个整数，存放在一个数组中（下界为1）。单击“排序保存”按钮，把数组中的100个整数从大到小排序，并把排序后的整数显示在文本框中，然后把排序后的整数存储到文件“out.txt”中。要求定义一个过程把指定个数的数组元素存储到“out.txt”中。
Dim arr(1 To 100) As Integer '定义窗体级数组
Sub putdata(a() As Integer,n As Integer) '一个参数是要保存数组，一个是保存个数
Dim sFile As String
sFile = "\out.txt"
Open App.Path & sFile For Output As #1 '打开文件
For i = 1 To n '利用循环保存n个数组元素
Print #1,a(i);
Next
Close #1
End Sub
Private Sub Cmd1_Click()
Dim i As Integer
Open App.Path & "in.txt" For Input As #1 '打开文件
For i = 1 To 100 '利用循环读取数据
Input #1,arr(i)
Next
Close #1
End Sub
Private Sub Cmd2_Click()
Dim i As Integer,j As Integer,t As Integer
Text1.Text = ""
For i = 1 To 99 '冒泡法排序
For j = 1 To 100 - i
If arr(j) < arr(j + 1) Then
t = arr(j)
arr(j) = arr(j + 1)
arr(j + 1) = t
End If
Next
Next
For i = 1 To 100 '把排序后的数据显示在文本框中
Text1.Text = Text1.Text & Str(arr(i))
Next
putdata arr,100 '保存数组中的100个数据
End Sub
【例8-9】 用Type…End Type语句定义一个记录数据类型，用来存储每个学生的学号、姓名、年龄。输入3个学生的记录，并存储到文件中。
Private Type stu '在窗体的通用声明内声明用户定义数据类型
Sno As String * 5 '注意，用户定义数据类型中的字符串必须是定长的
Name As String * 10
Age As Integer
End Type
Private Sub Command1_Click()
Dim recordstu As stu
Dim i As Integer
Open "tt.txt" For Random As #1 Len = Len(recordstu) '打开文件
For i = 1 To 3 '利用循环输入数据
recordstu.Sno = InputBox("请输入5位学号：")
recordstu.Name = InputBox("请输入姓名：")
recordstu.Age = Val(InputBox("请输入年龄："))
Put #1,i,recordstu '把记录存储到文件
Next
Close #1
End Sub
【例8-10】 读出例8-9写入的学生记录，并存储到数组中，然后打印到窗口上。
Private Type stu '在窗体的通用声明内声明用户定义数据类型
Sno As String * 5
Name As String * 10
Age As Integer
End Type
Private Sub Command2_Click()
Dim recordstu As stu
Dim i As Integer,recordnum As Integer
Open "tt.txt" For Random As #1 Len = Len(recordstu) '打开文件
recordnum = LOF(1) / Len(recordstu) '得到记录的总数
Print "学号","姓名","年龄" '打印标题
For i = 1 To recordnum
Get #1,i,recordstu
Print recordstu.Sno,recordstu.Name,recordstu.Age '打印数据
Next
Close #1
End Sub
【例8-11】 在例8-9写入的学生记录后添加一个新记录。
Private Type stu
Sno As String * 5
Name As String * 10
Age As Integer
End Type
Private Sub Command2_Click()
Dim recordstu As stu
Dim lastrecord As Integer
Open "tt.txt" For Random As #1 Len = Len(recordstu)
lastrecord = LOF(1) / Len(recordstu) + 1 '记录总数加1
recordstu.Sno = InputBox("请输入5位学号：")
recordstu.Name = InputBox("请输入姓名：")
recordstu.Age = Val(InputBox("请输入年龄："))
Put #1,lastrecord,recordstu '添加记录
Close #1
End Sub
【例8-12】 删除文件中第n个学生记录
Private Type stu
Sno As String * 5
Name As String * 10
Age As Integer
End Type
Private Sub Command1_Click()
Dim recordstu As stu
Dim lastrecord As Integer
Dim i As Integer,n As Integer
Open "tt.txt" For Random As #1 Len = Len(recordstu) '打开文件
Open "temp.txt" For Random As #2 Len = Len(recordstu) '打开临时文件
lastrecord = LOF(1) / Len(recordstu) '求记录数
n = Val(InputBox("请输入要删除的记录号："))
If n > lastrecord Then
MsgBox "要删除的记录不存在"
Else
For i = 1 To lastrecord
Get #1,i,recordstu '从文件读取记录
'如果不是要删除记录，则写到临时文件
If i <> n Then
Put #2,,recordstu '写入临时文件
End If
Next
End If
Close #1
Close #2
Kill "tt.txt" '删除原文件
Name "temp.txt" As "tt.txt" '文件改名
End Sub
【例8-13】 建立如图8.7所示的界面来显示和修改记录。
Private Type stu
Sno As String * 5
Name As String * 10
Age As Integer
　End Type
Dim currecord As Integer '定义变量currecord，用来存储当前记录号
Dim recordnum As Integer '定义变量recordnum，用来存储记录总数
Dim recordstu As stu
Private Sub Form_Load()
'把表示学号、姓名、年龄的三个文本框置空
Text1.Text = ""
Text2.Text = ""
Text3.Text = ""
currecord = 0 '初始时当前记录号为0
End Sub
Private Sub Command1_Click() '"打开文件"按钮的Click事件过程
Open "tt.txt" For Random As #1 Len = Len(recordstu) '打开文件
recordnum = LOF(1) / Len(recordstu) '求记录
总数
End Sub
Private Sub Command2_Click() '"上一条记录"按钮的Click事件过程
'如果当前记录不是第一个记录，读取上一条记录并显示
If currecord > 1 Then
currecord = currecord – 1 '当前记录号减1
Get #1,currecord,recordstu
Text1.Text = recordstu.Sno
Text2.Text = recordstu.Name
Text3.Text = recordstu.Age
Else
MsgBox "这已经是第一个记录"
End If
End Sub
Private Sub Command3_Click() '“下一条记录”按钮的Click事件过程
'如果当前记录不是最后一个记录，读取下一条记录并显示
If currecord < recordnum Then
currecord = currecord + 1 '当前记录号加1
Get #1,currecord,recordstu
Text1.Text = recordstu.Sno
Text2.Text = recordstu.Name
Text3.Text = recordstu.Age
Else
MsgBox "这已经是最后一个记录"
End If
End Sub
Private Sub Command4_Click() '“保存修改”按钮的Click事件过程
recordstu.Sno = Text1.Text
recordstu.Name = Text2.Text
recordstu.Age = Val(Text3.Text)
Put #1,currecord,recordstu '写入当前的记录内容以保存修改
End Sub
Private Sub Command5_Click() '“退出”按钮的Click事件过程
Close #1 '关闭文件
End '结束应用程序
End Sub
【例8-14】 设置一个阅读器，用以显示指定的文本文件，并把阅读器中的文件另存为其他文件，或修改内容后重新存盘。
Private Sub Command1_Click()
CommonDialog1.ShowOpen
fname = CommonDialog1.FileName
If fname <> "" Then
Text1.Text = ""
Open fname For Input As #1
b = ""
Do Until EOF(1)
Line Input #1,nextline
b = b & nextline & Chr(13) & Chr(10)
Loop
Close #1
Text1.Text = b
End If
End Sub
Private Sub Command2_Click()
CommonDialog1.ShowSave
fname = CommonDialog1.FileName
If fname <> "" Then
Open fname For Output As #1
Print #1,Text1.Text
Close #1
End If
End Sub
【例8-15】 将某班学生考试成绩输入到“考试成绩”随机文件中。每个学生的记录包含学号、姓名、高等数学成绩、英语成绩和计算机基础成绩五个字段。
Private Type cj
xh As String * 6
xm As String * 6
sx As Integer
yy As Integer
jsj As Integer
End Type
Private cjd As cj
Private Sub Command1_Click() '显示数据
Dim lastrec As Integer
Dim sx As Single,yy As Single,jsj As Single
Open "考试成绩" For Random As #1 Len = Len(cjd)
lastrec = LOF(1) / Len(cjd)
List1.Clear
For n = 1 To lastrec
Get #1,n,cjd
With cjd
xh = Format(.xh,"@@@@@@")
xm = Format(RTrim(.xm),"@@@@@@")
sx = Format(.sx,"####")
yw = Format(.yy,"####")
wy = Format(.jsj,"####")
msg = xh & xm & " " & sx & " " & yy & " " & jsj
End With
List1.AddItem msg
Next
Close #1
End Sub
Private Sub Command2_Click() '输入数据
For i = 0 To 4
Text1(i).Text = ""
Next
Text1(0).SetFocus
Command3.Enabled = True
End Sub
　Private Sub Command3_Click() '添加记录
Dim lastrec As Integer
For i = 0 To 4
If Text1(i).Text = "" Then
MsgBox "数据不全，输入完整后再添加",,"添加记录"
Exit Sub
End If
Next
With cjd
,xh = Text1(0).Text
,xm = Text1(1).Text
,sx = Val(Text1(2).Text)
,yy = Val(Text1(3).Text)
,jsj = Val(Text1(4).Text)
End With
Open "考试成绩" For Random As #1 Len = Len(cjd)
lastrec = LOF(1) / Len(cjd)
Put #1,lastrec + 1,cjd
Close #1
Call Command1_Click
Command3.Enabled = False
End Sub
Private Sub Command4_Click() '删除记录
Dim lastrec As Integer
recnum = List1.ListIndex + 1
Open "临时数据" For Random As #1 Len = Len(cjd)
Open "考试成绩" For Random As #2 Len = Len(cjd)
lastrec = LOF(2) / Len(cjd)
For n = 1 To lastrec
If n <> recnum Then
Get #2,n,cjd
Put #1,,cjd
Else
Get #2,n,cjd
With cjd
Text1(0).Text =,xh
Text1(1).Text =,xm
Text1(2).Text =,sx
Text1(3).Text =,yy
Text1(4).Text =,jsj End With
End If
Next
Close #1
Close #2
Kill "考试成绩"
Name "临时数据" As "考试成绩"
Call Command1_Click
End Sub
Private Sub List1_Click()
If List1.ListIndex > -1 Then
Command4.Enabled = True
Else
Command4.Enabled = False
End If
End Sub