VB程序设计实验教程与习题选解(中国铁道出版社)

第一章 VB开发环境与VB概述 习题答案
习题
一、选择题
1. 2. 3. 4. 5. 6. 7. 8. 9. 10. 11. 12. 13. 14.
B A A B D B A A C B C D A D


第二章 常用控件与界面设计 习题答案
习题
一、选择题
1. 2. 3. 4. 5. 6. 7. 8. 9. 10. 11. 12. 13. 14. 15.
C B C A A B B B C C B B D A B
16. 17. 18. 19. 20. 21. 22. 23. 24. 25. 26. 27. 28. 29. 30.
B B C C D B B B C C C A B B C
31. 32. 33. 34. 35. 36. 37. 38. 39. 40. 41. 42. 43. 44. 45.
B C B B D B D D B A B A B B D
46. 47. 48. 49. 50. 51. 52. 53. 54. 55. 56. 57. 58. 59. 60.
A A B D C D D C D D C A C C B
61.
B
第三章实验与习题
实验
实验3_1
‘算术运算
Private Sub Command1_Click()
Const a As Single = 3, b As Single = 2, c As Single = -1, d As Single = 6
Dim x As Single, y As Single, z As Single, m As Single
x = 2: y = 1: z = 1: m = 1
List1.Clear
List1.AddItem a / (b + c / b)
List1.AddItem (x + Sqr(x ^ 2 + 1)) ^ (1 / 3)
List1.AddItem ((2 * y) / (a * x + b * y) * (a * x - b * y))
List1.AddItem 1 + 1 / (1 + 1 / m)
List1.AddItem 1 / 2 * (d / 3) ^ (2 * x)
List1.AddItem Log(y + Cos(x) ^ 2)
List1.AddItem Abs((Exp(x) + Sin(x) ^ 3) / (x + y))
List1.AddItem Log((Exp(x * y) + Abs(1 / Tan(z) + Cos(x) ^ 3)) / (x + y - z))
List1.AddItem Sin(45 * 3.1415 / 180) + (Exp(10) + Log(10)) / Sqr(x + y + 1)
List1.AddItem Log(a) / Log(b)
End Sub
‘关系运算
Private Sub Command2_Click()
List1.Clear
List1.AddItem Mid("Visual Basic", 1, 12) = Right("Language Visual Basic", 12)
List1.AddItem "ABCRG" >= "abcde"
List1.AddItem Int(134.69) >= CInt(134.9)
List1.AddItem 78.9 / 32.77 <= 97.5 / 43.87 And -45.4 > -4.98
List1.AddItem Str(32.345) = CStr(32.345)
End Sub
‘逻辑运算
Private Sub Command3_Click()
Dim x As Integer, y As Integer
Dim C1 As Integer, C2 As Integer, C3 As Integer
C1 = 70: C2 = 80: C3 = 90
x = 9: y = -2
List1.Clear
List1.AddItem x + y < 10 And x - y > 0
List1.AddItem (x% >= 0 And y% >= 0) Or (x% < 0 And y% < 0)
List1.AddItem x = 0 Xor y = 0
List1.AddItem C1 + C2 + C3 >= 255 Or C1 > 90 And C2 > 90 And C3 > 80
End Sub
实验3_2
略
实验3_3
略
实验3_4
‘零售结算
Private Sub Command1_Click()
Dim dj As Single, sl As Single, je As Single, n As Integer
Label1.Caption = "金额："
dj = InputBox("请输入商品的单价：", "单价框")
sl = InputBox("请输入商品的数量：", "数量框", 1)
je = dj * sl
n = MsgBox("共计金额=" & je, vbOKCancel + vbInformation, "结果")
If n = vbOK Then Label1.Caption = "金额：" & Str(je) & "元"
End Sub
‘产生随机数
Private Sub Command2_Click()
Dim m As Integer, n As Integer
Dim x1 As Integer, x2

As Integer, x3 As Integer
m = Val(Text1.Text): n = Text2.Text
Randomize
x1 = Int(Rnd * (n - m + 1) + m)
x2 = Int(Rnd * (n - m + 1) + m)
x3 = Int(Rnd * (n - m + 1) + m)
Label4.Caption = "结果为：" & Str(x1) & Str(x2) & Str(x3)
End Sub
‘求逆序数
Private Sub Command3_Click()
Dim a As Integer, h As Integer, t As Integer, n As Integer
Randomize
a = Int(Rnd * (999 - 100 + 1) + 100)
h = Mid(CStr(a), 1, 1)
t = Mid(CStr(a), 2, 1)
n = Right(CStr(a), 1)
Label5.Caption = a & "-->" & Format(n * 100 + t * 10 + h, "000")
End Sub
实验3_5
略
习题
选择题
1-20: DBBDB DDBCA DDDCD DBADB
21-40: DCDAA B_ACA BCADA B_BCD
41-60: BCBDC CADBA CBDDD ABAAA
61-80:BBCAB BDAAA CBBDD CBDAD
81-89:CBDBB BADC

填空题
1、2 -32768~32767
2、整型 长整型 单精度 双精度
3、0 False “”
4、Chr(Int(Rnd*(Asc(“L”)-Asc(“C”))+Asc(“C”)))
x>0 And y>0 Or x<0 And y<0
c>=”a” And c<=”z” Or c>=”A” And c<=”Z”
x>=10 And x<20
x5、False
2
True
False
True
True
True
True
6、188
200100
68.56
876554
7、a=1 b=1
a=2 b=1
a=3 b=1
a=4 b=1
8、Y Mod 4=0 And Y Mod 100<>0 Or Y Mod 400 =0
9、He Said, “Good morning”.
10、EDEF
11、(A>0 And A<>Int(A)) And (B<0 And B<>Int(B))
12、a+b+c+d
(a+b+c+d)/4
sum
aver

13、(f-2*h)/2
(4*h-f)/2

简答题
1、略
2、Private Sub Form_Click()
Const g = 9.8
Dim V0 As Single, t As Single
Dim S As Single
V0 = InputBox("请输入V0的值：")
t = InputBox("请输入时间t的值：")
S = (1 / 2) * g * t ^ 2 + V0 * t
MsgBox ("位移量为：" & S)
End Sub
3、Private Sub Command1_Click()
Dim l As Single, w As Single, h As Single
Dim s As Single
l = Text1.Text
w = Text2.Text
h = Text3.Text
s = (l * w + l * h + w * h) * 2
Label1.Caption = s
End Sub


第四章选择分支与循环
实验答案
实验4-1
方法一： x<=5 ; y
方法二：Is<=2 ;Case Else

实验4-2
Shape1.BackColor=vbRed;
Inter=15;
Inter=Inter-1;
Inter;

实验4-3
bb=a
a=k

实验4-4
方法二： s*n ; t/s<10^-5

实验4-5
方法一:m>=10^-4 ; (-1)^(n+1)*m

实验4-6
x2=x3 ; <10^-6

实验4-7

实验4-8
i+2*j+5*k=10 ; n

实验4-9
题目一：a) 5
b)i=16 p=12 n=5
c)i=9 p=8 n=1
题目二：120 10

实验4-10
N=1 ； S=N& "*3 " & "+1 "

实验4-11
Len(st); Ch=Lcase(ch) ; Case Else ; Mid(Char,I,1)&St

实验4-12
i\100 ; (i Mod 100)\10

习题
一、 选择题
1．C 2. C 3.A 4. D 5.A 6. B 7. B 8. D 9. B
二、填空题
1． Is=0 ; 1 To 10 ; Is >10
2. 9
3. 3 ; 4 15
4. this is a book ;This Is A Book
5. 3 ; 3 ; 3 5
6. 32 0
7. 4
8. 15 1
9. 1 ; 401 ;104
10. 1 2 3 ;1 3; 1
11. (3)
12. 2 0 24
13. 10 14
14. BAABC

