VisualBasic试验基础指导书程序代码精.docx

9-1
Option Explicit
Option Base 1
Private Sub Command1_Click(
Dim x(10 As Integer, maxv As Integer, minv As Integer
Dim i As Integer
For i = 1 To 10
x(i = Int(90 * Rnd + 10
Text1.Text = Text1 & Str(x(i
Next i
Call maxmin(x, maxv, minv
Text2.Text = maxv
Text3.Text = minv
End Sub
Private Sub Command2_Click(
Text1.Text = ""
Text2.Text = ""
Text3.Text = ""
End Sub
Private Sub Command3_Click(
End
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 = LBound(a + 1 To UBound(a
If a(i > max Then
max = a(i
ElseIf a(i < min Then
min = a(i
End If
Next i
End Sub
9-2
Private Sub Command1_Click(
Dim x As Long
x = Val(Text1.Text
If verify(x Then
List1.AddItem x
Else
MsgBox Str(x & "不是自守数。", vbInformation End If
End Sub
Private Sub Command2_Click(
Text1.Text = ""
End Sub
Private Sub Command3_Click(
End
End Sub
Private Function verify(x As Long As Boolean
Dim y As Long, s As Integer
verify = False
s = Len(CStr(x
y = x * x
If x = Val(Right(CStr(y, s Then
verify = True
End If
End Function
9-3
Option Explicit
Option Base 1
Private Sub Command1_Click(
Dim a As Integer, b As Integer, i As Integer
a = Val(Text1.Text:
b = Val(Text2.Text
For i = a To b
If sx(i = True Then
List1.AddItem i
8 End If
Next i
If List1.ListCount = 0 Then List1.AddItem "无升序数" End Sub
Private Sub Command2_Click(
Text1.Text = ""
Text2.Text = ""
List1.Clear
Text1.SetFocus
End Sub
Private Sub Command3_Click(
End
End Sub
Private Function sx(ByVal n As Integer As Boolean Dim a( As Integer, k As Integer, i As Integer
Do
k = k + 1
ReDim Preserve a(k
a(k = n Mod 10
n = n \ 10
Loop Until n <= 0
For i = 1 To UBound(a - 1
If a(i + 1 >= a(i Then Exit Function
Next i
sx = True
End Function
9-4
Option Explicit
Private Sub Command1_Click(
Text1.Text = ""
Text2.Text = ""
Text3.Text = ""
End Sub
Private Sub Command2_Click(
End
End Sub
Private Function common(ByVal a As Integer, ByVal b As Integer As Integer Dim r As Integer
Do
r = a Mod b
a = b
b = r
Loop While r <> 0
common = a
End Function
Private Sub Option1_Click(Index As Integer
Dim a As Integer, b As Integer
Dim m As Integer, d As Integer
a = Text1
b = Text2
m = common(a, b
If Index = 0 Then
Text3 = m
Else
d = a * b / m
Text3 = d
End If
End Sub
9-5
Option Explicit
Private Function Judge(n As Integer As Boolean
Dim i As Integer
For i = 2 To Sqr(n
If n Mod i = 0 Then Exit Function
Next i
Judge = True
End Function
Private Sub Command1_Click(
Dim x As Integer, i As Integer
x = Text1.Text
If x = 4 Then
Text2 = "2+2"
Else
i = 3
Do While Text2 = ""
If Judge(i And Judge(x - i Then
Text2 = i & "+" & x - i
Else
i = i + 2
End If
Loop
End If
End Sub
Private Sub Command2_Click(
Text1.Text = ""
Text2.Text = ""
End Sub
Private Sub Command3_Click(
End
End Sub
9-6
Private Function change(s As String, n As Integer As String Dim i As Integer, k As Integer, sum As Integer
Dim p As String * 1, q As Integer
k = 0
For i = Len(CStr(Text2.Text To 1 Step -1
p = Mid(CStr(Text2.Text, i, 1
If p >= "0" And p <= "9" Then
q = Val(p
Else
q = Asc(p - 55
End If
sum = sum + q * n ^ k
k = k + 1
Next i
change = sum
End Function
Private Sub Command1_Click(
Dim s As String, n As Integer
Label2.Caption = Text1.Text & "进制数:"
s = Text1.Text
Select Case s
Case "二"
n = 2
Case "八"
n = 8
Case "十六"
n = 16
End Select
Text3.Text = change(s, n
End Sub
Private Sub Command2_Click(
Text1.Text = ""
Text2.Text = ""
Text3.Text = ""
End Sub
Private Sub Command3_Click(
End
End Sub
9-7
Option Explicit
Private Sub Command1_Click(
Dim n As Long
n = Text1.Text
If Right(CStr(n, 1 = "0" Then
Text2 = "尾数为0,无反序数"
Else
Text2.Text = nx(n
End If
End Sub
Private Sub Command2_Click(
Text1.Text = ""
Text2.Text = ""
End Sub
Private Sub Command3_Click(
End
End Sub
Private Function nx(n As Long As Long
Dim k As Integer, st As String
Do
k = k + 1
st = Mid(CStr(n, k, 1 & st
Loop Until k >= Len(Text1.Text
nx = Val(st
End Function
9-8
Private Sub Command1_Click(
Dim n As Integer, i As Integer, s As String, a( As Integer
For n = 153 To 9999
If arm(n = True Then
ReDim a(Len(CStr(n
For i = 1 To Len(CStr(n
a(i = Mid(CStr(n, i, 1
Next i
s = ""
For i = 1 To Len(CStr(n - 1
s = s & CStr(a(i & "^" & CStr(Len(CStr(n & "+"
Next i
List1.AddItem CStr(n & "=" & s & CStr(a(i & "^" & CStr(Len(CStr(n End If
Next n
End Sub
End
End Sub
Private Function arm(n As Integer As Boolean
Dim a( As Integer, i As Integer, st As String, sum As Integer
arm = False
st = CStr(n
ReDim a(Len(st
For i = 1 To Len(st
a(i = Mid(st, i, 1
Next i
For i = 1 To Len(st
sum = Val(a(i ^ (Len(st + sum
Next i
If n = sum Then
arm = True
Else
Exit Function
End If
End Function
9-9
Dim sco(5 As Single
Private Sub Command1_Click(
Dim i As Integer
For i = 0 To 5
sco(i = (Int(Rnd * 61 + 40 / 10
Text1(i.Text = sco(i
Next i
End Sub
Private Sub Command2_Click(
Dim i As Integer, sum As Integer, min As Single, max As Single Call a(min, max
For i = 0 To 5
sum = sum + sco(i
Next i
Text7.Text = (sum - min - max / 4
End Sub
Private Sub a(min As Single, max As Single
Dim i As Integer, k As Integer
max = sco(0: min = sco(0
For i = 1 To 5
If sco(i > max Then
max = sco(i
ElseIf sco(i < min Then
min = sco(i
End If
Next i
End Sub
For i = 0 To 5
Text1(i = ""
Next i
Text7.Text = ""
End Sub
Private Sub Command4_Click(
End
End Sub
9-10
Private Sub Command1_Click(
Dim max As Long, min As Long
Call at(max, min
Text2.Text = max
Text3.Text = min
End Sub
Private Sub Command2_Click(
Text1.Text = ""
Text2.Text = ""
Text3.Text = ""
End Sub
Private Sub Command3_Click(
End
End Sub
Private Sub at(max As Long, min As Long
Dim s As String, i As Integer, a( As Integer, k As Integer, temp As Integer, st As String, st1 As String s = CStr(Text1.Text
ReDim a(Len(s
For i = 1 To Len(s
k = k + 1
a(k = Val(Mid(s, i, 1
Next i
max = a(1: min = a(1
For i = 1 To Len(s
For j = 1 To Len(s
If a(i < a(j Then
temp = a(i
a(i = a(j
a(j = temp
End If
Next j
Next i
If a(1 = 0 Then
For i = 2 To Len(s
If a(i <> 0 Then Exit For
Next i
temp = a(i
a(i = a(1
a(1 = temp
End If
For i = 1 To Len(s
st = st & a(i
Next i
min = Val(st
For i = 1 To Len(s
For j = 1 To Len(s
If a(i > a(j Then
temp = a(i
a(i = a(j
a(j = temp
End If
Next j
Next i
For i = 1 To Len(s
st1 = st1 & a(i
Next i
max = Val(st1
End Sub
7-2
Option Explicit
Option Base 1
Private Sub Command1_Click(
Dim a(20 As Integer, i As Integer, st As String
Dim max As Integer, min As Integer, maxp As Integer, minp As Integer For i = 1 To 20
a(i = Int(Rnd * (100 - 1 + 1 + 1
st = st & Str(a(i
If i Mod 10 = 0 Then st = st & vbCrLf
Next i
Text1.Text = st
max = a(1: min = a(1
maxp = 1: minp = 1
For i = 2 To 20
If a(i > max Then
max = a(i
maxp = i
ElseIf a(i < min Then
min = a(i
minp = i
End If
Next i
Text2.Text = max & "位置是" & maxp
Text3.Text = min & "位置是" & minp
End Sub
Private Sub Command2_Click(
Text1.Text = ""
Text2.Text = "": Text3.Text = ""
End Sub
Private Sub Command3_Click(
End
End Sub
7-5
Private Sub cmdExit_Click(
Unload Me
End Sub
Private Sub cmdJudge_Click(
Dim m As Integer, i As Integer, j As Integer, sum As Integer Dim a(
m = Text1.Text
For i = 1 To m / 2
If m Mod i = 0 Then
sum = sum + i
j = j + 1
ReDim Preserve a(j
a(j = i
End If
Next i
If m = sum Then
Picture1.Print m & "是完数,由于"
Picture1.Print m; "=";
For i = 1 To UBound(a - 1
Picture1.Print a(i; "+";
Next i
Picture1.Print a(i
Else
Picture1.Print m & "不是完数"
End If
End Sub
Private Sub cmdNext_Click(
Picture1.Cls
Text1.Text = ""
Text1.SetFocus
End Sub
7-6
Option Explicit
Option Base 1
Private Sub Command1_Click(
Dim fn( As Integer, i As Integer, k As Integer
Dim j As Integer, st As String
For i = 10 To 50
k = 0
For j = 1 To i - 1
If i Mod j = 0 Then
k = k + 1
ReDim Preserve fn(k
fn(k = j
End If
Next j
If UBound(fn = 3 Then
st = i & ":"
For j = 1 To UBound(fn - 1
st = st & fn(j & ","
Next j
List1.AddItem st & fn(j
End If
Next i
End Sub
Private Sub Command2_Click(
List1.Clear
End Sub
7-7
Private Sub Command1_Click(
Dim word( As String, S As String
Dim n As Integer, k As Integer, maxw As String S = Text1.Text
Do
n = InStr(S, " "
If n <> 0 Then
k = k + 1
ReDim Preserve word(k
word(k = Left(S, n - 1
List1.AddItem word(k
S = Right(S, Len(S - n
End If
Loop Until n = 0
ReDim Preserve word(k + 1
word(k + 1 = Left(S, Len(S - 1
List1.AddItem word(k + 1
maxw = word(k + 1
For n = 2 To UBound(word
If Len(word(n > Len(maxw Then
maxw = word(n
End If
Next n
Text2.Text = maxw
End Sub
Private Sub Command2_Click(
Text1.Text = ""
Text2.Text = ""
List1.Clear
Text1.SetFocus
End Sub
Private Sub Command3_Click( End End Sub 7-9 Option Base 1 Private Sub Command1_Click( Dim rndArray(10 As Integer Dim i As Integer, j As Integer, temp As Integer Randomize Picture1.Print "排序前：" For i = 1 To 10 rndArray(i = Int(90 * Rnd + 10 Picture1.Print rndArray(i; Next i For i = 1 To 9 For j = 1 To 9 If rndArray(j > rndArray(j + 1 Then temp = rndArray(j rndArray(j = rndArray(j + 1: rndArray(j + 1 = temp End If Next j Next i Picture1.Print Picture1.Print "排序后：" For i = 1 To 10 Picture1.Print rndArray(i; Next i Picture1.Print End Sub Private Sub Command2_Click( Picture1.Cls End Sub Private Sub Command3_Click( End End Sub