VB实验
实验（三）
题目(4)用inputbox函数计算圆面积，球表面积，球体积。
Option Explicit
Const PI As Single = 3.14
Dim r As Single
Private Sub Command2_Click()
Text1.Text = ""
Label5.Caption = ""
Label6.Caption = ""
Label7.Caption = ""
End Sub
Private Sub Form_click()
r = Val(InputBox("请输入圆的半径", "半径输入"))
Text1.Text = r
End Sub
Private Sub Command1_Click()
Label5.Caption = Format(PI * r * r, "0.0000")
Label6.Caption = Format(4 * PI * r ^ 2, "0.0000")
Label7.Caption = Format(4 / 3 * PI * r ^ 3, "0.0000")
End Sub
题目(5)模拟秒表操作程序。开始、停止、所用时间。
Dim e As Date
Dim b As Date
Private Sub Command1_Click()
Text1.Text = Format(Now(), "hh:mm:ss")
b = Text1.Text
End Sub
Private Sub Command2_Click()
Text2.Text = Format(Now(), "hh:mm:ss")
e = Text2.Text
Text3.Text = Format(e - b, "hh:mm:ss")
题目(7)某职工每天的工资是P元，本月他工作了D天，...
Private Sub Text1_KeyPress(KeyAscii As Integer)
If KeyAscii = 13 Then
p = Val(InputBox("请输入日工资", "工资输入"))
d = Val(InputBox("请输入工作天数", "天数输入"))
Text1.Text = p
Text2.Text = d
a = p * d - (p * d * 0.055 + 27.83)
Print a
Label4.Caption = Format(a, "0.00")
End If
End Sub
End Sub
实验（四）
题目(1)计算三角形面积
Option Explicit
Dim a As Integer
Dim b As Integer
Dim c As Integer
Dim p As Single
Dim s As Single
Private Sub Command1_Click()
p = (a + b + c) / 2
s = Sqr(p * (p - a) * (p - b) * (p - c))
Label5.Caption = s
End Sub
Private Sub Command2_Click()
Text1.Text = ""
Text2.Text = ""
Text3.Text = ""
Label5.Caption = ""
End Sub
Private Sub Command3_Click()
End
End Sub
Private Sub Form_click()
a = InputBox("请输入边长a：", "输入边")
Text1.Text = a
b = InputBox("请输入边长b：", "输入边")
Text2.Text = b
c = InputBox("请输入边长c：", "输入边")
Text3.Text = c
If a + b < c Or a + c < b Or b + c < a Then
MsgBox "你输入的数据有误，请重新输入！"
End If
End Sub
题目(2)袖珍计算器
Private Sub Command1_Click()
a = Text1.Text
b = Text2.Text
c = Text3.Text
If Not IsNumeric(a) And Not IsNumeric(b) And (c <> "+" Or c <> "-" Or c <> "mod" Or c <> "\" Or c <> "*" Or c <> "/") Then
MsgBox "请输入正确的字符！"
Text1.Text = ""
Text2.Text = ""
Text3.Text = ""
Text1.SetFocus
End If
If c = "+" Then Text4.Text = a + b
If c = "-" Then Text4.Text = a - b
If c = "*" Then Text4.Text = a * b
If c = "/" And b <> 0 Then Text4.Text = Format(a / b, "0.0000")
If c = "mod" And b <> 0 Then Text4.Text = a Mod b
If c = "\" And b <> 0 Then Text4.Text = a \ b
End Sub
Private Sub Command2_Click()
Text1.Text = ""
Text2.Text = ""
Text3.Text = ""
Text4.Text = ""
End Sub
Private Sub Command3_Click()
End
End Sub
题目(5)任意输入三个数比较大小
Option Explicit
Dim a(1 To 3) As Single
Dim max, min, ave, n, j, k, i
Private
Sub Text1_KeyPress(KeyAscii As Integer)
If KeyAscii = 13 Then
a(1) = Val(Text1.Text)
Text2.SetFocus
End If
End Sub
Private Sub Text2_KeyPress(KeyAscii As Integer)
If KeyAscii = 13 Then
a(2) = Val(Text2.Text)
Text3.SetFocus
End If
End Sub
Private Sub Text3_KeyPress(KeyAscii As Integer)
If KeyAscii = 13 Then
For n = 1 To 3
If Not IsNumeric(a(n)) Then MsgBox "请输入正确的数字字符！"
Next n
a(3) = Val(Text3.Text)
min = a(1)
For i = 1 To 3
If min > a(i) Then
min = a(i)
End If
Next i
max = a(1)
For j = 1 To 3
If max < a(j) Then
max = a(j)
End If
Next j
For k = 1 To 3
If a(k) <> min And a(k) <> max Then
ave = a(k)
End If
Next k
Label4.Caption = max & ">" & ave & ">" & min
End If
End Sub
题目(6)用inputbox函数输入学生三门功课的成绩M1/M2/M3计算学生奖学金
的等级。
Option Explicit
Dim mark(1 To 3) As Integer
Dim ave As Single
Dim sum As Integer
Dim i As Integer, j As Integer, cout As Integer, m As Integer, n As Integer
Private Sub Form_Click()
FontSize = 20
sum = 0: cout = 0: j = 0: m = 0: n = 0
For i = 1 To 3
mark(i) = Val(InputBox("请输入成绩"))
sum = sum + mark(i)
If mark(i) = 100 Then cout = cout + 1
Select Case mark(i)
Case 70 To 74
j = j + 1
Case 75 To 79
m = m + 1
Case 80 To 100
n = n + 1
End Select
Next i
ave = sum / 3
If cout >= 2 Or (ave >= 95 And n = 3) Then
Print "一等奖"
ElseIf cout = 1 Or (ave >= 90 And m + n = 3) Then
Print "二等奖"
ElseIf m + n + j = 3 Then
Print "三等奖"
ElseIf m + n + j < 3 Then
Print "未获奖"
End If
End Sub
实验（五）
题目(1)有一个数列，它的头三项为0，0，1。直至最后一个数超过1010为止。
Dim a(1 To 20) As Integer, n%, i%
Private Sub Form_click()
For i = 4 To 20
a(1) = 0: a(2) = 0: a(3) = 1
a(i) = a(i - 1) + a(i - 2) + a(i - 3)
Next i
For i = 1 To 20
Print a(i);
If i Mod 5 = 0 Then Print
If a(i) > 1010 Then Exit For
Next i
End Sub
题目(2)找出2~1000之间的全部的同构数
Option Explicit
Private Sub Command1_Click()
Dim i%, a(1 To 2000) As Long
For i = 2 To 2000
Select Case i
Case 2 To 9
If i = i ^ 2 Mod 10 Then
a(i) = i
Text1.Text = Text1.Text & " " & a(i)
End If
Case 10 To 99
If i = i ^ 2 Mod 100 Then
a(i) = i
Text1.Text = Text1.Text & " " & a(i)
End If
Case 100 To 999
If i = i ^ 2 Mod 1000 Then
a(i) = i
Text1.Text = Text1.Text & " " & a(i)
End If
Case 1000 To 2000
If i = i ^ 2 Mod 10000 Then
a(i) = i
Text1.Text = Text1.Text & " " & a(i)
End If
End Select
Next i
End Sub
Private Sub Command2_Click()
End
End Sub
题目(5)百鸡百元
Option Explicit
Private Sub Form_click()
Dim a%, b%, c%
For a = 1 To 100
For b = 1 To 100
For c = 1 To 100
If a + b + c = 100 And a * 5 + b * 3 + c * (1 / 3) = 100 Then
Print a; b; c; a + b + c; a * 5 + b * 3 + c * (1 / 3)
End If
Next c
Next b
Next a
End Sub
题目(8)在图形框中输出6~1000中所有的完数。6.28.496
Private Sub Command
1_Click()
Dim k%, i%, j%, x%, a(1 To 30)
For x = 6 To 500
k = 0
For j = 1 To x '求出因子之和
If x Mod j = 0 And x <> j Then
k = j + k
End If
Next '求出因子之和
If k = x Then Label2.Caption = Label2.Caption & k & vbCrLf
Next
End Sub
Private Sub Command2_Click()
Label2.Caption = ""
End Sub
题目(10)输出图形（数字金字塔）
Private Sub Form_click()
dim i%,j%,n%
For i = 1 To 9
print Spc(30 - 3 * i);
For j = 1 To i
print j;
Next j
For n = i-1 To 1 Step -1
print n;
next n
print
Next i
End Sub
实验（六）
题目(1)输出100个随机数，十个每行，并在标签框中输出元素中的最大，最小，平均值。
Private Sub Form_click()
Randomize
Dim a(1 To 100)
For i = 1 To 100
a(i) = Int(Rnd * 81 + 20)
Print a(i);
If i Mod 10 = 0 Then Print
Next
Max = a(1)
For i = 1 To 100
If Max < a(i) Then
Max = a(i): k = a(i): j = i
End If
Next
Min = a(1)
For i = 1 To 100
If Min > a(i) Then
Min = a(i): m = a(i): n = i
End If
Next
Print "max=" & Max & vbCrLf & "min=" & Min
Print "最大是第" & j & "个" & "最小是第" & n & "个"
End Sub
题目(2)输出两个数组，并让这两个数组相加得到第三个数组(未完成)
Private Sub Form_click()
Dim a(), b(), c(), n%, m%, i%, j%
n = Val(InputBox("请输入元素个数"))
x = Val(InputBox("请输入元素范围下界"))
y = Val(InputBox("请输入元素范围上界"))
ReDim a(1 To n)
For i = 1 To n
a(i) = Int(Rnd * (y - x + 1) + x)
Next
Print " 数组a为："
For i = 1 To n
Print a(i);
Next
Print
ReDim b(1 To n)
For i = 1 To n
b(i) = Int(Rnd * (y - x + 1) + x)
Next
Print " 数组b为："
For i = 1 To n
Print b(i);
Next
Print
ReDim c(1 To n)
For i = 1 To n
c(i) = a(i) + b(i)
Next
Print " 数组c为："
For i = 1 To n
Print c(i);
Next
End Sub
题目(4)(未完成)
Option Explicit
Dim a() As Integer, n%, i%
Private Sub picture2_Click()
n = Val(Text1.Text)
For i = 0 To n - 1
ReDim a(0 To n - 1)
Randomize
a(i) = Int(Rnd * 131 + 100)
Next
For i = 0 To n - 1
ReDim Preserve a(n - 1)
Picture2.Print a(i);
Next
Picture2.Print
End Sub
实验（七）
题目(1)求解二元一次方程
Option Explicit
Dim a%, b%, c%, x1, x2
Private Sub Command1_Click()
a = Val(Text1.Text)
b = Val(Text2.Text)
c = Val(Text3.Text)
Call qiuzhi(a, b, c, x1, x2)
Label4.Caption = "x1=" & x1 & vbCrLf & "x2=" & x2
End Sub
Private Sub Command2_Click()
Text1.Text = "": Text2.Text = "": Text3.Text = "": Label4.Caption = ""
End Sub
Private Sub Text1_KeyPress(KeyAscii As Integer)
If KeyAscii = 13 Then
Text2.SetFocus
End If
End Sub
Private Sub Text2_KeyPress(KeyAscii As Integer)
If KeyAscii = 13 Then Text3.SetFocus
End Sub
Private Sub Text3_KeyPress(KeyAscii As Integer)
If KeyAscii = 13 Then Command1.SetFocus
End Sub
Sub qiuzhi(ByRef a%, b%, c%, x1, x2)
If a = 0 Then
MsgBox "此方程不是一元
二次方程！"
x1 = "无解"
x2 = "无解"
Else
x = b ^ -4 * a * c
Select Case x
Case 0
x1 = b / (2 * a)
x2 = b / (2 * a)
Case Is > 0
x1 = (b + Sqr(x)) / (2 * a)
x2 = (b - Sqr(x)) / (2 * a)
Case Is < 0
x1 = b & "+" & Sqr(Abs(x)) & "i" & "/" & (2 * a)
x2 = b & "-" & Sqr(Abs(x)) & "i" & "/" & (2 * a)
End Select
End If
End Sub
补充：
输入200-600之间的随机数，10个一换行，并输出最大的数。
Private Sub Form_Click()
Randomize
For i = 1 To 200
a = Int(Rnd * 401 + 200)
Print a;
If i Mod 10 = 0 Then
Print
End If
Next
ma = 0
If ma < a Then
ma = a
End If
Print "max="; ma
End Sub