CBAABC
15. X Mod P=0 ; X=X+1 ;Find=False
16. abs(t)<10^(-7) ; s+t
17. Mid(n,1,1)=Mid(n,2,1) And Mid(n,3,1)=Mid(n,4,1)
S=S+1
18. Mid(n,i,1)>Mid(n,i+1,1)
19. "输入n";N/I=0 ;Print I
第五章数组
实验
5_1
Int(90 * Rnd) + 10
a(i) = a(21 - i)
a(21 - i) = t
5_2
k = x Mod 10
i = i + 1
5_3
s
5_4
max < a(i, j)
row = I
col = j
5_5
1
ReDim Preserve prime(m)
prime(j)
5_6
d Mod 2
5_7
Exit For
a(j + 1) = a(j)
5_8
N – I
A(j) = A(j + 1)
5_9
A(i, 1)
J
Min = Max
Not Flag
5_10
ch >= "0" And ch <= "9"
P = P & ch
ReDim Preserve C(k)
5_11
Private Sub Form_Click()
Dim x As Integer, i As Integer, k As Integer, j As Integer
Dim a() As Integer
x = InputBox("输入正整数x=")
i = 2
Print x; "的质因子为:";
Do While x >= i
If x Mod i = 0 Then
k = k + 1
ReDim Preserve a(k)
a(k) = i
x = x \ i
Else
i = i + 1
End If
Loop
For j = 1 To UBound(a)
Print a(j);
Next j
End Sub

习题
一 选择题
1. A
2. C
3. D
4. C
5. B
6. D
7. D
8. B
9. D
10. B
11. B
12. D
二 填空题
1. Variant
2. ReDim A(N)
A(1)
If M < A(I) Then M = A(I)
3. Int(26 * Rnd) + 65
Chr(t)
i + 1 To 10
A(i) > A(j)
4. InStr(s, ",")
Right(s, Len(s) - n)
s
5. 4 5 6
6 5 4
3 2 1
6. T – 1
I + 1
7. k = 6 - i – j
max = m
8. j = a
j = j - 3
9. i + 1
i = i + 1
10. 2
3
7
三 编程题
1．
Option Explicit
Option Base 1
Private Sub Command1_Click()
Dim a(10) As Integer
Dim i As Integer, max As Integer
For i = 1 To 10
a(i) = Int(90 * Rnd) + 10
Print a(i);
Next i
Print
i = 1
max = 0
Do While i <= 10
If a(i) Mod 3 = 0 Then
If a(i) > max Then
max = a(i)
End If
End If
i = i + 1
Loop
If max = 0 Then
Print "无要找的数"
Else
Print max & "是最大的能被3整除的数"
End If
End Sub
2．
Option Explicit
Option Base 1
Private Sub Command1_Click()
Dim A() As Integer
Dim I As Integer, m As Integer
Dim K As Integer
ReDim A(10)
For I = 1 To 10
A(I) = I
Print A(I);
Next I
Print
m = InputBox("ê?è?m")
K = 9 + m
ReDim Preserve A(K)
For I = 11 To K
A(I) = A(I - 10)
Next I
For I = 1 To 10
A(I) = A(I + m - 1)
Next I
For I = 1 To 10
Print A(I);
Next I
Print
End Sub
3．
Option Explicit

Private Sub Command1_Click()
Dim I As Integer, J As Integer, K As Integer
Dim a() As Integer, n As Integer, p As Integer
Dim s As String, Flag As Boolean
p = 1
For K = 10 To 100

I = 1
Do While I <= 10 And Not Flag
J = 1
Do While J <= 10 And Not Flag
n = I ^ 2 + J ^ 2
If n = K Then

Flag = True
ReDim Preserve a(p)
a(p) = K
p = p + 1
s = I & Str(J) & Str(K)
List1.AddItem s
End If
J = J + 1
Loop
I = I + 1
Loop
Flag = False
Next K
End Sub
4．
Option Explicit

Private Sub Command1_Click()
Dim A(10) As Integer
Dim B(10) As Integer, S As String
Dim I As Integer, J As Integer, X As Integer
A(1) = Int(90 * Rnd) + 10
S = A(1)
For I = 2 To 10
Do
X = Int(90 * Rnd) + 10
For J = 1 To I - 1
If X = A(J) Then Exit For
Next J
If J = I Then
A(I) = X
S = S & " " & A(I)
Exit Do
End If
Loop
Next I
Text1.Text = S
B(1) = Int(90 * Rnd) + 10
S = B(1)
For I = 2 To 10
Do
X = Int(90 * Rnd) + 10
For J = 1 To I - 1
If X = B(J) Then Exit For
Next J
If J = I Then
B(I) = X
S = S & " " & B(I)
Exit Do
End If
Loop
Next I
Text2.Text = S
S = ""
For I = 1 To 10
For J = 1 To 10
If A(I) = B(J) Then
S = S & " " & A(I)
End If
Next J
Next I
Text3.Text = S
End Sub

Private Sub Command2_Click()
Text1.Text = ""
Text2.Text = ""
Text3.Text = ""
Text1.SetFocus
End Sub
5．
Option Explicit

Private Sub Command1_Click()
Dim I As Integer, J As Integer
Dim a() As Integer, K As Integer, Sum As Integer
K = Val(Text1.Text)
I = 1
Do
J = K Mod 10
ReDim Preserve a(I)
a(I) = J
Sum = Sum + J
K = K \ 10
I = I + 1
Loop Until K = 0
Text2.Text = Sum
End Sub
6．
Option Explicit

Private Sub Command1_Click()
Dim a(100, 2) As Integer, K As Integer
Dim I As Integer, J As Integer
Dim M As Integer, N As Integer
K = 1
For I = 1 To 99
For J = 1 To 99
If I > J Then
M = I - J
N = I + J
If Sqr(M) = Int(Sqr(M)) And Sqr(N) = Int(Sqr(N)) Then
List1.AddItem I & " " & J
a(K, 1) = I
a(K, 2) = J
K = K + 1
End If
End If
Next J
Next I
End Sub
第六章 参考答案
实验
实验6-1
1、 Exit Do
2、 Y(X)
3、 X >= -1

实验6-2
【题目二】42 、26、8

实验6-3
1、 s1, key
2、 s As String
3、 ch >= "a" And ch <= "z"
4、 Mid(s, i, 1) = Chr(Asc(ch) + k - 26)
思考：解密函数
Private Sub dec(s As String, k As Integer) '解密过程
Dim i As Integer, ch As String * 1
For i = 1 To Len(s)
ch = Mid(s, i, 1)
If "A" <= ch And

ch <= "Z" Then
If Asc(ch) - k < Asc("A") Then
Mid(s, i, 1) = Chr(Asc(ch) - k + 26) '小于A的ASCII值则加上26
Else
Mid(s, i, 1) = Chr(Asc(ch) - k)
End If
ElseIf ch >= "a" And ch <= "z" Then '多分支格式，ch介于小写a与z之间
If Asc(ch) - k < Asc("a") Then
Mid(s, i, 1) = Chr(Asc(ch) - k + 26) '小于a的ASCII值则加上26
Else
Mid(s, i, 1) = Chr(Asc(ch) - k)
End If
End If
Next i
End Sub
实验6-4
1、 b() As Integer, st As String
2、 L <= R
3、 ReDim Preserve b(R)
4、 L = L + 1
辗转相除法求最大公约数函数
Private Function Gcd(ByVal p As Integer, ByVal q As Integer) As Integer
Dim r As Integer
r = p Mod q
Do While r <> 0
p = q
q = r
r = p Mod q
Loop
Gcd = q
End Function

实验 6-5
【题目一】
age = age(n - 1) - 3
【题目二】
1、(Left + Right) / 2
2、Left = Mid + 1

实验6-6
1、3 -1
2、7 4
3、3 -1
4、7 0

实验6-7
【题目一】
1、 Sqr(2 + t)
2、 Abs(a - 1) < eps
【题目二】
1、 Dim X As Integer
2、 "S(" & I & ")=" & S(I)
3、 (j * i + 1)


习题参考答案

一 选择题
1~5： BDCCD 6~10：BBBAD 11~15：DAAAB
16~20：BDCDB 21~25：CCBAD 26~28：DAB
二、填空
1（1） 形式 、（2） 实在
2（1） 按地址传递 、（2） ByVal
3（1） 窗体模块 、（2） 标准模块 、（3） 类模块
4（1） 6
5（1）4 20 101
6（1） 6 26 、（2） -2 98
7（1） 10 6 、（2） 5 -5
8（1） 6 5 、（2） 8 7
9（1） 11 、（2） 7
10（1） Fun(i) 、（2） Fun=p
11（1） 4 、（2） 20.7
12（1） 29 、（2） 28.7
13（1） k = j 、（2） b() As Integer
14（1） gec 、（2） ge 、（3） 3
15（1） p1 = True And p2 = True 或 p1 And p2 、（2） p1 = p2 – 2 、
（3） Isp = True 、（4） m Mod i = 0
16（1） Convert(st) 、（2） Len(s) 、
（3） "A" To "F" 、（4） k = k + p * h
17（1） isualVi 、（2） sualVisu
18（1） s + a 、（2） n + 1 、
（3） x As Single, n As Integer 、（4） p * (x + i) / ((2 * i - 1) * i * x)

