[题目1]所谓的完全数是一个整数N的因子和（不包括N）等于N。例如6=1+2+3，6是完全数。编写程序验证；两位以上的完全数，把它们的各位数字加起来得到一个数，再把这个数的各位数字加起来又得到一个数，一直做下去，直到得到一个一位数，这个数是1。过程WanShu的功能是找完全数。

答：

源程序：

Option Explicit

Private Sub Command1_Click()

Dim i As Integer, K As Integer, St As String

For i = 10 To 500

     If Wanshu(i) Then

          St = CStr(i)

           Text1.Text = Text1.Text & St

           Call Test(St)

           Text1.Text = Text1.Text & Chr(13) & Chr(10)

      End If

Next i

End Sub

 

Private Function Wanshu(n As Integer) As Boolean

Dim i As Integer, sum As Integer

For i = 1 To n - 1

      If n Mod i = 0 Then

           sum = sum + i

       End If

Next i

If sum = n Then Wanshu = True

End Function

 

Private Sub Test(s As String)

Dim i As Integer, sum As Integer

Do Until Val(s) = 1

      sum = 0

       For i = 1 To Len(s)

            sum = sum + Val(Mid(s, i, 1))

      Next i

Text1.Text = Text1.Text & "->" & Str(sum)

s = Str(sum)

Loop

End Sub

 

[题目2] 编程求下面多项式的值
Y=A0+A1×X+A2×X²+……+An×Xⁿ
[编程要求]
1． 程序参考界面如图所示，编程时不得增加或减少界面对象或改变对象的种类，窗体及界面元素大小适中，且均可见；
2． 多项式次数从文本框输入，多项式系数An是随机生成的1~9之间的整数。计算多项式在自变量x依次取0，1，2，……，10时的值。多项式系数显示在图片框中。多项式自变量x的值与对应的多项式值按图示格式显示在列表框中；
3． 单击“计算”命令按钮，则运行程序；按“清除”按钮，则将文本框、图片框和列表框清空；按“结束”按钮，则结束程序运行；
4． 定义一个函数过程求多项式的值。

答：

源程序：

Private Sub Command1_Click()

Dim i As Integer, n As Integer, a() As Integer, sum As Long

Randomize

If Trim(Text1.Text) = "" Then

   MsgBox "", vbOKOnly

   Text1.SetFocus

   Exit Sub

End If

n = Val(Trim(Text1.Text))

ReDim a(n)

Picture1.Cls

List1.Clear

For i = 0 To n

   a(i) = Int(Rnd * 9) + 1

   Picture1.Print a(i) & "  ";

Next i

For i = 0 To 10

    sum = 0

    Call dxsz(i, n, a, sum)

    List1.AddItem i & "    " & sum

Next i

End Sub

 

Private Sub dxsz(x As Integer, n As Integer, arr() As Integer, s As Long)

Dim i As Integer

s = arr(0)

For i = 1 To n

    s = s + arr(i) * x ^ i

Next i

End Sub

 

Private Sub Command2_Click()

Text1.Text = ""

Picture1.Cls

List1.Clear

Text1.SetFocus

End Sub

 

Private Sub Command3_Click()

End

End Sub

 

[题目3] 找出1000以内的超完全数。设符号Φ（N）表示N的所有因子（包括N在内）的和，若Φ（Φ（N））=2N,则N就是一个超完全数。例如：16的因子和为1+2+4+8+16=31；而31的因子和为1+31=32；32=2×16，故16是一个超完全数。

答：

源程序：

Option Explicit

Option Base 1

Private Sub command1_click()

Dim I As Integer, A() As Integer

Dim K As Integer, sum1 As Integer, sum2 As Integer

For I = 2 To 1000

    sum1 = 0: sum2 = 0

    Call fctor(I, sum1)

    Call fctor(sum1, sum2)

    If sum2 = 2 * I Then

          K = K + 1

          ReDim Preserve A(K)

          A(K) = I

     End If

