南师大博雅VB记案例

————————————————————————————————作者：————————————————————————————————日期：

循环结构

一、For循环语句：

1、计算1+2+3+4……+100

Private Sub Form_Click()

Dim a As Integer, s As Integer For i = 1 To 100

a = a + 1

s = s + a

Next i

Print s

End Sub

2、计算1+3-5+7-9+……-99

Private Sub Form_Click()

Dim a As Integer, s As Long

a = -1

For i = 1 To 99 Step 2

a = a + 2

s = s + (-1) ^ n * a

n = n + 1

Next i

Print s

End Sub

3、找一个数的约数

Private Sub Command1_Click() Dim n As Integer

List1.Clear

n = InputBox("输入")

For x = 1 To n

If n Mod x = o Then

List1.AddItem Str(x)

End If

Next x

End Sub

4、循环嵌套：找勾股数

（1）Private Sub Command1_Click()

Dim n As Integer

List1.Clear

For a = 1 To 300

For b = a To 300

For c = b To 300

If a ^ 2 + b ^ 2 = c ^ 2 Then

List1.AddItem Str(a) & Str(b) & Str(c)

End If

Next c

Next b

Next a

End Sub

（2）简化

Private Sub Command1_Click()

List1.Clear

For a = 1 To 500

For b = a To 500

If Sqr(a ^ 2 + b ^ 2) = Int(Sqr(a ^ 2 + b ^ 2)) Then

List1.AddItem Str(a) & Str(b) & Str(Sqr(a ^ 2 + b ^ 2)) End If

Next b

Next a

End Sub

二、Select结构语句（善于实现多分支结构）

Select case e

Case e1

A语句

Case e2

B语句

Case else

N 语句

End Select

1、随机出扑克牌：

Private Sub Command1_Click()

Dim n As Integer

n = Int(Rnd * (13 - 1 + 1) + 1)

Select Case n

Case 1

Text1.Text = "ACE"

Case 2 To 10

Text1.Text = CStr(n)

Case 11

Text1.Text = "JACK"

Case 12

Text1.Text = "QUEEN"

Case Else

Text1.Text = "KING"

End Select

End Sub

三、DO—LOOP循环结构

(1)Do While e (2)Do

……

[Exit do] [Exit do]

……LOOP LOOP While e

(3)Do until e (4)Do

……

[Exit do] [Exit do] ……

Loop Loop until e

1、找最大公约数

Private Sub Command1_Click()

Dim n As Integer, m As Integer, r As Integer

n = Val(Text1.Text)

m = Val(Text2.Text)

r = n Mod m

n = m

m = r

Loop While r <> 0

Text3.Text = n

End Sub

2、统计分数：输出总分，最高分，最低分，平均分

Private Sub Command1_Click()

Dim s As Integer, max As Integer, min As Integer

max = 0

min = 100

n = InputBox("成绩")

If n <> -1 Then

k = k + 1

s = s + n

Avg = s / k

If n > max Then max = n

If n < min Then min = n

Else

Exit Do

End If

Loop

Print "总分"; s

Print "平均分"; Avg

Print "最高分"; max

Print "最低分"; min

End Sub

数组

1、产生一个而为数组1 2 3

4 5 6

7 8 9

Private Sub Command1_Click()

Dim a(3, 3) As Integer

k = 1

For i = 1 To 3

For j = 1 To 3

a(i, j) = k

k = k + 1

Print a(i, j);

Next j

Next i

End Sub

2、产生10个各不相同的随机数

Private Sub Command1_Click()

Dim a(10) As Integer, n As Integer

Randomize

Form1.Cls

For i = 1 To 10

k = k + 1

n = Int(Rnd * 90 + 10)

For j = 1 To i - 1

If n = a(j) Then Exit For

Next j

If j = i Then

a(i) = n

Print a(i);

Else

i = i - 1

End If

Next i

Print k

End Sub

3、用数组做计数器：求“两个骰子和”的概率Private Sub Command1_Click()

Form1.Cls

Dim a(2 To 12) As Integer, n As Integer

For i = 1 To 100

n = Int(Rnd * 6 + 1) + Int(Rnd * 6 + 1)

a(n) = a(n) + 1

Next i

For i = 2 To 12

Print CStr(i); ":"; a(i)

Next i

End Sub

4、产生一个五行五列的随机数组

Private Sub Command1_Click()

Dim a(5, 5) As Integer

Randomize

For i = 1 To 5

For j = 1 To 5

a(i, j) = Int(Rnd * 90 + 10)

Print a(i, j);

Next j

Next i

End Sub

5、随机控制任意行列数组

Private Sub Command1_Click()

Dim a() As Integer, m As Integer, n As Integer Form1.Cls

Randomize

m = InputBox("行")

n = InputBox("列")

ReDim a(m, n)

For i = 1 To m

For j = 1 To n

a(i, j) = Int(Rnd * 90 + 10)

Print a(i, j);

Next j

Next i

End Sub

6、找质数

7、制作计算器

Private Sub Command1_Click(Index As Integer)

text1 = text1.Text& CStr&(index)

End Sub

过程调用

1、SUB过程调用：算圆面积

Private Sub Command1_Click()

Dim r As Single, m As Single

r = Val(Text1.Text)

m = 0

Call s(r, m) r,m 为实参Text2.Text = m