三、改错题
1、
Option Base 1
Private Sub Command1_Click()
Dim A() As Integer, I As Integer, J As Integer, Logic As Boolean
Dim K As Integer
ReDim A(1)
A(1) = 50

———————— 'K=1
For I = 51 To 149
K = 1 '位置错
Logic = False
Call Sub1(A, I, Logic)
If Logic Then

K = K + 1
ReDim A(K) 'ReDim Preserve A(K)
A(K) = I
End If
Next I
For I = 1 To UBound(A)
Text1 = Text1 & Str$(A(I))
If I Mod 5 = 0 Then Text1 = Text1 & vbCrLf
Next I
End Sub
Private Sub Sub1(A() As Integer, N As Integer, F As Boolean)
Dim I As Integer, J As Integer, Ub As Integer
Ub = UBound(A)
For I = 1 To Ub
For J = 2 To A(I)
If A(I) Mod J = 0 And N Mod J = 0 Then
Exit For 'Exit Sub
End If
Next J
F = True
Next I
End Sub

2、
Option Explicit
Option Base 1

Private Sub Command1_Click()
Dim I As Integer, Flg As Boolean, S1 As Integer, S2 As Integer
Dim J As Integer, K As Integer, P() As Integer
ReDim P(1)
P(1) = 2
For I = 3 To 150 Step 2
For J = 2 To Sqr(I)
If I Mod J = 0 Then Exit For
Next J
If J > Sqr(I) Then
ReDim Preserve P(UBound(P) + 1)
P(UBound(P) + 1) = I 'P(UBound(P)) = I
End If
Next I
For I = 80 To 125
If fun(I, P, S1, S2) Then 'If fun(I, P, S1, S2)
Text1 = Text1 & Str$(I) & "=" & Str(S1) & "*" & Str$(S2) & vbCrLf
End If
Next I
End Sub
Private Function fun(N As Integer, P() As Integer, S1 As Integer, S2 As Integer) As Boolean
Dim I As Integer, J As Integer
For I = 1 To UBound(P)
For J = 1 To UBound(P) - 1
If N = P(I) * P(J) Then
S1 = P(I)
S2 = P(J)
'fun = True
Exit Function
fun = True '位置错
End If
Next J
Next I

End Function

3、
Option Explicit
Private Sub Get_Chess(Chess() As Integer, idx As Integer, Over As Integer) 'ByVal idx As Integer
Dim Ub As Integer, Counter As Integer, K As Integer
Ub = UBound(Chess)
Chess(idx) = 0
Counter = 1
K = 0 '位置错
Do Until Counter = Ub - 1

Do Until K = 2
idx = idx + 1
If idx > Ub Then idx = 1
K = K + Chess(idx)
Loop
Chess(idx) = 0
Counter = Counter + 1
Loop
For Over = 1 To Ub
If Chess(Over) <> 0 Then Exit For
Next Over
End Sub

Private Sub Command1_Click()
Dim Chess(32) As Integer, I As Integer, J As Integer
Dim K As Integer, idx As Integer
For I = 1 To 32
For J = 1 To 32
Chess(J) = 1
Next J
Call Get_Chess(Chess, I, K)
If K = 23 Then
Text1 = "从第" & Str$(I) & "号棋子开始取"
Exit For
End If
Next I
End Sub

5、
Option Explicit
Private Sub Form_Click()
Dim S As String, Flg As Boolean
Do
S = InputBox("输入一个自然数")
If S = "" Or Not IsNumeric(S) Th

en
MsgBox "请重新输入", 48 + vbOKOnly
Else
Exit Do
End If
Loop
judge(S, Flg) ' Call judge(S, Flg) 或 judge S, Flg
If Flg Then
Print S; "是回文数"
Else
Print S; "不是回文数"
End If

End Sub
Private Sub judge(Ch As String, F As Boolean)
Dim L As Integer, I As Integer
L = Len(Ch)
F = True ' F = False
For I = 1 To L
If Mid$(Ch, I, 1) <> Mid$(Ch, L + 1 - I, 1) Then Exit Sub
Next I
F = False ' F = True
End Sub

四、编程题
1、编程验证任一大于2的偶数可以表示成两个素数之和。
Private Function Prime(a As Integer) As Boolean
Dim i As Integer
For i = 2 To Sqr(a)
If a Mod i = 0 Then Exit Function
Next i
Prime = True
End Function

'方法一
Private Sub Command1_Click()
Dim m As Integer, i As Integer
m = InputBox("请输入一个大于2 的偶数")
If m <= 2 Or m Mod 2 <> 0 Then MsgBox "请输入大于2的偶数": Exit Sub
If Prime(2) And Prime(m - 2) Then
Print m & "=2 +" & m - 2
Else
Do
i = i + 1
If Prime(2 * i + 1) And Prime(m - (2 * i + 1)) Then
Print m & "=" & 2 * i + 1 & "+" & m - (2 * i + 1)
Exit Do
End If
Loop While 2 * i + 1 < m - (2 * i + 1)
End If
End Sub
'方法二
Private Sub Command2_Click()
Dim m As Integer, i As Integer, p() As Integer, n As Integer
Dim flg As Boolean
m = InputBox("请输入大于2的偶数")
If m <= 2 Or m Mod 2 <> 0 Then MsgBox "请输入大于2的偶数": Exit Sub
ReDim p(1)
p(1) = 2
n = 1
For i = 3 To m - 2 Step 2
If Prime(i) Then
n = n + 1
ReDim Preserve p(n)
p(n) = i
End If
Next i
For i = 1 To n
For j = 1 To n
If p(i) + p(j) = m Then
Print m & "=" & p(i) & "+" & p(j)
flg = True
Exit For
End If
Next j
If flg = True Then Exit For
Next i
End Sub

2、求组合数 （n>=m），程序中必须包含一个求阶乘的通用过程。

Private Function Fact(a As Integer) As Long
If a = 0 Or a = 1 Then
Fact = 1
Else
Fact = a * Fact(a - 1)
End If

End Function

Private Sub Command1_Click()
Dim n As Integer, m As Integer, result As Single
n = Val(Text1.Text)
m = Val(Text2.Text)
If n >= m Then
result = Fact(n) / Fact(m) / Fact(n - m)
Text3.Text = result
Else
MsgBox "要求n>=m,请重新输入"
Text1.Text = ""
Text2.Text = ""
Text1.SetFocus
End If
End Sub

Private Sub Command2_Click()
Text1.Text = ""
Text2.Text = ""
Text3.Text = ""
Text1.SetFocus
End Sub
3、编写一个查找10到300之间所有同构数的

程序，程序中必须包含一个判定某数是否是同构数的Function过程Istgs。若一个数出现在自己平方数的右端，则此数为同构数。如5在52=25的右端，25在252=625的右端，故5和25为同构数。

Private Function Istgs(n As Integer) As Boolean
Dim s As String, L As Integer
L = Len(CStr(n))
s = CStr(n ^ 2)
If Right(s, L) = n Then Istgs = True
End Function

Private Sub Command1_Click()
Dim n As Integer
For n = 10 To 300
If Istgs(n) Then List1.AddItem n & "^2" & "=" & n ^ 2
Next n
End Sub

Private Sub Command2_Click()
End
End Sub

4、编写程序，随机生成一个由三位正整数组成的3行4列的数组，求数组每一行的最大元素及其所在列号，程序中必须包含一个求一行中最大元素及其所在列号的通用过程。（若一行中有多个最大元素则取其中之一即可）


Private Sub CmdDisp_Click()
Dim a(3, 4) As Integer, i As Integer, j As Integer
Dim m As Integer, mj As Integer
Randomize
For i = 1 To 3
For j = 1 To 4
a(i, j) = Int(900 * Rnd + 100)
Print a(i, j);
Next j
Print
Next i
For i = 1 To 3
m = 0
Call max(a, i, m, mj)
Print "第" & i & "行最大值为" & m & ",在第" & mj & "列"
Next i
End Sub
Private Sub max(a() As Integer, i As Integer, m As Integer, maxj As Integer)
Dim j As Integer
m = a(i, 1): maxj = 1
For j = 2 To UBound(a, 2)
If a(i, j) > m Then
m = a(i, j)
maxj = j
End If
Next j
End Sub