Next I

For I = 1 To K

      Text1.Text = Text1.Text & Str(A(I)) & " "

Next I

End Sub

 

Private Sub fctor(N As Integer, S As Integer)

Dim I As Integer, J As Integer

Do While I <= N

      I = I + 1

      If N Mod I = 0 Then

            S = S + I

       End If

Loop

End Sub

 

[题目4] 生成一个三行八列的二维数组A(3,8)，其中前两行元素产生的方法是：
用初值X1=26及公式Xi+1=(25×Xi+357) Mod 1024，产生一个数列：X1、X2、......、X16 。
其中X1~X8作为A的第一行元素；X9~X16作为A的第二行元素；A的第三行元素值取前两行同列元素的最大公约数。最后按图示格式显示在图片框中。
[编程要求]
1． 程序参考界面如图所示，编程时不得增加或减少界面对象或改变对象的种类，窗体及界面元素大小适中，且均可见；
2． 按“生成数组”按钮，则将生成的数组显示在图片框中；按“清除”按钮，则将图片框清空；按“退出”按钮，则退出程序运行；
3． 程序中必须定义一个求两个数最大公约数的通用函数过程。

答：

源程序：

Private Sub command1_click()

Dim A(3, 8) As Integer, I As Integer, J As Integer, K As Integer

Dim arr(16) As Integer

arr(1) = 26

For K = 2 To 16

  arr(K) = (arr(K - 1) * 25 + 357) Mod 1024

Next K

K = 1

For I = 1 To 2

    For J = 1 To 8

        A(I, J) = arr(K)

        K = K + 1

    Next J

Next I

For J = 1 To 8

  A(3, J) = fun(A(1, J), A(2, J))

 Next J

For I = 1 To 3

   For J = 1 To 8

     Picture1.Print Format(A(I, J), "#####") & " ";

  Next J

  Picture1.Print

Next I

End Sub

 

Private Function fun(ByVal s1 As Integer, ByVal s2 As Integer)

 Dim N As Integer

 Do

   N = s1 Mod s2

   s1 = s2

   s2 = N

Loop Until N = 0

fun = s1

End Function

 

Private Sub Command2_Click()

Picture1.Cls

End Sub

 

Private Sub Command3_Click()

End

End Sub

 

[题目5] 下面程序功能是将一个字符串中的相同字符调整到一块，得到一个新的字符串。

答：

源程序：

Option Explicit

Private Sub Command1_Click()

Dim S As String

   S = Text1.Text

   Call sub1(S)

   Text2.Text = S

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) - 1

        AL = Mid(St, I, 1)

        For P = I + 1 To Len(St)

              If AL = Mid(St, P, 1) Then

                  For K = P To I + 2 Step -1

                        Mid(St, K, 1) = Mid(St, K - 1, 1)

                   Next K

                   Mid(St, I + 1, 1) = AL

                   Exit For

               End If

           Next P

    Next I

End Sub

 

[题目6]把文本框输入的字符串按降序添加到列表框中。
[编程要求]
1． 程序参考界面如图1所示，编程时不得增加或减少界面对象或改变对象的种类，窗体及界面元素大小适中，且均可见；
2． 在文本框Text1中输入字符串，单击“添加”按钮，如果该字符串在列表框中不存在，就将该字符串按降序插入到列表框中，否则就用MsgBox语句（或函数）给出提示信息（见图2），且该字符串不添加到列表框中。
3． 单击“清除”按钮，则清空文本框列表框；单击“退出”按钮，则退出程序运行；
4． 程序中必须包含一个通用字过程，其功能是将字符串按降序插入到列表框中。

答：

源程序：

Private Sub Command1_Click()

If Trim(Text1.Text) = "" Then

  MsgBox "请输入要添加的字符串", vbOKOnly

  Text1.SetFocus

  Exit Sub

End If

If pd(Trim(Text1.Text)) = True Then

    Call px(Trim(Text1.Text))