End Sub

Private Sub s(r As Single, area As Single) r,area 为形参area = 3.14 * r ^ 2

End Sub

参数的集合就是实参和形参的结合，实参通过位置把数值传给形参

2、Function过程调用：算圆面积

Private Sub Command1_Click()

Dim r As Integer

r = Text1

Text2 = area(r)

End Sub

Private Function area(w As Integer) As Single

area = 3.14 * w * w

End Function

3、计算阶乘

n！

m！*（n-m）！

（1）用一般的循环方式计算：

Private Sub Command1_Click()

n = Val(Text1.Text)

m = Val(Text2.Text)

k = n

t = 1

For i = 1 To k

t = t * i

Next i

s = t

k = m

t = 1

For i = 1 To k

t = t * i

Next i

s = s / t

k = n - m

t = 1

For i = 1 To k

t = t * i

Next i

s = s / t

Text3.Text = Str(s)

End Sub

（2）用FUNCTION过程调用计算阶乘Private Sub Command1_Click()

Dim m As Integer, n As Integer

Dim i As Integer, k As Integer

Dim t As Long, s As Long

n = Val(Text1.Text)

m = Val(Text2.Text)

s = fact(n) / (fact(m) * fact(n - m))

Text3.Text = Str(s)

End Sub

Private Function fact(k As Integer) As Long

Dim i As Integer

fact = 1

For i = 1 To k

fact = fact * i

Next i

End Function

Byval 传值方式

Byref 传址方式（数组作为形参采用传址方式）

默认传址方式

（3）用FUNCTION过程调用计算阶乘（DO LOOP循环）Private Sub Command1_Click()

Dim m As Integer, n As Integer

Dim i As Integer, k As Integer

Dim t As Long, s As Long

n = Val(Text1.Text)

m = Val(Text2.Text)

s = fact(n) / (fact(m) * fact(n - m))

Text3.Text = Str(s)

End Sub

Private Function fact(k As Integer) As Long

Dim i As Integer

fact = 1

For i = 1 To k

fact = fact * I ？

Next i

End Function

4、数组作为形参的过程调用

Private Sub Command1_Click()

Dim a(8) As Integer

Call gen(a)

Call out(a)

Call sort(a)

Call out(a)

End Sub

Private Sub out(a() As Integer)

For i = 1 To UBound(a)

Print a(i);

Next i

End Sub

Private Sub gen(a() As Integer)

For i = 1 To UBound(a)

a(i) = Int(Rnd * 90 + 10)

Next i

End Sub

Private Sub sort(a() As Integer)

Dim t As Integer

For i = 1 To UBound(a) - 1

For j = i + 1 To UBound(a)

If a(i) > a(j) Then

t = a(i)

a(i) = a(j)

a(j) = t

End If

Next j

Next i

End Sub

递归过程

1、用递归过程算阶乘

Private Sub Command1_Click()

Dim n As Integer

n = InputBox("输入一个正整数")

Print n; "!="; fact(n)

End Sub

Private Function fact(ByVal n As Integer) As Long

If n = 1 Then

fact = 1

Else

fact = n * fact(n - 1)

End If

End Function

2、算非布拉切函数fib：0，1，1，2，3，5，8……

Private Sub Command1_Click()

Dim n As Integer

n = InputBox("输入一个正整数")

Print fib(n)

End Sub

Private Function fib(n As Integer) As Long

If n = 1 Or n = 0 Then

fib = n

Else

fib = fib(n - 1) + fib(n - 2)

End If

End Function

打字游戏

前提：label visible false

Timer enabled false

Interval 80

Form keypreview true

Private Sub gen()

Label1.Top = 0

Label1.Visible = True

Label1.Caption = Chr(Int(Rnd * 26 + 65))

'Label.ForeColor = RGB(Int(Rnd * 256), Int(Rnd * 256), Int(Rnd * 256)) ？

Private Sub Command1_Click()

Timer1.Enabled = True

Call gen

End Sub

Private Sub Form_KeyPress(KeyAscii As Integer) If Chr(KeyAscii) = Label1.Caption Then Call gen

End Sub

Private Sub Timer1_Timer()

If Label1.Top < 3000 Then

Label1.Top = Label1.Top + 50

Else: Call gen

End If

End Sub

Private Sub gen()

Label1.Top = 1440

Label1.Visible = True

Label1.Caption = Chr(Int(Rnd * 26 + 65))

End Sub

Private Sub Command1_Click()

Timer2.Enabled = True

Timer1.Enabled = True

Call gen

End Sub

Private Sub Form_KeyPress(KeyAscii As Integer) If Chr(KeyAscii) = Label1.Caption Then

Call gen

Text3.Text = Val(Text3.Text) + 1

End If

End Sub

Private Sub Timer1_Timer()

Dim n As Integer

n = Text3.Text

Select Case n

Case 0 To 30

Text2.Text = 1

Timer1.Interval = 100

Case 30 To 60

Text2.Text = 2

Timer1.Interval = 60

Case Else

Text2.Text = 3

Timer1.Interval = 30

End Select

If Label1.Top < 6840 Then

Label1.Top = Label1.Top + 50

Else: Call gen

End If

End Sub

Private Sub Timer2_Timer()

Text1.Text = Val(Text1.Text) + 1 End Sub