Private Sub CmdEnd_Click()
End
End Sub
5、一个整数N的因子和（不包括N）等于N，则N被成为完全数。例如，28=1+2+4+7+14，28是完全数。编写程序验证：介于10到10000之间的完全数，把它们的各位数字加起来得到一个数，再把这个数的各位数字加起来又得到一个数，一直做下去，直到得到一个一位数，这个数是1，程序中必须包含一个判定某数是否是完全数的过程。例如，28的各位数字加起来得到一个数10，再把10这个数的各位数字加起来又得到一个数是1。


Private Function IsWqs(n As Integer) As Boolean
Dim sum As Integer, i As Integer
For i = 1 To n / 2
If n Mod i = 0 Then sum = sum + i
Next i
If sum = n Then IsWqs = True
End Function

Private Sub Command1_Click()
Dim n As Integer
Dim sum As Integer
For n = 10 To 10000
If IsWqs(n) Then
t = n
Print t; "=>";
Do
sum = 0
For i = 1 To Len(t) - 1
sum = sum + Mid(CStr(t), i, 1)
Print Mid(CStr(t), i, 1); "+";
Next i
sum = sum + Mid(CStr(t), i, 1)
If sum <> 1 Then
Print Mid(CStr(t), i, 1); "="; s

um; ","; sum; "=>";
Else
Print Mid(CStr(t), i, 1); "="; sum;
End If
t = sum
Loop Until sum = 1
Print
End If
Next n
End Sub
Private Sub Command2_Click()
End
End Sub

6、找出500以内的超完全数，程序中必须包含一个判定某数是否是超完全数的过程。设符号Ф（N）表示N的所有因子的和（包括N在内），若Ф（Ф（N））=2N，则N就是一个超完全数。例如，16的因子和为1+2+4+8+16=31，而31的因子为1+31=32，32=2*16，故16是一个超完全数。

Private Function Judge(n As Integer) As Boolean
Dim sum As Integer
sum = yz(n)
If yz(sum) = 2 * n Then Judge = True
End Function

Private Function yz(n As Integer) As Integer
Dim i As Integer
For i = 1 To n
If n Mod i = 0 Then yz = yz + i
Next i
End Function

Private Sub Command1_Click()
Dim n As Integer
For n = 1 To 500
If Judge(n) Then Print n
Next n
End Sub

7、编写程序，通过调用通用过程找出100以内的所有不可表示成两个平方数之和的数。
Private Function pfh(n As Integer) As Boolean
Dim i As Integer, t As Single
For i = 1 To Int(Sqr(n))
t = n - i ^ 2
If Sqr(t) = Int(Sqr(t)) Then pfh = True
Next i
End Function

Private Sub Command1_Click()
Dim n As Integer, t As Integer
For n = 1 To 100
If pfh(n) = False Then
t = t + 1
Print n;
If t Mod 10 = 0 Then Print
End If
Next n
End Sub

8、编写程序，通过调用通用过程找出30以内所有的无平方因子数。若一个数不能被大于1的数的平方整除，则该数就是一个无平方因子数。
Private Sub Command1_Click()
Dim n As Integer, j As Integer, flg As Boolean
For n = 2 To 30
flg = False
For j = 2 To n
If pfs(j) And n Mod j = 0 Then
flg = True
Exit For
End If
Next j
If flg = False Then Print n;
Next n
End Sub
Private Function pfs(n As Integer) As Boolean
If Sqr(n) = Int(Sqr(n)) Then pfs = True
End Function

9、编写程序，通过调用通用过程验证下列命题：任意一个正整数和其反序数相加，得到一个新的正整数，再对这个新整数重复上述步骤，最终一定可以得到一个回文数（例如，正整数351，其反序数为153，351+153=504，504+405=909，909是回文数）。
'求反序数
Private Function fxs(n As Long) As Long
Dim i As Integer, s As String
For i = 1 To Len(CStr(n))
s = Mid(CStr(n), i, 1) & s
Next i
fxs = s
End Function
'判断某数是否为回文数
Private Function Hws(n As Long) As Boolean
Dim i As Integer, s As String, L As Integer
s = CStr(n): L = Len(s)
For i = 1 To Len(s) / 2
If Mid(s, i,

1) <> Mid(s, L + 1 - i, 1) Then Exit Function
Next i
Hws = True
End Function

Private Sub Command1_Click()
Dim x As Long, t As Long
x = InputBox("请输入一个正整数：")
t = x
Do While Hws(t) = False
Print t; "+"; fxs(t); "="; t + fxs(t)
t = t + fxs(t)
Loop
End Sub

10、找出1000以内所有的奇妙平方数，程序中必须包含一个判定某事是否是奇妙平方数的过称。所谓奇妙平方数，是指此数的平方与它的逆序数的平方互为逆序数。例如，122=144，212=441，12与21互逆，144与441互逆，12就是奇妙平方数。
'求反序数
Private Function fxs(n As Long) As Long
Dim i As Integer, s As String
For i = 1 To Len(CStr(n))
s = Mid(CStr(n), i, 1) & s
Next i
fxs = s
End Function

Private Sub Command1_Click()
Dim n As Long, t As Long
For n = 1 To 999
t = fxs(n)
If t ^ 2 = fxs(n ^ 2) And n Mod 10 <> 0 And n < t Then
List1.AddItem n & " " & t
List2.AddItem n & "^2" & "=" & n ^ 2 & " " & t & "^2" & "=" & t ^ 2
End If
Next n
End Sub

11、编写程序，查找介于300~2000之间的所有只有两个数字相同的完全平方数，程序中必须包含一个判定某数是否是只有两个数字相同的完全平方数的过程。所谓完全平方数是指其平方根为整数的数。例如676、900、1521等都是介于300~2000之间符合条件的数。

Private Function Judge(n As Integer) As Boolean
Dim i As Integer, L As Integer, a(9) As Integer, t As Integer
If Sqr(n) = Int(Sqr(n)) Then
L = Len(CStr(n))
For i = 1 To L
t = Mid(CStr(n), i, 1)
a(t) = 1
Next i
For i = 0 To 9
Sum = Sum + a(i)
Next i
If Sum = L - 1 Then Judge = True
End If


End Function

Private Sub Command1_Click()
Dim a As Integer
For a = 300 To 2000
If Judge(a) Then List1.AddItem a
Next a
End Sub

12、编写程序，随机生成8个不相等的三位正整数，将他们显示在列表框1中，并在列表框2中显示其中的奇偶间隔数，程序中必须包含一个判定某数是否是就间隔数的过程。所谓奇偶间隔数是指：该数据的各位与百位为奇数，十位为偶数。例如147就是一个就间隔数。
Private Function F(n As Integer) As Boolean
Dim i As Integer
For i = 1 To Len(CStr(n))
If i Mod 2 = 1 And Mid(CStr(n), i, 1) Mod 2 <> 1 Then Exit Function
If i Mod 2 = 0 And Mid(CStr(n), i, 1) Mod 2 <> 0 Then Exit Function
Next i
F = True
End Function
Private Sub CmdDisp_Click()
Dim a(8) As Integer, i As Integer, j As Integer
Randomize
Do
t = Int(900 * Rnd + 100)
For j = 1 To i
If t = a(j) Then Exit For
Next j
If j = i + 1 Then
i = i + 1
a

(i) = t
List1.AddItem a(i)
If F(a(i)) Then List2.AddItem a(i)
End If
Loop Until i = 8
End Sub
Private Sub CmdClear_Click()
List1.Clear
List2.Clear
End Sub

Private Sub CmdEnd_Click()
End
End Sub


13、编写一个找出所有三位绝对素数的程序。所谓绝对素数是指该数本身是素数，其逆序数也是素数的数。例如，107与701都是素数，所以107和701都是绝对素数。
Private Function prime(a As Integer) As Boolean
Dim i As Integer
For i = 2 To Sqr(a)
If a Mod i = 0 Then Exit Function
Next i
prime = True
End Function

Private Function nx(n As Integer) As Integer
Dim i As Integer, s As String
For i = 1 To Len(CStr(n))
s = Mid(CStr(n), i, 1) & s
Next i
nx = Val(s)
End Function
Private Sub CmdFind_Click()
Dim n As Integer, t As Integer
For n = 100 To 900
t = nx(n)
If prime(n) And prime(t) And n < t Then
List1.AddItem "(" & n & "," & t & ")"
End If
Next n
End Sub