Else

    MsgBox "该字符串已经存在，请重新输入！", vbOKOnly

    Text1.Text = ""

    Text1.SetFocus

End If

    Text1.Text = ""

    Text1.SetFocus

End Sub

 

Private Function pd(S As String) As Boolean

Dim I As Integer

For I = 0 To List1.ListCount

    If List1.List(I) = S Then

        pd = False

        Exit Function

    Else

        pd = True

    End If

Next I

End Function

 

Private Sub px(S As String)

Dim I As Integer, tem As String, K As Integer

For I = 0 To List1.ListCount

    If S > List1.List(I) Then

        Exit For

    End If

Next I

For j = List1.ListCount To I + 1 Step -1

     List1.List(j) = List1.List(j - 1)

Next j

List1.List(j) = S

End Sub

 

 

Private Sub Command2_Click()

Text1.Text = ""

List1.Clear

Text1.SetFocus

End Sub

 

Private Sub Command3_Click()

End

End Sub

 

Private Sub Form_Activate()

Text1.SetFocus

End Sub

 

[题目7] 下面程序的功能是从菲波那契数列中找出长度为两位和三位的非素数元素。
注：菲波那契数列即：

答：

源程序：

Option Explicit

Private Function fib(n As Integer) As Long

If n = 1 Or n = 2 Then

     fib = 1

Else

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

End If

End Function

 

Private Function Prime(n As Integer) As Boolean

Dim k As Integer

Prime = False

For k = 2 To Sqr(n)

     If n Mod k = 0 Then Exit Function

Next k

Prime = True

End Function

 

Private Sub Command1_Click()

Dim temp As String, k As Integer, p As Long

k = 1: p = Trim(fib(k))

Do Until Len(temp) > 4

     temp = CStr(p)

     If Len(temp) = 3 Or Len(temp) = 2 Then

          List1.AddItem p

     End If

     k = k + 1

     p = fib(k)

Loop

temp = ""

For k = 0 To List1.ListCount - 1

     If Not Prime(List1.List(k)) Then

           temp = temp & List1.List(k) & Chr(13) & Chr(10)

      End If

Next k

Text1 = temp

End Sub

 

[题目8] 随机生成所有数组元素都是两位数的3×3的二维数组，找出其中不同行、不同列的三个数组元素的乘积最大的一组，并且这三个元素按下面的形式显示在图片框中。
[编程要求]
1． 程序参考界面如图所示，编程时不得增加或减少界面对象或改变对象的种类，窗体及界面元素大小适中，且均可见；
2． 按“计算”按钮，则开始运行程序，依照题目要求将随机生成的数组显示在图片框中，同时必须使用循环结构找出结果，并按图示格式显示在文本框中；按“结束”按钮，则结束程序运行；
3． 程序中要有一个通用过程，其功能是找出符合条件的三个数组元素。
答：

源程序：

Private Sub Command1_Click()

Dim a(3, 3) As Integer

Dim i As Integer, j As Integer, sum As Long

Randomize

For i = 0 To 2

    For j = 0 To 2

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

        Picture1.Print a(i, j) & "  ";

    Next j

    Picture1.Print

Next i

Call find(a, sum)

End Sub

 

Private Sub find(a() As Integer, s As Long)

Dim i As Integer, j As Integer, tem As Long, t As Integer, k As Integer, flg As Integer

s = 0

For j = 0 To 2

   For i = 0 To j

      tem = a(i, j) * a((i + 1) Mod 3, (j + 1) Mod 3)

      tem = tem * a((i + 2) Mod 3, (j + 2) Mod 3)

      If tem > s Then s = tem: k = i: t = j: flg = 1

      tem = a(i, j) * a((i + 1) Mod 3, (j + 2) Mod 3)

      tem = tem * a((i + 2) Mod 3, (j + 4) Mod 3)

      If tem > s Then s = tem: k = i: t = j: flg = 2

    Next i

Next j

If flg = 1 Then

