代码:
Private Sub Command1_Click()
n = 4
'm = 1
For i = 1 To n
m = m * i
Next i
Print "m="; m
End Sub
选【调试】‖【添加监视】进入后，在【表达式】中写入ｍ，然后点击【确定】。这时屏幕下方出现了含有ｍ的监视窗口。再重复以上过程，把n也加入到监视窗口。
按F8键进行单步调试（即每按一下F8运行一行），逐步检查监视窗口的变量变化。点击【Command1】后，再按F8继续运行。如果屏幕下部先出现【立即】窗口，则把它关掉，再从菜单上选取【窗口】‖【监视窗口】把监视窗口调出来。
用InputBox输入数值时的错误处理
发生错误时继续调用InputBox，直到正确。
Private Sub Command1_Click()
Dim s11 As Integer
Dim s2 As String
On Error GoTo head
head1:
s2 = InputBox("请输入单价:")
If s2 <> "" Then
s11 = s2
End If
Exit Sub
head:
MsgBox "输入错！请重新输入"
Resume head1
End Sub
用Resume Next处理错误
发生错误时退出Command1.
Private Sub Command1_Click()
Dim s11 as Integer
Dim s2 As String
On Error GoTo head
s2 = InputBox("请输入单价:")
If s2 <> "" Then
s11 = s2
End If
Exit Sub
head:
MsgBox "输入错！请重新输入"
Resume Next
End Sub
用Text控件输入数值时的错误处理
Private Sub Command1_Click()
Dim i1 As Integer
On Error GoTo handle
i1 = Text1
MsgBox "输入正确,i1=" & i1
Exit Sub
handle:
MsgBox "输入错误!"
Text1 = ""
Exit Sub
End Sub
Private Sub Form_Load()
Text1 = ""
End Sub
用输入窗体时的错误处理
放置控件: Form1:Command1, Form2:Command1,Text1,Module1
Module1代码:
Public i1 As Integer
Form1代码:
Private Sub Command1_Click()
Form2.Show vbModal
MsgBox "输入完成,i1=" & i1
End Sub
Form2代码:
Private Sub Command1_Click()
On Error GoTo handle
i1 = Text1
MsgBox "输入正确,i1=" & i1
Unload Me
Exit Sub
handle:
MsgBox "输入错误!"
Text1 = ""
Exit Sub
End Sub
Private Sub Form_Load()
Text1 = ""
End Sub
显示错误信息
On Error Resume Next ' 改变错误处理的方式。
Err.Clear
Err.Raise 6 ' 生成一个溢出（Overflow）的错误。
' 检查错误代号，显示相关错误信息。
If Err.Number <> 0 Then
Msg = "Error # " & Str(Err.Number) & " was generated by " _
& Err.Source & Chr(13) & Err.Description
MsgBox Msg, , "Error", Err.Helpfile, Err.HelpContext
End If
五 打印
用Currentx、y指定Print位置
放置控件: Form1:Command1,command2,text1
代码:
Dim g1, g2 As Integer
Private Sub Command1_Click()
g1 = g1 + 200
Cwrite
End Sub
Private Sub Command2_Click()
g2 = g2 + 200
Cwrite
End Sub
Sub Cwrite()
Cls '清除上次字符串
CurrentX = g1
CurrentY = g2
Print "Position test."
End Sub
用Printer方法编程打印
1．设页面坐标
pw = 400: ph = 650
Printer.Scale (0, 0)-(pw, ph)
注：以上设置只能设页面坐标，不能设置页面大小。要设置页面大小到Windows/打印机/属性/中去设置。对于标准连续打印纸，设Letter。
2．设字体
Printer.FontName = “黑体”
Printer.FontSize = 10 '5号字
Printer.FontBold = True '粗体
3．打印位置
Printer.CurrentX = 110
Printer.CurrentY = 30
4．打印数据
Printer.Print "中国水利水电出版社入库单"
Printer.Print "单号: " & tnum
5．画表格线
Printer.DrawWidth = 3 '线宽
Printer.Line (20,20) – (300,300)
6．打印份数
Printer.Copies = 2
7．换页
Printer.NewPage
8．打印开始
Printer.EndDoc
注意:只要使用Printer方法，不管是否用Printer.EndDoc，程序运行完时均要打印。
改变页面位置
如用 Printer.Scale (0, 0)-(pw, ph)
增大左边界 Printer.Scale (-50, 0)-(pw, ph)
整体左移 Printer.Scale (-50, 0)-(pw-50, ph)
增大上边界 Printer.Scale (0, -50)-(pw, ph)
增大下边界 Printer.Scale (0, 0)-(pw, ph+50)
整体下移 Printer.Scale (0, -50)-(pw, ph-50)
直接用printer打印表格
Private Sub cmdprint_Click()
Dim n As Integer
Dim rs As New ADODB.Recordset
rs.Open "SELECT * FROM jggz", "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=D:\jggz\jggz.mdb;Persist Security Info=False", adOpenStatic, adLockPessimistic
n = 0
rs.MoveFirst
Form1.Print "┌────┬────┐"
While Not rs.EOF
Printer.Print "│" & rs.Fields("姓名").Value; Tab(11); "│"; rs.Fields("课时工资"); Tab(21); "│"
rs.MoveNext
n = n + 1
If n / 5 = Int(n / 5) Or rs.EOF Then
Printer.Print "└────┴────┘"
Printer.Print "┌────┬────┐"
Else
Printer.Print "├────┼────┤"
End If
Wend
Printer.Print "└────┴────┘"
rs.Close
End Sub
附件1：制表符号区位对照
区位
0904
0906
0916
0920
0924
0940
0948
符号
─
│
┌
┐
└
┤
┬
区位
0956
0964
0905
0907
0919
0931
0939
符号
┴
┼
━
┃
┏
┛
┣
区位
0947
0955
0963
0979
0936
0959
符号
┫
┳
┻
╋
┠
┷
六 绘图
使用Pset画点
放置控件: Form1:Command1
属性设置: 〖Command1.Caption〗=开始
代码:
Private Sub Command1_Click()
Const pi = 3.14159
Dim x0, y0 As Single
Dim x1, y1 As Integer
x0 = 0
Do While x0 <= 4 * pi '画两个相位
y0 = Sin(x0)
x1 = x0 * 400 '放大400倍
y1 = y0 * 400 + 1000
PSet (x1, y1) '画点
x0 = x0 + 0.01 '步长为0.01
Loop
End Sub
使用Line画线
放置控件: Form1:Command1
属性设置: 〖Command1.Caption〗=开始画图
代码:
Private Sub Command1_Click()
Line (100, 100)-(1000, 1000)
Line -(0, 500) '第一点缺省采用当前点，即（1000，1000）
Line -(100, 100) '完成一个三角形
End Sub
使用Line擦除线段
放置控件: Form1:Command1,Command2
属性设置: 〖Command1.Caption〗=画线,〖Command2.Caption〗=擦除
代码:
Private Sub Command1_Click()
DrawMode = 1
Line (0, 0)-(1000, 1000)
End Sub
Private Sub Command2_Click()
DrawMode = 7
Line (0, 0)-(1000, 1000), BackColor
End Sub
使用Circle画弧
放置控件: Form1:Command1
属性设置: 〖Command1.Caption〗=开始画图
代码:
Private Sub Command1_Click()
Const Pi = 3.1416
Circle (1000, 1000), 500, , 0, Pi '画一个从0度到π(180)度的弧
End Sub
用鼠标画园饼并擦除
放置控件: Form1
代码:
Private Sub Form_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
Static x0, y0 As Integer '保存上一个鼠标位置的参数
FillStyle = 0 '设置填充模式
Circle (x0, y0), 200, BackColor '擦除上一个园饼
Refresh '重画
DrawMode = 1 '绘图方式还原
Circle (X, Y), 200
x0 = X '保存当前鼠标位置
y0 = Y
DrawMode = 7 '使用XOR绘图方式准备擦图
End Sub
如果要在已有背景上擦除，用以下程序：
Private Sub Command1_Click()
DrawMode = 1
Line (0, 0)-(1000, 1000)
End Sub
Private Sub Form_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
Static x0, y0 As Integer '保存上一个鼠标位置的参数
FillStyle = 0 '设置填充模式
DrawMode = 7 '使用XOR绘图方式准备擦图
Circle (x0, y0), 200, BackColor '擦除上一个园饼
Refresh '重画
Command1_Click
DrawMode = 1 '绘图方式还原
Circle (X, Y), 200
x0 = X '保存当前鼠标位置
y0 = Y
End Sub
用PictureBox做简单的动画
放置控件: Form1:Picture1,Picture2,Picture3,Command1,timer1
属性设置: 〖Picture1.Autosize〗=true,〖Picture1.Picture〗=bfly1.bmp
〖Picture2.Autosize〗=true,〖Picture2.Picture〗=bfly2.bmp
〖Picture3.Autosize〗=true
〖Command1.Caption〗=开始
〖timer1.Interval〗=10
注意:bmp文件从c:\program files\microsoft visual\msdn98\98vs\vcr\选取
代码:
Option Explicit
Sub delay(ss As Integer) '延时程序,ss单位为毫秒(ms)
Dim start, check
start = Timer
Do
check = Timer
Loop While check < start + ss * 0.001
End Sub
Private Sub Command1_Click()
Dim i As Integer
For i = 1 To 10 '蝴蝶扇动10下翅膀
Picture3.Picture = Picture1.Picture '显示图1
delay (100) '延时100毫秒
Picture3.Picture = Picture2.Picture '显示图2
delay (100)
Next i
End Sub
用PictureBox做动画(用DoEvents中断)
放置控件: Form1:P1,P2,P3(PictureBox),Command1,Command2,timer1
属性设置: 〖P1.Autosize〗=true,〖P1.Picture〗=bfly1.bmp
〖P2.Autosize〗=true,〖P2.Picture〗=bfly2.bmp
〖P3.Autosize〗=true
〖Command1.Caption〗=开始
〖Command2.Caption〗=退出,〖Command2.Visible〗=False
〖timer1.Interval〗=10
〖Form1.BackColor〗=白 '从调色板上选取
注意:bmp文件从c:\program files\microsoft visual\msdn98\98vs\vcr\选取
代码:
Option Explicit
Sub delay(ss As Integer)
Dim start, check
start = Timer
Do
check = Timer
Loop While check < start + ss * 0.001
End Sub
Sub flying() '飞翔过程
Const d1 = 30
P3.Picture = P1.Picture
delay (d1)
P3.Picture = P2.Picture
delay (d1)
End Sub
Private Sub Command1_Click()
Dim mx0, my0 As Integer '随机产生的x,y方向的步长
Dim mx, my As Integer '转换方向后的步长
Dim k As Integer '步长系数
Dim bl As Integer '中断检测计数
k = 400
mx0 = k * Rnd: my0 = k * Rnd '赋初始值
mx = mx0: my = my0
Do
Command1.Visible = False
If P3.Left < 0 Then '如果碰到左边界
mx0 = k * Rnd: my0 = k * Rnd '向右飞
mx = mx0: my = 2 * (my0 - k / 2)
End If
If P3.Left > Form1.Width - P3.Width Then '如果碰到右边界
mx0 = k * Rnd: my0 = k * Rnd '向左飞
mx = -mx0: my = 2 * (my0 - k / 2)
End If
If P3.Top < 0 Then '如果碰到上边界
mx0 = k * Rnd: my0 = k * Rnd '向下飞
mx = 2 * (mx0 - k / 2): my = my0
End If
If P3.Top > Form1.Height - P3.Height Then '如果碰到下边界
mx0 = k * Rnd: my0 = k * Rnd '向上飞
mx = 2 * (mx0 - k / 2): my = -my0
End If
P3.Picture = LoadPicture '清除上一幅图
P3.Move P3.Left + mx, P3.Top + my '按设定的步长移动
flying '调用飞翔过程
Form1.Refresh '重画
bl = bl + 1 '中断程序
If bl > 100 Then '设飞动100次中断1次
Command2.Visible = True '显示"退出"按钮
Refresh
delay (3000) '停3秒等待用户点击"退出"按钮
DoEvents '中断处理
Command2.Visible = False '如用户没有选退出,再将按钮隐藏
bl = 0 '重新计数
End If
Loop Until 1 = 2 '无限循环
End Sub
Private Sub Command2_Click()
End
End Sub
用Image做复杂一点的动画
放置控件: Form1:P1,P2,P3(Image),Command1,timer1
属性设置: 〖P1.Stretch〗=true,〖P1.Picture〗=bfly1.bmp
〖P2.Stretch〗=true,〖P2.Picture〗=bfly2.bmp
〖P3.Stretch〗=true
〖timer1.Interval〗=10
〖Form1.BackColor〗=白 '从调色板上选取
注意:bmp文件从c:\program files\microsoft visual\msdn98\98vs\vcr\选取
代码:
Option Explicit '强制变量说明
Dim mx0, my0 As Integer '随机产生的x,y方向的步长
Dim mx, my As Integer '转换方向后的步长
Dim k As Integer '步长系数
Dim doflag As Boolean '检测Command1的Click的标记
Sub delay(ss As Integer) '延时过程
Dim start, check
start = Timer
Do
check = Timer
Loop While check < start + ss * 0.001
End Sub
Sub flying() '飞翔过程
Const d1 = 40
p3.Picture = LoadPicture '清除上一幅图
p3.Move p3.Left + mx, p3.Top + my '按设定的步长移动
p3.Picture = p1.Picture '显示第一幅图
Refresh
delay (d1 * 3)
p3.Picture = p2.Picture '显示第二幅图
Refresh
delay (d1)
End Sub
Sub fly_direction()
If p3.Left < 0 Then '如果碰到左边界
mx0 = k * Rnd: my0 = k * Rnd '向右随机方向飞
mx = mx0: my = 2 * (my0 - k / 2)
End If
If p3.Left > Form1.Width - p3.Width Then '如果碰到右边界
mx0 = k * Rnd: my0 = k * Rnd '向左随机方向飞
mx = -mx0: my = 2 * (my0 - k / 2)
End If
If p3.Top < 0 Then '如果碰到上边界
mx0 = k * Rnd: my0 = k * Rnd '向下随机方向飞
mx = 2 * (mx0 - k / 2): my = my0
End If
If p3.Top > Form1.Height - p3.Height Then '如果碰到下边界
mx0 = k * Rnd: my0 = k * Rnd '向上随机方向飞
mx = 2 * (mx0 - k / 2): my = -my0
End If
flying '调用飞翔过程
End Sub
Private Sub Command1_Click()
Select Case doflag
Case True
Command1.Caption = "开始"
doflag = False
Cls
Case False
Command1.Caption = "停止"
doflag = True
mx0 = k * Rnd: my0 = k * Rnd '赋初始值
mx = mx0: my = my0
End Select
End Sub