14、随机生成一个4行5列由两位正整数组成的数组，并找出其中所有的峰元素。所谓峰元素是指本行内为最大，在本列中也为最大的数组元素。

Option Base 1
Dim a(4, 5) As Integer
Private Sub Command1_Click()
Dim i As Integer, j As Integer
Randomize
For i = 1 To 4
For j = 1 To 5
a(i, j) = Int(Rnd * 90 + 10)
Picture1.Print a(i, j);
Next j
Picture1.Print
Next i
End Sub
Private Sub Fp(a() As Integer, i As Integer, maxj As Integer, Flg As Boolean)
Dim max As Integer, j As Integer, t As Integer
max = a(i, 1): maxj = 1
For j = 2 To UBound(a, 2)
If a(i, j) > max Then
max = a(i, j)
maxj = j
End If
Next j
For t = 1 To UBound(a, 1)
If a(t, maxj) > max Then
Flg = False
Exit Sub
End If
Next
Flg = True
End Sub

Private Sub Command2_Click()
Dim i As Integer, m As Integer, mj As Integer, f As Boolean
For i = 1 To 4
f = False
m = 0: mj = 0
Call Fp(a, i, mj, f)
If f = True Then
Text1.Text = Text1.Text & "(" & i & "," & mj & "):" & a(i, mj)
End If
Next i

End Sub

Private Sub Command3_Click()
Picture1.Cls
Text1.Text = ""
End Sub

15、编写程序，随机生成30个无重复数的三位整数，找出其中的降序数。所谓降序数是指所有高位数字都大于低位数字的数。

Private Sub Command1_Click()
Dim a(30) As Integer, i As Integer, j As Integer
Dim Flag As Boolean
Randomize
Do
t = Int(900 * Rnd + 100)
For j = 1 To i
If t = a(j) Then Exit For
Next j
If j = i + 1 Then
i = i + 1
a(i) = t
Text1.Text = Text1.Text + Str(a(i)

)
If i Mod 10 = 0 Then Text1.Text = Text1.Text + vbCrLf
If IsDown(a(i)) Then
List1.AddItem a(i)
Flag = True
End If
End If
Loop Until i = 30
If Flag = False Then List1.AddItem "无降序数"
End Sub
Private Function IsDown(n As Integer) As Boolean
Dim i As Integer, S As String
S = CStr(n)
For i = 1 To Len(S) - 1
If Mid(S, i, 1) < Mid(S, i + 1, 1) Then Exit Function
Next i
IsDown = True
End Function

Private Sub Command2_Click()
Text1.Text = ""
List1.Clear
End Sub


第七章　程序调试
实验
实验7_1
Private Sub Command1_Click()
Dim A(7) As Integer, St As String
Dim I As Integer, J As Integer
Dim Temp As Long
St = Text1.Text
Temp = Val(St)
'If Temp < 1000000 Or Temp > 9999999 Then
' MsgBox "数据不合要求 ", 48, "输入一个7位整数"
' Exit Sub
'End If
For I = 1 To Len(Temp)
A(I) = Mid$(St, I, 1)
Next
For I = 1 To 6
For J = I + 1 To Len(Temp)
If A(I) < A(J) Then
Temp = A(I)
A(I) = A(J)
A(J) = Temp
End If
Next
Next
St = ""
For I = 1 To Len(Temp)
St = St & A(I)
Next
Text2 = St
End Sub

Private Sub Command2_Click()
Text1.Text = ""
Text2.Text = ""

End Sub

Private Sub Command3_Click()
End
End Sub
实验7_1思考题目答案：
Private Sub Command1_Click()
Dim A(7) As Integer, St As String
Dim I As Integer, J As Integer
Dim Temp As Long
St = Text1.Text
Temp = Val(St)
'If Temp < 1000000 Or Temp > 9999999 Then
' MsgBox "数据不合要求 ", 48, "输入一个7位整数"
' Exit Sub
'End If
For I = 1 To Len(Temp)
A(I) = Mid$(St, I, 1)
Next
For I = 1 To 6
For J = I + 1 To Len(Temp)
If A(I) < A(J) Then
Temp = A(I)
A(I) = A(J)
A(J) = Temp
End If
Next
Next
St = ""
For I = 1 To Len(Temp)
St = St & A(I)
Next
Text2 = St
End Sub

Private Sub Command2_Click()
Text1.Text = ""
Text2.Text = ""

End Sub

Private Sub Command3_Click()
End
End Sub



实验7_2改错题答案：
Option Base 1
Private Sub Command1_Click()
Dim Fb(20) As Integer, i As Integer, j As Integer, k As Integer
Fb(1) = 1
Fb(2) = 2
i = 2
Do
i = i + 1
Fb(i) = Fb(i - 1) + Fb(i - 2)
Loop Until Fb(i) > 1000
For k = 1 To i - 1
Text1 = Text1 & " " & Fb(k)
Next
For k = 2 To i - 1
For j = 2 To Sqr(Fb(k))
If Fb(k) Mod j = 0 Then Exit For
Next
If j > Sqr(Fb(k)) Then Text2 = Text2 & " " & Fb(k)
Next
End Sub

Private Sub Command2_Click()
End
End Sub


实验7_3改错题答案
Option Base 1
Private Sub Command1_Click()
Dim i As Integer, j As Integer, s As String
Dim a() As Integer, k As Integer, gcd As Integer, lcd As Integer
List1.AddItem "聪明数对如下："
For i = 1 To 9
For

j = i To 9
s = ""
Call gld(i, j, gcd, lcd)
If i * j - (i + j) = (gcd + lcd) Then
k = k + 1
ReDim Preserve a(2, k)
a(1, k) = i
a(2, k) = j
s = s & Str$(a(1, k)) & "," & Str$(a(2, k))
List1.AddItem (s)
End If
Next
Next
End Sub
Private Sub gld(ByVal a As Integer, ByVal b As Integer, gcd As Integer, lcd As Integer)
Dim aa As Integer, bb As Integer, r As Integer
aa = a
bb = b
Do
r = a Mod b
a = b
b = r
Loop Until r = 0
gcd = a
lcd = (aa * bb) / gcd
End Sub

习题答案
选择题
1.D 2.A 3.B 4.D 5.B 6.B 7.C 8.C 9.C
填空题
1.中断　2.ctrl+break 3.本地　4.debug.print k
改错题
Option Explicit
Option Base 1
Private Sub Form_Click()
Dim a(10) As Integer, i As Integer, j As Integer
Dim b(10) As Integer, k As Integer, l As Integer
Randomize
For i = 1 To 10
a(i) = Int(Rnd * 19) + 1
Print a(i);
Next
Print
j = 1
k = 10
For i = 1 To 10
For l = 2 To a(i) - 1
If a(i) Mod l = 0 Then Exit For
Next
If l = a(i) Then
b(j) = a(i)
j = j + 1
Else
b(k) = a(i)
k = k - 1
End If
Next
For i = 1 To 10
Print b(i);
Next
Print
End Sub
编程题
Option Explicit
Option Base 1
Private Sub Command1_Click()
Dim i As Integer
For i = 1 To Len(Text1.Text)
Text2.Text = Text2.Text & Convert(Mid(Text1.Text, i, 1)) & vbCrLf
Next
End Sub
Private Function Convert(a As String) As String
Dim Ascii As Integer
Dim Binary As String
Ascii = Asc(a)
Do While Ascii > 0
Binary = Ascii Mod 2 & Binary
Ascii = Ascii \ 2
Loop
Convert = Binary
End Function

第八章文件实验答案
实验
8_1图片浏览器：
Private Sub Dir1_Change()
File1.Path = Dir1.Path
End Sub

Private Sub Drive1_Change()
Dir1.Path = Drive1.Drive
End Sub



Private Sub File1_DblClick()
Dim fileName As String
fileName = File1.Path + "\" + File1.fileName
Image1.Picture = LoadPicture(fileName)
HScroll1.Max = Image1.Width - Picture1.Width + VScroll1.Width
VScroll1.Max = Image1.Height - Picture1.Height + HScroll1.Height
If Image1.Width > Picture1.Width Then
rgeChange = HScroll1.Max / 10
HScroll1.SmallChange = VScroll1.Max / 20
HScroll1.Enabled = True
Else
HScroll1.Enabled = False
End If
If Image1.Height > Picture1.Height Then
rgeChange = VScroll1.Max / 10
VScroll1.SmallChange = VScroll1.Max / 20
VScroll1.Enabled = True
Else
VScroll1.Enabled = False
End If
End Sub