Text1.Text = "a(" & k + 1 & "," & t + 1 & ")*a(" & (k + 1) Mod 3 + 1 & "," & (t + 1) Mod 3 + 1 & ")*a(" & (k + 2) Mod 3 + 1 & "," & (t + 2) Mod 3 + 1 & ")=" & s

Else

Text1.Text = "a(" & k + 1 & "," & t + 1 & ")*a(" & (k + 2) Mod 3 + 1 & "," & (t + 1) Mod 3 + 1 & ")*a(" & (k + 4) Mod 3 + 1 & "," & (t + 2) Mod 3 + 1 & ")=" & s

End If

End Sub

 

Private Sub Command2_Click()

End

End Sub

[题目9] 本程序的功能是；单击“数组生成”按钮，则利用随机函数生成一个元素均为两位正整数的5×5的二维数组，并且在图片框1中；单击“处理”按钮，则调整数组各行的顺序。使数组中的最小元素所在行为第一行，剩下的四行中的最小元素所在行为第二行，依次类推，直至最末行，最后显示在图片框2中。

答：

源程序：

Dim A(1 To 5, 1 To 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(Rnd * 90) + 10

           Picture1.Print A(I, J);

      Next J

      Picture1.Print

Next I

End Sub

 

Private Sub command2_click()

Dim I As Integer, J As Integer, k As Integer

Dim Min As Integer, Imin As Integer, T As Integer

For k = 1 To 5

       Min = A(k, 1): Imin = k

       For I = k To 5

             For J = 1 To 5

                 If A(I, J) < Min Then Min = A(I, J): Imin = I

             Next J

       Next I

     If Imin <> k Then

          For J = 1 To 5

               Call Swap(A(Imin, J), A(k, J))

          Next J

     End If

Next k

For I = 1 To 5

       For J = 1 To 5

            Picture2.Print A(I, J);

       Next J

       Picture2.Print

Next I

End Sub

 

Public Sub Swap(X As Integer, Y As Integer)

Dim T As Integer

T = X: X = Y: Y = T

End Sub

 

[题目10] 设n是一个正整数，d是它的因子，若d和n/d互质（即d和n/d的最大公约数是1），则称d为n的酉因子。如果n等于它的酉因子和（不包括n自身），则称n为酉完全数。编程找出200以内的酉完全数。
[编程要求]
1． 程序参考界面如图所示，编程时不得增加或减少界面对象或改变对象的种类，窗体及界面元素大小适中，且均可见；
2． 单击“生成酉完全数”按钮，则找出酉完全数，并将找到的酉完全数及其酉因子按图示的格式显示在图片框中；
3． 按“清除”按钮，则将图片框清空；按“退出”按钮，则退出程序执行；
4． 程序中至少要有一个通用过程。

答：

源程序：

Private Sub Command1_Click()

Dim I As Integer, A() As Integer, k As Integer, sum As String, s As Integer

For I = 2 To 200

   sum = ""

   s = 0

   Call yin(I, A)

   For k = 1 To UBound(A)

       s = s + A(k)

   Next k

   If I = s Then

      sum = I & "="

      For k = 1 To UBound(A) - 1

           sum = sum & A(k) & "+"

      Next k

      sum = sum & A(UBound(A))

      Picture1.Print sum

    End If

Next I

End Sub

 

Private Function yin(X As Integer, A() As Integer)

Dim idx As Integer

Dim I As Integer

For I = 1 To X - 1

  If X Mod I = 0 And gcd(I, X / I) = 1 Then

     idx = idx + 1

     ReDim Preserve A(idx)

     A(idx) = I

  End If

Next I

End Function

 

Private Function gcd(ByVal n As Integer, ByVal m As Integer)

Dim k As Integer

Do

    k = n Mod m

    n = m

    m = k

Loop Until k = 0

gcd = n

End Function

 

Private Sub command2_click()

Picture1.Cls

End Sub

 

Private Sub Command3_Click()

End

End Sub