vb程序设计实验教程与习题选解王杰华郑国平主编

更新时间：2024-06-08 00:57:01 阅读量：综合文库文档下载

说明：文章内容仅供预览，部分内容可能不全。下载后的文档，内容与下面显示的完全一致。下载之前请确认下面内容是否您想要的，是否完整无缺。

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 第二章常用控件与界面设计习题答案

习题

一、选择题

15. 16. 17. 18. 19. 20. 21. 22. 23. 24. 25. 26. 27. 28. 29. C B B A 75. B B B C A C C B B A C B D A D D C B B B D B B D D B B D C C C B D C C A D B C B C B A A A D B B C A B B C B C D B 30. 31. 32. 33. 34. 35. 36. 37. 38. 39. 40. 41. 42. 43. 44. 45. 46. 47. 48. 49. 50. 51. 52. 53. 54. 55. 56. 57. 58. 59. 60. 61. 62. 63. 64. 65. 66. 67. 68. 69. 70. 71. 72. 73. 74. 第三章实验与习题

实验

实验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(\ List1.AddItem \ 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(\请输入商品的数量：\数量框\

je = dj * sl

n = MsgBox(\共计金额=\结果\ If n = vbOK Then Label1.Caption = \金额：\元\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 = \结果为：\ 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 & \End Sub 实验3_5 略

习题选择题

1-20: DBBDB DDBCA DDDCD DB_DB 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 x

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 (\位移量为：\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

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 & \ 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 & \ 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 & \ 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 & \ \ 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 >= \

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 \ If Asc(ch) - k < Asc(\

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 >= \ '多分支格式，ch介于小写a与z之间 If Asc(ch) - k < Asc(\

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、 \3、 (j * i + 1)

习题参考答案

一选择题

1~5： BDCCD 16~20：BDCDB

6~10：BBBAD 21~25：CCBAD

11~15：DAAAB 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） \ 、（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) & \ 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 = \从第\号棋子开始取\ 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 = \

MsgBox \请重新输入\

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的偶数\ If Prime(2) And Prime(m - 2) Then Print m & \ Else Do

i = i + 1

If Prime(2 * i + 1) And Prime(m - (2 * i + 1)) Then Print m & \ 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的偶数\ 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 & \ flg = True Exit For End If Next j

If flg = True Then Exit For Next i End Sub

2、求组合数Cn?mn!（n>=m），程序中必须包含一个求阶乘的通用过程。 m!(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 & \\ 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 \第\行最大值为\在第\列\ 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); \ Else

Print Mid(CStr(t), i, 1); \ 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; \ 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 & \ \

List2.AddItem n & \ \ 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 \ 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 & \ 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 \数据不合要求 \输入一个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 \数据不合要求 \输入一个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 & \ 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 & \ 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)) & \ 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 + \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

HScroll1.LargeChange = HScroll1.Max / 10 HScroll1.SmallChange = VScroll1.Max / 20 HScroll1.Enabled = True Else

HScroll1.Enabled = False End If

If Image1.Height > Picture1.Height Then

VScroll1.LargeChange = 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 = \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 \ 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