Private Sub Form_Load()
File1.Pattern = "*.jpg;*.bmp"
Image1.Left = 0: Image1.Top = 0
HScroll1.Top = Picture1.Height - HScroll1.Height - 50
HScroll1.Left = 0
HScroll1.Width = Picture1.Width - 50
VScroll1.Top = 0
VScroll1.Left = Picture1.Width - VScroll1.Width - 50
VScroll1.Height = Picture1.Height - HScroll1.Height - 50
HScroll1.Min = 0: VScroll1.Min = 0
End Sub

Private

Sub HScroll1_Change()
Image1.Left = -HScroll1.Value
End Sub

Private Sub VScroll1_Change()
Image1.Top = -VScroll1.Value
End Sub


实验8_2　顺序文件操作
Option Base 1
Dim a(4, 4) As Integer
Private Sub Command1_Click()
Dim s As Integer
Dim i As Integer
Dim j As Integer
Open "c:\test.txt" For Input As #12
Do While Not EOF(12)
i = j \ 4 + 1
Input #12, a(i, (j Mod 4) + 1)
j = j + 1
Loop
For i = 1 To 4
For j = 1 To 4
Picture1.Print Format(a(i, j), "@@@");
Next
Picture1.Print
Next
Close #12
Command2.Enabled = True
End Sub

Private Sub Command2_Click()
Dim i As Integer
Dim j As Integer
Dim sum As Integer
For i = 1 To 4
sum = sum + a(i, i)
Next
Text1.Text = sum
End Sub

Private Sub Command3_Click()
End
End Sub


实验8_3　记录文件操作
Option Explicit
Option Base 1
Private Type Stu_Score
Studentname As String * 6
Language As Integer
Math As Integer
English As Integer
End Type
Dim Student As Stu_Score
Dim Filenum As Integer
Dim Reclength As Long
Dim str As String
Private Sub Command1_Click()
Student.Studentname = Text1
nguage = Text2
Student.Math = Text3
Student.English = Text4
Print List1.ListIndex
List1.AddItem Text1 & " " & Text2 & " " & Text3 & " " & Text4
End Sub

Private Sub Command2_Click()
Text1 = "": Text2 = "": Text3 = "": Text4 = ""
End Sub

Private Sub Form_Load()
Filenum = FreeFile
Reclength = Len(Student)
Open "score" For Random As #Filenum Len = Reclength
List1.AddItem "姓名 语文　数学　英语"
Do While Not EOF(Filenum)
Get #Filenum, , Student
With Student
str = .Studentname & " " & .Language
str = str & .Math & "　" & .English
List1.AddItem str
End With
Loop
List1.RemoveItem (List1.ListCount - 1)

End Sub

Private Sub Form_Unload(Cancel As Integer)
Close #Filenum
End Sub


