实训目标与要求：
1）掌握主要控件的属性设置，事件、方法的书写
2）掌握单选按钮、复选按钮、列表框、复选框的主要属性与方法
实训内容：
1、编程实现字体的放大与缩小。（具体效果见源程序实例）
要求：1）需要用到FontSize、ForeColor、Left、Width、ScaleWidth等属性 2）应运用IF判断语句控制最大字体和最小字体
参考代码：
Private Sub Command1_Click()
If Label1.Width < Form1.ScaleWidth Then Label1.FontSize = Label1.FontSize + 2 Else
Print \"已到最大！\"
End If
Label1.Left = (Form1.ScaleWidth - Label1.Width) / 2 End Sub
Private Sub Command2_Click() If Label1.FontSize > 3 Then
Label1.FontSize = Label1.FontSize - 2 Else
Print \"已到最小！\"
End If
Label1.Left = (Form1.ScaleWidth - Label1.Width) / 2 End Sub
Private Sub Command3_Click() End End Sub
2、编写下图所示的四则运算程序，输入第一个数和第二个数之后，单击图中任意一个单选按钮，就能在“计算结果”文本框中输出结果（当第二个数为0，并且选择除法运算时，则在“计算结果”文本框中显示“除数为0，计算无效”）。
提示：此题不止一种解题方法，在学习新控件的同时，请尝试使用控件数组和Select case分支语句来解题。
参考代码：
Private Sub Option1_Click(Index As Integer) Select Case Index Case 0
Text3 = Val(Text1) + Val(Text2) Case 1
Text3 = Text1 - Text2 Case 2
Text3 = Text1 * Text2 Case 3
If Text2 = 0 Then
MsgBox \"除数为零，计算无效！\"
Else
Text3 = Round(Text1 / Text2, 2) '保留两位小数 End If End Select End Sub
3、根据要求，完善程序。创建程序界面如下图所示：
要求：实现向列表框添加、删除以及清除所有项目的功能。
Private Sub Form_Load() List1.AddItem \"北京\" List1.AddItem \"天津\" List1.AddItem \"上海\" List1.AddItem \"重庆\"
End Sub
Private Sub Command1_Click()
Item = InputBox(\"请输入要添加的项目\添加\") ① '代码块一：在列表框中显示添加的项目 End Sub
Private Sub Command2_Click()
Item = InputBox(\"请输入要删除的项目\删除\")
For i =
② '代码块二：判断输入的删除项目是否已经存在于列表框中若存在，则删除 Next i End Sub
Private Sub Command3_Click()
③ '代码块三：清除列表框中的所有项目 End Sub
参考代码：
① List1.AddItem Item
② For i = 0 To List1.ListCount - 1
If List1.List(i) = Item Then List1.RemoveItem (i) Next i
If i = List1.ListCount Then MsgBox \"列表框中没有此项目\" ③ List1.Clear
实训十三 用户界面设计（二）
实训目标与要求：
掌握图片框、图像框、滚动条以及定时器的使用
实训内容：
1、在窗体上画出一个图片框Picture1。程序运行后，单击图片框，则将图片框的背景设置为白色，并在其中以15号黑体显示“在图片框上输出文字示例”。单击窗体，则清除图片框中的文字内容。
参考代码：
Private Sub Form_Click() Picture1.Cls End Sub
Private Sub Picture1_Click()
Picture1.BackColor = vbWhite Picture1.Font = \"黑体\"
Picture1.FontSize = 15
Picture1.Print \"在图片框上输出文字示例\"
End Sub
2、利用滑动条和图片框进行如下实例操作，当拖动滚动条时以拉幕的方式显示图片。
参考代码：
Private Sub Form_Load() Picture1.Width = 0 HScroll1.Value = 0 HScroll1.Min = 0
HScroll1.Max = 7560 End Sub
Private Sub HScroll1_Scroll()
Picture1.Width = HScroll1.Value End Sub
3、利用定时器实现图片的轮流加载以形成动画效果，要求可以用按钮控制开始、停下，用滚动条控制行走速度。
参考代码：
Private Sub Form_Load() HScroll1.Min = 200 HScroll1.Max = 1000 Timer1.Enabled = False Timer1.Interval = 200
Command1.Caption = \"GO\"
Image1.Picture = LoadPicture(App.Path + \"\\2.jpg\") End Sub
Private Sub Command1_Click()
If Command1.Caption = \"GO\" Then Timer1.Enabled = True
Command1.Caption = \"STOP\" Else
Timer1.Enabled = False
Command1.Caption = \"GO\" End If End Sub
Private Sub HScroll1_Scroll()
Timer1.Interval = HScroll1.Value End Sub
Private Sub Timer1_Timer() Static i
If i = 0 Then
Image1.Picture = LoadPicture(App.Path + \"\\1.jpg\") i = 1 Else
Image1.Picture = LoadPicture(App.Path + \"\\2.jpg\") i = 0 End If End Sub
4、编程实现使图片在窗体内来回移动，碰撞边缘后反弹。点击按钮开始，再次点击按钮结束。
注意要点：
1） 如何使一张图片改变其本身大小，然后出现在窗体上？ 2）图片不动时，按钮显示“开始”；图片移动时，按钮显示“停止”。 3）如何判断图片碰到了边框？碰到之后，如何使它反方向运动？
拓展练习：
在实现图片来回移动的基础上，增加一个变速功能。在窗体上添加一个滑动条，滑动时可以改变图片移动的速度。 注意要点：
1）滑动条的Max、Min、Smallchange、Largechange等属性的设置。 2）使用change事件还是scroll事件？
3）改变速度有改变移动步长和Timer频率两种方法？你认为哪一种比较好？
参考代码：
Dim a As Integer
Private Sub Form_Load() Image1.Stretch = True
Image1.Picture = LoadPicture(App.Path + \"/1.jpg\") Timer1.Interval = 50
Timer1.Enabled = False '设定滚动条的取值区间 HScroll1.Min = 10 HScroll1.Max = 100 HScroll1.Value = 50
a = 30 '设定移动速度
End Sub
Private Sub Command1_Click()
If Command1.Caption = \"Start\" Then Timer1.Enabled = True
Command1.Caption = \"Stop\" Else
Timer1.Enabled = True
Command1.Caption = \"Start\" End If End Sub
Private Sub HScroll1_Scroll()
Timer1.Interval = 110 - HScroll1.Value '滚动条用来控制定时器的Interval属性 End Sub
Private Sub Timer1_Timer()
If Image1.Left >= Me.ScaleWidth - Image1.Width Or Image1.Left <= 0 Then '如果图像框飞出了窗体范围则反向 a = -a End If
Image1.Left = Image1.Left + a End Sub
实训十四 文件操作
实训目标与要求：
顺序文件创建和读写的操作方法
实训内容：
编写一个简易的医院信息系统的挂号程序。要求：
（1）单击“挂号”按钮，则将一个病人的ID号、姓名、性别、年龄（Integer）、挂号类别添加到1.txt文件中； （2）单击“下一个”，则清除文本框中现有信息， 便于继续输入。 （3）单击“打单”按钮，则从文件中读取数据显示在右侧的文本框。 （4）单击“清除”，则同时清除右侧文本框里的内容和1.txt中的内容。 界面如下：
输入数据后1.txt文件中的内容： 清除后1.txt文件中的内容：
参考代码：
Private Sub Command1_Click()
Dim a As String, b As String, c As String, d As String, e As String Open \"d:/1.txt\" For Append As #1 a = Text1 b = Text2 c = Combo1 d = Text3 e = Combo2
Write #1, a, b, c, d, e Close #1 End Sub
Private Sub Command2_Click() Text1 = \"\" Text2 = \"\" Text3 = \"\" Combo1 = \"\" Combo2 = \"\" End Sub
Private Sub Command3_Click()
Dim a As String, b As String, c As String, d As String, e As String Open \"d:/1.txt\" For Input As #1 Do While EOF(1) = False Input #1, a, b, c, d, e
Text4 = Text4 & a & \" \" & b & \" \" & c & \" \" & d & \" \" & e & vbCrLf Loop Close #1 End Sub
Private Sub Command4_Click() Text4 = \"\" End Sub
Private Sub Form_Load() Text1 = \"\" Text2 = \"\" Text3 = \"\" Combo1 = \"\" Combo2 = \"\" End Sub
实训十五 图形基本绘制方法（一）
实训目标与要求：
1）掌握绘图中的基本概念，颜色函数的使用
2）掌握Pset绘制点和曲线的方法，Line绘制直线的方法
实训内容：
1、变幻莫测。在窗体上创建一个名为Picture1的图片框，利用定时器Timer1，让图片框的背景颜色不断随机变化（分别尝试用QBColor和RGB函数来实现，对比使用两种函数的效果)
参考代码：
Private Sub Form_Load() Randomize
Timer1.Interval = 100 Timer1.Enabled = True End Sub
Private Sub Timer1_Timer()
'使用QBcolor
'Picture1.BackColor = QBColor(Int(Rnd * 16)) '使用RGB
Picture1.BackColor = RGB(Int(256 * Rnd), Int(256 * Rnd), Int(256 * Rnd)) End Sub
2、颜色渐变。单击窗体，在窗体上产生从左到右，从红色到白色的渐变效果。
参考代码：
Private Sub Form_Click()
For i = 0 To Me.ScaleWidth
c = 255 * i / Me.ScaleWidth
Line (i, Me.ScaleHeight)-(i, 0), RGB(255, c, c) Next i End Sub
3、单击窗体，利用Line方法在窗体上绘出如下图所示的刻度坐标。
要求：主刻度：间隔1000缇、长度200缇；次要刻度：间隔100缇、长度100缇。
参考代码：
Private Sub Form_click()
Dim X As Single, Y As Single X = Me.ScaleWidth Y = Me.ScaleHeight
Line (0, Y / 2)-(X, Y / 2) '绘制基线
For i = 0 To X Step 100
Line (i, Y / 2)-(i, Y / 2 - 100) '绘制次刻度线
If i Mod 1000 = 0 Then Line (i, Y / 2)-(i, Y / 2 - 200) '绘制主刻度线 Next i End Sub 4、利用Timer和Pset实现一个动态画圆的程序，单击窗体后可以在窗体上动态地画出一个圆形图案，画圆结束后显示提示信息。
参考代码：
Dim X As Double, Y As Double, r As Integer Const pi = 3.1415926
Private Sub Form_Load() Timer1.Interval = 10 Timer1.Enabled = False X = Me.ScaleWidth / 2 Y = Me.ScaleHeight / 2 r = 1000 End Sub
Private Sub Form_Click() Timer1.Enabled = True End Sub
Private Sub Timer1_Timer() Static i
PSet (X + r * Sin(i * pi / 180), Y + r * Cos(i * pi / 180)), vbRed i = i + 1
If i = 360 Then
CurrentX = 0: CurrentY = 0 Print \"画圆结束！\" Timer1.Enabled = False End If End Sub
实训十五 图形基本绘制方法（二）
实训目标与要求：
1）掌握Line绘制矩形的方法，Circle绘制圆形的方法
2）掌握鼠标绘图时经常涉及到的事件过程(MouseDown、MouseUp、MouseMove)
实训内容：
1、以鼠标点击处为矩形的中心,在窗体上画出不超过窗体边框的红色实心正方形
参考代码：
Private Sub Form_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
Dim X1 As Single, X2 As Single, Y1 As Single, Y2 As Single Dim Xmin As Single, Ymin As Single, Min As Single
X1 = X: Y1 = Y
X2 = Me.ScaleWidth - X: Y2 = Me.ScaleHeight - Y Xmin = IIf(X1 < X2, X1, X2) Ymin = IIf(Y1 < Y2, Y1, Y2)
Min = IIf(Xmin < Ymin, Xmin, Ymin) '获取中心点距离窗体四周的最小边距 Cls
Me.FillStyle = 0 '填充样式为实心 Me.FillColor = vbRed '填充色为红色
Me.ForeColor = vbRed '前景色，此处即为边框色为红色 Line (X - Min, Y - Min)-(X + Min, Y + Min), , B '以上四句可用下面一句话代替
'Line (X - Min, Y - Min)-(X + Min, Y + Min),vbred, FB End Sub
2、程序调试题
实验目的：提高程序阅读能力，熟悉程序调试题的解题方法；
实验要求：先将本题预先给出的代码复制到VB的运行环境中，再进行调试。此题为2007年秋季等级考试上机考试的真题。
实验内容：程序运行后，从窗体工作区中心点开始，按每秒一次的速度自动画出不断增大的正方形。当正方形超出窗体工作区任一边界时，则清除窗体上所有图形，重新开始上述画图过程。
1 Dim s As Long
2 Private Sub Form_Load()
3 Form1.Caption = \"动态画矩形\"
4 Timer1.Enabled = False 5 Timer1.Interval = 1 6 End Sub
7 Private Sub Timer1_Timer() 8 x = Me.ScaleWidth \\ 2 9 y = Me.ScaleHeight \\ 2 10 r = r + 100
11 Line (x - r, y - r)-(x + r, y + r), , B
12 If r >= Me.ScaleWidth \\ 2 And r >= Me.ScaleHeight \\ 2 Then 13 r = Me.ScaleWidth 14 Clear 15 End If 16 End Sub
参考答案：
代码1改为： Dim r As Long
代码5改为： Timer1.Interval = 1000 代码12： And 改为 Or 代码13改为：r=0 代码14改为：Cls
3、一块小石头掉进平静的水面，会产生一圈圈的涟漪，编写程序，简单模拟这个动态效果。要求：鼠标单击窗体上任意位置，就会产生一个以此位置为圆心，逐渐向外扩大的彩色圆圈。
参考答案：
Dim r As Integer, X1 As Single, Y1 As Single
Private Sub Form_MouseDown(Button As Integer, Shift As Integer, x As Single, y As Single) Cls X1 = x Y1 = y r = 0
Timer1.Interval = 100 Timer1.Enabled = True End Sub
Private Sub Timer1_Timer() r = r + 100
Circle (X1, Y1), r, QBColor(Int(Rnd * 16)) End Sub
4、绘制两点之间的圆，鼠标按下为起点, 鼠标放开为终点。
参考答案：
Dim X1 As Single, Y1 As Single
Private Sub Form_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single) Cls
'记录起点 X1 = X
Y1 = Y End Sub
Private Sub Form_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
'显示鼠标路径
If Button = 1 Then '如果鼠标按下 Cls
Line (X1, Y1)-(X, Y) End If End Sub
Private Sub Form_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single) Cls '画圆
r = Sqr((X - X1) ^ 2 + (Y - Y1) ^ 2) '计算直径 Circle ((X + X1) / 2, (Y + Y1) / 2), r / 2 End Sub
实训十五 图形基本绘制方法（三）
实训目标与要求：
绘图方法与程序结构、定时器的综合应用
实训内容：
1、单击窗体上任意一点，一次性在窗体上画不超出窗体边框的20个圆，圆的颜色随机。如下图所示。
参考答案：
Private Sub Form_Click() Cls
For i = 1 To 20 '产生随机圆心点
X = Rnd * Me.ScaleWidth Y = Rnd * Me.ScaleHeight '计算半径的最大值
X1 = Me.ScaleWidth - X Y1 = Me.ScaleHeight - Y Xmin = IIf(X < X1, X, X1) Ymin = IIf(Y < Y1, Y, Y1)
Rmin = IIf(Xmin < Ymin, Xmin, Ymin) '产生随机半径 r = Rnd * Rmin '画圆
Circle (X, Y), r, QBColor(Int(Rnd * 16)) Next i End Sub
2、在窗体上按下鼠标左键并拖动时，能在窗体上画出与鼠标移动轨迹保持一致的一连串不重叠的小圆形（半径R=100）
参考答案：
Dim X1 As Single, Y1 As Single, r As Integer
Private Sub Form_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single) Cls
X1 = X Y1 = Y r = 100
Circle (X, Y), r '画第一个圆
End Sub
Private Sub Form_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
L = Sqr((X - X1) ^ 2 + (Y1 - Y) ^ 2) '求当前鼠标位置与上一个圆心点间的距离 If Button = 1 And L > 2 * r Then '当鼠标左键按下时，且距离满足不重叠的要求 Circle (X, Y), r '画圆，且记录下当前圆心点
X1 = X Y1 = Y End If End Sub
3、观察“动态画正弦曲线”程序运行的效果，并按照此程序的功能，予以实现。此题目要求正弦曲线和文字显示必须在图片框中输出。
参考答案：
Dim i As Integer
Private Sub Form_Load() Timer1.Interval = 10 Timer1.Enabled = False End Sub
Private Sub Picture1_Click() Picture1.Cls i = 0
Timer1.Enabled = True End Sub
Private Sub Timer1_Timer()
d = 3.14159 / 900 '设置曲线弧度
If i < Picture1.ScaleWidth Then x = i
y = (1 - Sin(i * d)) * Picture1.ScaleHeight / 2
Picture1.PSet (x, Picture1.ScaleHeight / 2) '绘制基准线 Picture1.PSet (x, y) '绘制曲线
i = i + 10 Else
Picture1.CurrentX = 0
Picture1.CurrentY = Picture1.ScaleHeight - 200 '设置文字输出点 Timer1.Enabled = False
Picture1.Print \"动态画曲线结束\" End If End Sub
因篇幅问题不能全部显示，请点此查看更多更全内容