习题答案：
一． 选择题：
1.A 2.B 3.C 4.D 5.C 6.C 7.A 8.B 9.C 10.C 11.D
12.C 13.D 14.D 15.C 16.A
二． 填空题
1.目录列表框　２．文本　３．Close #1 ４．GFEDCBA
5. EOF(Fileno) #Fileno,L
6.len(LastRecord) filelen(“score”)
7.close #1 FreeFile chr
8. “data.txt” for input as #11 not EOF(11) s Insert(a(i),0)
Preserve b(UBound(b)+1) a(i)
9. LineInput(#1,st) print #3, ,subSt Mid(st,i+1,1) p
三． 改错题
第一题：
Private Sub Command1_Click()
Dim s As String, i As Integer
s = Text1.Text
Call sub1(s)
Open "a.txt" For Output As #12
For i = Len(s) To 1 Step -1
Print #12, Mid(s, i, 1)
Next
Close #12
End Sub
Private Sub sub1(st As String)
Dim i As Integer, l As Integer, k As Integer
Dim p As Integer, al As String * 1
For i = 1 To Len(st)
al = Mid(st, i, 1)
p = i + 1
Do Until p > Len(st)
If al = Mid(st, p, 1) Then

For k = p To i + 1 Step -1
Mid(st, k, 1) = Mid(st, k - 1, 1)
Next
Mid(st, i + 1, 1) = al
Exit Do
Else
p = p + 1
End If
Loop
Next
End Sub

第二题：
Option Explicit
Private Function SuShu(m As Long) As Boolean
Dim i As Long
For i = 2 To Int(Sqr(m))
If m Mod i = 0 Then Exit Function
Next
SuShu = True
End Function

Private Sub Form_Click()
Dim st As String, c As String
Dim num As Long, a() As Long
Dim i As Long, j As Long, k As Long
st = InputBox("请输入任一数字串", "查找素数")
c = ""
i = 1
k = 1
Do While i <= Len(st)
If k <= Len(st) Then
c = c + Mid(st, k, 1)
num = Val(c)
If SuShu(num) Then
j = j + 1
ReDim Preserve a(j)
a(j) = num
End If
k = k + 1
Else
c = ""
i = i + 1
k = i
End If
Loop
Open "a.txt" For Output As #14
Print #14, st
For i = 1 To j
Print #14, a(i)
Next
Close #14
End Sub


四． 编程题
第一题：
Option Explicit
Private Sub Command1_Click()
Dim i As Integer
Dim s As String
Open "c:\test.txt" For Output As #10
For i = 1 To 100
If prime(i) Then
Write #10, i
End If
Next
Close #10
MsgBox "ok"
End Sub



第二题：
Option Explicit
Private Sub Command1_Click()
Dim i As Integer
Open "c:\test.txt" For Output As #10
For i = 1 To 16
Print #10, i;
If i Mod 4 = 0 Then
Print #10, vbCrLf
End If
Next
Close #10
MsgBox "ok"
End Sub



第三题：
Option Explicit
Private Sub Command1_Click()
Dim Source As String
Dim LineStr As String
Open Text1.Text For Input As #10
Do While Not EOF(10)
Line Input #10, LineStr
Source = Source + LineStr
Loop
Text3.Text = Search(Source, Text2.Text)
Close #10
End Sub
Private Function Search(Source As String, word As String) As Integer
Dim num As Integer, i As Integer
For i = 1 To Len(Source) - Len(word)
If Mid(Source, i, Len(word)) = word Then
num = num + 1
i = i + Len(word) '跳过word单词长度后继续查找
End If
Next
Search = num
End Function



第四题：
Option Explicit

Private Sub Command1_Click()
Dim Studentname As String
Dim English As Integer
Dim Math As Integer
Dim Computer As Integer
Dim Allscore As Integer
Dim Avgscore As Double
Open "c:\test.txt" For Input As #10
Open "c:\test1.txt" For Output As #11
Do While Not EOF(10)
Input #10, Studentname, English, Math, Computer
Allscore = English + Math + Computer
Avgscore = Allscore / 3
Print #11, Studentname, English, Math, Computer, Allscore, Avgscore
Loop
Close #10
Close #11
Kill "c:\test.txt"
Name "c:\test1.txt" As "c:\test.txt"
End Sub


第五题：
Option Explicit
Private Type StudentType
Studentno As String * 6
Studentname As String * 6
English As Integer
Math As Integer
Comp

uter As Integer
End Type

Private Sub Command1_Click()
Dim Tempstudent As StudentType
Dim Filenum As Integer
Dim Filenum1 As Integer
Dim Reclength As Long
Filenum = FreeFile
Reclength = Len(Tempstudent)
Open "score" For Random As #Filenum Len = Reclength
Filenum1 = FreeFile
Open "tempfile" For Random As #Filenum1 Len = Reclength
Do While Not EOF(Filenum)
Get #Filenum, , Tempstudent
With Tempstudent
If Not (.Computer < 60 And .English < 60 Or .Computer < 60 And .Math < 60 Or .English < 60 And .Math < 60) Then
Put #Filenum1, , Tempstudent
End If
End With
Loop
Close #Filenum
Kill "score"
Name "tempfile" As "score"
End Sub



第九章习题
一． 选择题
题号 1 2 3 4 5 6
答案 A B A C C B
题号 7 8 9 10 11 12
答案 B B C D D D

二． 填空题
1．左键 右键 中间键
2． Style
3．AutoSize
4．Picture1.Move 200, 100, Picture1.Width / 2, Picture1.Height / 2
5．Picture1.Line (1000, 1000)-Step(1000, 1000), RGB(255, 0, 0), BF
6．以(3000,3000)为圆心，水平半径长为500，垂直半径长为1000， 60°为起始弧度值，
270°为结束弧度值的一段圆弧，并且圆弧的端点和圆心相连接。（或者直接画出如下图
也可）

7．AB A
8. RGB(Int(Rnd * 256), Int(Rnd * 256), Int(Rnd * 256))
(x1, 800), 400

三． 编程题
1．Option Explicit
Private Sub Command1_Click()
Dim x As Single, y As Single, a As Integer
Const pi = 3.1415926
Line (50, 1500)-(6200, 1500)
Line (6200, 1500)-(6000, 1450)
Line (6200, 1500)-(6000, 1550)
Line (3000, 500)-(3000, 2500)
Line (3000, 500)-(2950, 700)
Line (3000, 500)-(3050, 700)
For a = -360 To 360
If Abs(Cos(a * pi / 180)) > 0.4 Then
y = (-1) * Tan(a * pi / 180) * 500 + 1500
x = a * 8 + 3000
PSet (x, y), RGB(255, 0, 0)
End If
If Abs(Sin(a * pi / 180)) > 0.4 Then
y = (-1) * Cos(a * pi / 180) / Sin(a * pi / 180) * 500 + 1500
x = a * 8 + 3000
PSet (x, y), RGB(0, 0, 255)
End If
If a Mod 90 = 0 Then
Line (x, 1500)-(x, 1600)
Print a
End If
Next
End Sub

2．Private Sub Command1_Click()
Dim i As Integer, j As Integer
Dim x As Integer, y As Integer
Dim flag As Boolean
flag = False
x = 500
y = 500
For i = 1 To 9
For j = 1 To 9
If flag Then
Line (x, y)-Step(200, 200), RGB(255, 255, 255), BF
flag = False
Else
Line (x, y)-Step(200, 200), RGB(0, 0, 0), BF
flag = True
End If
x = x + 200
Next j
x = 500
y = y + 200
Next i
End Sub

3．Private Sub Command1_Click()
Const pi = 3.1415926
DrawWidth = 2
FillStyle = 0
FillColor = RGB(180, 180, 180)
Circle (1000, 1500), 800, , -7 * pi / 6, -5 * pi / 6

FillColor = RGB(210, 210, 210)
Circle (3000, 1500), 800, RGB(210, 210, 210), -7 * pi / 6, -5 * pi / 6
End Sub

第十章习题
一． 选择题
题号 1 2 3 4 5 6 7 8
答案 D C C B C B A A
题号 9 10 11 12 13 14 15 16
答案 C B A A A A B A

二． 填空题
1． 数据 DatabaseName RecordSource
2． 绑定 DataSource DataField DataSource DataField
3．AddNew Delete Update
4．关系
5．关系 mdb
6．Data.Recordset.Update
7．DELETE FROM xsh WHERE 性别=”男”
8．ALTER TABLE xsh ADD COLUMN Sex text(2)

三． 编程题
1． CREATE TABLE xsh (Number Text(5),Name Text(6)) ‘建立表
ALTER TABLE xsh ADD COLUMN Sex Text(2) ‘添加字段
ALTER TABLE xsh DROP COLUMN Sex ‘删除字段
SELECT Number,Name,Sex FROM xsh Where Sex = “男” ‘数据查询
INSERT INTO xsh(Number,Name,Sex) VALUE(“98001”,”李小平”，”男”) ‘添加纪录
DELETE FROM xsh WHERE Sex=”男” ‘删除纪录
UPDATE xsh SET Name=”王东升” WHERE Name=”李小平 ‘更新纪录”

2．（1）．INSERT INTO kch(课程编号,课程名称,课程性质,学分) VALUE (“k004”,”Java程序设
计”,”专业选修”,2)
　(2)．DELETE FROM kch WHERE 课程名称=”操作系统”
(3)．UPDATE kch SET 学分=2 WHERE 课程编号 = “k003

3．Private Sub M1_1_Click()
Data1.Recordset.AddNew
Data1.Recordset.Update
Data1.Recordset.MoveLast
End Sub

Private Sub M1_2_Click()
Data1.Recordset.MoveNext
MsgBox "数据更新成功!!", vbInformation, "提示信息"
End Sub

Private Sub M1_3_Click()
Data1.Recordset.Delete
Data1.Recordset.MoveLast
End Sub

Private Sub M1_4_Click()
Picture1.Print "课程编号", "课程名称", "课程性质 ", "学分"
Data1.Recordset.MoveFirst
Do Until Data1.Recordset.EOF
Picture1.Print Data1.Recordset.Fields(0), Data1.Recordset.Fields(1), _
Data1.Recordset.Fields(2), Data1.Recordset.Fields(3)
Data1.Recordset.MoveNext
Loop
End Sub


模拟练习一答案
笔试模拟题（一） 答案
第一部分 计算机基础知识
1. 2. 3. 4. 5. 6. 7. 8. 9. 10.
A D C A B B D C A C
11. 12. 13. 14. 15. 16. 17. 18. 19. 20.
B C D C D D C D C B
第二部分 Visual Basic程序设计
一、选择题
62. 63. 64. 65. 66. 67. 68. 69. 70. 71.
D A B C D D A B B A
二、填空题
（1） （X+Y<20）Or (X>5 And Y>5)
（2） 31
（3） 63
（4） 0
（5） 4
（6） 2 3 4 5 6
（7） 6 7 8
（8） 10
（9） 1 1 2
（10） 1 1 1
（11） 3 1 4
（12） 1 3 1
（13） 6.5
（14） 4 9 13
（15） 19.5
（16） Val（Text1.Text）
（17） x^n 或 t*x
（18） s*n
（19） t/s >= 10 ^ -5
（20） x-1 或 Sqr(x)
（21） Flag = False
（22） List1.AddItem x
（23） 10
（24） i + 1
（25） temp
（26

） Text2.Text & sort(i)
（27） and total(p2) Mod 6 = 0
（28） "(" & p1 & "," & p2 & ")"
（29） m + Val(Mid(Cstr(n), i,1))
（30） total = m



第三部分上机改错与编程
一、改错题
Option Explicit
Private Sub Form_Click()
Dim a(10) As Integer, i As Integer
For i = 1 To 10
a(i) = i
Next i
For i = 1 To 10 '改为 For i = 1 To 9
If p(a(i) + a(i + 1)) = False Then Print a(i), a(i + 1) '改为p(a(i) + a(i + 1)) = True
Next i
End Sub
Private Function p(x As Integer) As Boolean
Dim i As Integer
p = False
For i = 2 To Int(Sqr(x))
If x Mod i = 0 Then Exit For '改为 Exit Function
Next i
p = True
End Function

二、编程题
Option Base 1
Dim A(5, 5) As Integer
Private Sub Command1_Click()
Dim i As Integer, j As Integer
For i = 1 To 5
For j = 1 To 5
A(i, j) = Int((9 - 1 + 1) * Rnd + 1)
Picture1.Print A(i, j);
Next j
Picture1.Print
Next i
End Sub

Private Sub Command2_Click()
Dim Sum1 As Integer, Sum2 As Integer
Dim i As Integer, j As Integer
For i = 1 To 5
For j = 1 To 5
If i < j Then
Sum1 = Sum1 + A(i, j)
Else
If i > j Then
Sum2 = Sum2 + A(i, j)
End If
End If
Next j
Next i
Text1 = CStr(Sum1) & "-" & CStr(Sum2) & "=" & CStr(Sum1 - Sum2)
End Sub

模拟练习二答案
第一部分 基础知识
一、 选择题
DBBBD BBABC AABAA DABDC
第二部分 VB程序设计
一、 选择题
CCCCB AACDB
二、填空题
1、$$***$$$$*****
2、0.6 1.8 5.4
3、11 2 43
4、1 5 2
8
3
5、2 2 109
6、sum=1
a*(x^2/(2*n*(2*n-1)))
Abs(a) <=0.0000001
sum
7、Len(a)
zh(b)
1
n
8、UBound(P)
P(I)+P(J)+P(k)
I Mod J =0
I
9、Len(st)
Mid(st,i,1)
A(idx)+1
Asc(“a”)
25
第三部分上机改错与编程

一、 改错题
Option Explicit
Private Sub Form_Click()
Dim n As Integer
Dim flg As Boolean ' Dim flg As Integer
n = InputBox("input n:")
Call Conver(n, flg)
If flg = True Then
Print n; "是降序数"
Else
Print n; "不是降序数"
End If
End Sub
Private Sub Conver(n As Integer, flg As Boolean) ' byval flg as Boolean
Dim x As String, i As Integer
x = Trim(Str(n))
For i = 1 To Len(x) - 1
If Mid(x, i, 1) < Mid(x, i + 1, 1) Then Exit For ' >
Next i
If i = Len(x) Then flg = True Else flg = False
End Sub
二、编程题
Private Sub Command1_Click() ‘生成列表
Dim i As Integer
Dim j As Integer
Dim k As Integer
For i = 10 To 10000
If Prime(i) Then
For j = 2 To Sqr(i)
For k = 2 To Sqr(i)
If i = j ^ 2 + k ^ 2 And j < k Then

List1.AddItem Str(i) & "=" & Str(j ^ 2) & "+" & Str(k ^ 2)
End If
Next k
Next j
End If
Next i
End Sub
Private Function Prime(x As Integer) As Boolean ‘判断是否是素数过程
Dim n As Integer
Dim i As Integer
n = Sqr(x)
For i = 2 To n
If x Mod i = 0 Then
Prime = False
Exit For
End If
Next i
If i > n Then
Prime = True
End If
End Function
Private Sub Command2_Click() ‘清除列表
List1.Clear
End Sub

Private Sub Command3_Click() ‘返回
End
End Sub
模拟练习三答案
第一部分 基础知识
一、选择题
1．D 2.C 3.D 4.C 5.C 6. C 7.A 8. A 9. A 10.C
11.A 12.B 13.A 14.C 15.B 16.C 17.A 18.C 19.B 20.A
第二部分 VB基础知识
一、选择题
21．B 22.B 23.B 24.B 25.D 26.A 27.A 28.C 29.B 30.D

二、填空题
（1）Option Base1
（2） LBound
（3）Ubound
（4）过程
（5）模块
（6）3
（7）7
（8）23
（9）10 4 6
（10）34 12 22
（11）44
（12）10 8
（13）5 2
（14）12 -10
（15）x<2000
(16) x<3000
(17) y=0.8*x
(18) y=0.7*x
(19) t>eps
(20) (-1)^n
(21) t*x^2/n
(22) Exit For
(23) p2=True
(24) i
(25) True
(26) Str2=Str2&Convert(A(I))
(27) d=Mid(St,I,1)
(28) S= “”
（29）S=B&S
(30)Convert=S


第三部分上机改错与编程

一、 改错题
1) For j=1 To Ubound(b) 改为For j=1 To Ubound(b)-1
2) Private Function wanshu(x As Interger,b()As Interger) As Boolean
改为Private Function wanshu(ByAal x As Interger,b()As Interger) As Boolean
3) For i=2 To x-1
sum=1
改为sum=1
For i=2 To x-1
二、 编程题
Option Explicit
Dim n As Integer,Samp() As Integer
Private Sub Command1_Click()
Dim i As Integer
n=InputBox("输入样本个数n: ",,10)
ReDim samp(n)
For i=1 To n
samp(i)=Int(99*Rnd)+1
Text1=Text1&Str(samp(i))
Next i
End Sub

Private Sub Command2_Click()
Dim Max As Integer, Min As Integer,i As Integer
Dim news() As Single
ReDim news(n)
Call MaxMin(samp,Max,Min)
For i=1 To n
new(i)=(samp(i)-Min)/(Max-Min)
List1.AddItem samp(i)& "-->"&new(i)
Next i
End Sub

Private Sub MaxMin(a()As Integer,Max As Integer,Min As Integer)
Dim i As Integer
Max=a(1):Min=a(1)\
For i=2 To UBound(a)
If a(i)Min=a(i)
ElseIf a(i)>Min Then
Max=a(i)
EndIf
Next i
End Sub

Private Sub Command3_Click()
Text1="":List.Clear
End Sub

模拟练习四答案
第一部分
1. C
2. D
3. B
4. C
5. B
6. A
7. C
8. B
9. B
10. D
11. B
12. D
13. C
14.
15. B
16. D
17. A
18. C
19. D
20. D
第二部分
一 选择题
21. A
22. A
23. B
24. D
25. D
26. C
27. B
28. A
29. A
30. C
二 填空题
1. C
2. CW
3. 8
4. 4 9 2
5. 3 5 7
6. 8 1 6
7. 3
8. 9.6
9. 17
10. 178
11. 178
12. 6
13. 5
14. 17
15. N/Fm
16. P() as Integer
17. ReDim

Preserve P(Idx)
18. I
19. Int(41*Rnd) –20
20. fan(a)
21. b(j)+abs(a(i,j))
22. Fz23. Exit Function
24. Fz&Fm
25. Mid(S,i,1) =Mid(S,n,1)
26. Vilidata=True
27. "c:\data.txt" For Input As #11
28. Not EOF(11)
29. ReDim Preserve B(UBound(B) + 1)
30. B(i) = B(i - 1)
第三部分上机改错与编程

改错题
Option Explicit

Private Sub Command1_Click()
Dim a(9) As Integer, x As Integer, k As Integer, i As Integer
Do While i <= 9
x = Int(Rnd * 900 + 100)
k = x Mod 10
If a(k) = 0 Then
a(k) = x ‘x=a(k)
i = i + 1
Text1 = Text1 & Str(a(k))
End If
Loop
sort a ‘sort(a)
For i = 0 To 9
List1.AddItem a(i)
Next i
End Sub


Private Sub sort(a() As Integer)
Dim temp As Integer, n As Integer, i As Integer, j As Integer
n = UBound(a)
For i = 0 To n
For j = i + 1 To n
If a(i) < a(j) Then
temp = a(i)
a(i) = a(j) ‘a(j)=a(i)
a(j) = temp
End If
Next j
Next i
End Sub
编程题
Option Explicit

Private Sub Command1_Click()
Dim i As Integer, s1 As Integer, s2 As Integer
Dim k As Integer
s1 = Text1: s2 = Text2
For i = s1 To s2
If luck(i) Then
k = k + 1
List1.AddItem Str(i)
End If
Next i
Text3 = k
End Sub

Private Function luck(ByVal n As Integer) As Boolean
Dim a(4) As Integer, k As Integer
Do
k = k + 1
a(k) = n Mod 10
n = n \ 10
Loop Until n <= 0
If (a(1) + a(2)) = (a(3) + a(4)) Then luck = True
End Function

Private Sub Command2_Click()
Text1 = "": Text2 = "": Text3 = ""
List1.Clear
Text1.SetFocus
End Sub
模拟练习五答案
第一部分计算机基础知识
1.D 2.D 3.B 4.C 5.C 6.C 7.B 8.C 9.A 10.D 11.B 12.A 13.B 14.D 15.C 16.A 17.A 18.D 19.B 20.D
第二部分VISUAL BASIC程序设计
一．选择题：
21.d 22.b 23.c 24.c 25.c 26.c 27.a 28.d 29.b 30.b
二．填空题：
(1) .6 (2) 1.8 (3)5.4 (4)DHL (5)NRV (6)XBF (7)1 (8)-2 (9)6 (10)X=4 (11)26 (12)15 15 (13)6.5 (14)4 9 13 (15)19.5 (16)X<=1 (17)2 (18)Fib(n-1)+Fib(n-2)
(19) byval N as integer (19) N=N\10 (20) F=false (21) prime=true
(22)k=10 (23) b(j)=a(i) (24)k=k-1 (25)b(i)
(26) false (27)exit sub (28)str(n) (29) s1 (30)true

第三部分上机改错与编程
一． 改错题：
Option Explicit
Private Sub Command1_Click()
Dim exp As Integer, idx As Integer
For idx = 2 To 10000
If Mersenne(idx, exp) Then
If Prime(idx) Then
List1.AddItem idx & "=" & 2 & "^" & exp & "-1"
End If
End If
exp = 0
Next
End Sub
Private Function Mersenne(N As Integer, exp As Integer) As Boolean
Dim M As Integer, ex As Long
M = N
ex = 1
Do While M > ex
exp = exp + 1