【题目1】本程序的功能是：找出2~10000之间可以表示成2²-1形式的素数.本题程序界面见图1.

答：

源程序：

Option Explicit

Private Sub Command1_Click()

Dim Exp As Integer, Idx As Integer

For Idx = 2 To 10000

    If Mersenne(Idx, Exp) Then

        If Prime(Idx) Then

            List1.AddItem Idx & " =" & 2 & "^" & Exp & "-1"

        End If

     

    End If

  Exp = 0

Next Idx

End Sub

Private Function Mersenne(N As Integer, Exp As Integer) As Boolean

   Dim M   As Integer, Ex As Long

   M = N

   Ex = 1

   Do While M > Ex

        Exp = Exp + 1

        Ex = Ex * 2

   Loop

   If M = Ex - 1 Then

       Mersenne = True

   End If

End Function

Private Function Prime(N As Integer) As Boolean

   Dim K As Integer

   For K = 2 To Sqr(N)

      If N Mod K = 0 Then Exit Function

   Next K

Prime = True

End Function

 

【题目2】将1～9这9个数字顺序排列围成一圈,从中任意一个数字开始,依次将其分成三段,每段数字连在一起算一个数,得到一个2位数、一个3位数和一个4位数,将这三个数相加,使其和数能被77整除.编写一个能找出这三个数的程序.

【编程要求】

1.程序参考界面如图2所示,编程时不得增加或减少界面对象或改变对象的种类,窗体及界面元素大小适中,且均可见;

2.单击“运行”按钮,找出符合条件的三个数,并将它们显示在文本框中;

3.单击“清理”按钮,则将文本框清空,并将焦点设置在“运行”按钮上;单击“结束”按钮,结束程序运行;

4.程序中必须包含一个将数字分段,得到一个2位数、一个3位数和一个4位数的通用过程.

答：

源程序：

Private Sub Command1_Click()

Dim s As String, i As Integer, sum As Integer, s1 As Integer, s2 As Integer, s3 As Integer

s = "123456789"

For i = 1 To Len(s)

    Call part(s, i, s1, s2, s3)

    If (s1 + s2 + s3) Mod 77 = 0 Then

        Text1.Text = Text1.Text & "( " & s1 & " + " & s2 & " + " & s3 & " ) mod " & 77 & "=0" & vbCrLf

    End If

Next i

End Sub

 

Private Sub part(ByVal s As String, i As Integer, s1, s2, s3)

s = s & s

s1 = Int(Mid(s, i, 2))

s2 = Int(Mid(s, i + 2, 3))

s3 = Int(Mid(s, i + 5, 4))

End Sub

 

Private Sub Command2_Click()

End

End Sub

 

[题目3]下面程序的功能是将给定的十六进制整数转换成二进制整数（删除高位0）。

答：

源程序：

Option Explicit

Private Sub Command1_Click()

Dim H As String, Bin As String, L As Integer, I As Integer

Dim K As Integer, S As String * 1

H = UCase(Trim(Text1))

L = Len(H)

For I = 1 To L

   S = Mid(H, I, 1)

If S <= "9" And S >= "0" Then

   K = Val(S)

Else

   K = Asc(S) - 55

End If

If K < 0 Or K > 15 Then

Bin = "十六进制数据错误"

End If

Call Trans(Bin, K)

Next I

Bin = Right(Bin, Len(Bin) - InStr(Bin, "1") + 1)

Text2 = Bin

End Sub

Private Sub Trans(Bin As String, K As Integer)

Dim S As String, I As Integer, N As Integer

Do While K > 0

S = K Mod 2 & S

K = K \ 2

Loop

S = "0000" & S

Bin = Bin & Right(S, 4)

End Sub

 

[题目4]编写程序，找出由1，2，3，4四个不同数字组成的4位整数中的素数。

[编程要求]

1程序参考界面如图2所示，编程时不得增加或减少界面对象或改变对象的种类，窗体及界面元素大小适中，且均可见；

2单击“开始”按钮，生成（或筛选出）由1，2，3，4四个数字组成的4位整数，并显示在列表框List1中，在列表框List2中显示其中的素数；

3单击“清理”按钮，则将两个列表框清空；单击“退出”按钮，结束程序运行；

4程序中必须包含一个判断某数是否为素数的通用过程。

答：

源程序：

Private Sub Command1_Click()

Dim i As Integer, j As Integer, k As Integer, t As Integer, s As String

For i = 1 To 4

    For j = 1 To 4

        For k = 1 To 4

            For t = 1 To 4

                If i <> j And i <> k And i <> t And j <> k And j <> t And k <> t Then

                    s = i & j & k & t

                    List1.AddItem s

                    If prime(Int(s)) Then List2.AddItem s

                End If

            Next t

        Next k

    Next j

Next i

End Sub

Private Function prime(ByVal x As Integer) As Boolean

Dim i As Integer

prime = True

For i = 2 To Sqr(x)

    If x Mod i = 0 Then prime = False: Exit Function

Next i

End Function

Private Sub Command2_Click()

List1.Clear

List2.Clear

End Sub

 

Private Sub Command3_Click()

End

End Sub

 

[题目5]下面程序的功能是：从由2，4，5，7四个数字组成的没有重复数字的24个四位数中，找出一个具有倍数关系的四位数对。本题程序界面如图1。

答：

源程序：

Option Explicit

Private Sub Compare(A() As Integer, S As String, Idx As Integer)

Dim I As Integer, J As Integer

For I = 1 To Idx

    For J = 1 To Idx

        If A(I) Mod A(J) = 0 And J <> I Then

             S = A(I) & "是" & A(J) & "的" & A(I) \ A(J) & "倍" & vbCrLf

             Text1 = S

             Exit Sub

        End If

    Next J

Next I

 

End Sub

Private Sub Command1_Click()

Dim N(100) As Integer, I As Integer, S As String, Idx As Integer

Dim J As Integer, Ch As String * 1, K As Integer

For I = 2457 To 7542

   S = CStr(I)

   For J = 1 To 4

     Ch = Mid(S, J, 1)

     If Ch <> "2" And Ch <> "4" And Ch <> "5" And Ch <> "7" Then Exit For

     K = J

     Do

         K = K + 1

         If Ch = Mid(S, K, 1) Then Exit For

     Loop Until K > 4

    Next J

    If J > 4 Then

        Idx = Idx + 1

         N(Idx) = I

         List1.AddItem I

    End If

Next I

  Call Compare(N, S, Idx)

  End Sub

 

[题目6]编写程序：生成两个等差数列A={3，10，17，24，31，……，108}与B={3，8，13，18，23，……，108}，再找出两个数列中的相同项。

[编程要求]

1. 程序参考界面如图2所示，编程时不得增加或减少界面对象或改变对象的种类，窗体及界面元素大小适中，且均可见；

2. 单击“运行”按钮，生成这两个数列，分别输出到多行文本框1与多行文本框2中，找出两个数列中的相同项，并输出到文本框3中；

3. 单击“清除”按钮，则将文本框清空，并将焦点置于“运行”按钮上；单击“结束”按钮，结束程序运行；
4.       程序中必须包含一个生成等差数列的通用过程。

答：

源程序：

Option Base 1

Private Sub Command1_Click()

Dim d1() As Integer, d2() As Integer, n1 As Integer, n2 As Integer, i As Integer, j As Integer

Call scdcsl(d1, 3, 7, 108, n1)

Call scdcsl(d2, 3, 5, 108, n2)

For i = 1 To n1

    Text1 = Text1 & d1(i) & " "

Next i

For i = 1 To n2

    Text2 = Text2 & d2(i) & " "

Next i

i = 1

j = 1

Do

    If d1(i) = d2(j) Then

        Text3 = Text3 & d1(i) & " "

        i = i + 1

        j = j + 1

    ElseIf d1(i) > d2(j) Then

        j = j + 1

    Else

        i = i + 1

    End If

Loop Until (i > n1)

End Sub

 

Private Sub scdcsl(a() As Integer, x As Integer, d, y , n)

Do

    n = n + 1

    ReDim Preserve a(n)

    a(n) = x

    x = x + d

Loop While (x <= y)

End Sub

 

Private Sub Command2_Click()

Text1.Text = ""

Text2.Text = ""

Text3.Text = ""

Command1.SetFocus

End Sub

 

Private Sub Command3_Click()

End

End Sub

 

[题目7]下面程序的功能是，找出1~300之间的三个相临整数N ，N+1和N+2，且每个整数均为两个素数的乘积。本题程序界面如图1。

答：

源程序：

Option Explicit

Private Sub Command1_Click()

Dim p() As Integer, i As Integer, N(3) As Integer

Call Prime(p, 150)

For i = 1 To 300

  If Compare(p, i) Then

  List1.AddItem i & "," & i + 1 & "," & i + 2

End If

Next i

End Sub

 

Private Sub Prime(p() As Integer, N As Integer)

Dim i As Integer, k As Integer, idx As Integer

For i = 2 To N

    For k = 2 To Sqr(i)

        If i Mod k = 0 Then Exit For

    Next k

  If k > Sqr(i) Then

  idx = idx + 1

  ReDim Preserve p(idx)

  p(idx) = i

 End If

Next i

End Sub

 

Private Function Compare(p() As Integer, ByVal a As Integer) As Boolean

Dim i As Integer, J As Integer, k As Integer, Flg As Boolean

For k = 1 To 3

    i = 1

    Do While i <= UBound(p)

        For J = 1 To UBound(p)

            If a = p(i) * p(J) Then Exit Do

        Next J

        i = i + 1

    Loop

    If J > UBound(p) Then Exit Function

    a = a + 1

Next k

Compare = True

End Function

 

[题目8]编写程序求给定正整数的所有因子及所有因子的倒数之和。

[编程要求]

1．程序参考界面如图2所示，编程时不得增加或减少界面对象或改变对象的种类，窗体及界面元素大小适中，且均可见；

2．运行程序，在文本框1中输入测试数据，单击“运行”按纽，求出其所有因子及所有因子的倒数和，按图示格式输出到多行文本框2中（结果要进行约分）；

3．单击“清除”按纽，则将两个文本框清空，焦点置于文本框1上；

4．程序中必须包含一个求其正整数所有因子倒数之和的通用过程。

答：

源程序：

Private Sub Command1_Click()

Dim x As Long

x = Int(Trim(Text1.Text))

Text2.Text = x & "的所有因子为："

Call yzsum(x)

End Sub

 

Private Sub yzsum(ByVal x As Long)

Dim a() As Integer, idx As Integer, fz As Long, s1 As Long, fm As Long, s2 As Long

Dim i As Integer

For i = 1 To x

    If x Mod i = 0 Then

        idx = idx + 1

        ReDim Preserve a(idx)

        a(idx) = i

        Text2 = Text2 & i & " "

        If fm = 0 Then

            fm = fm + i

            fz = 1

        Else

            s1 = gcd(fm, i)

            s2 = fm * i / s1

            fz = fz * s2 / fm + s2 / i

            fm = s2

        End If

    End If

Next i

s1 = gcd(fm, fz)

fz = fz / s1

fm = fm / s1

If fm = 1 Then

    Text2 = Text2 & vbCrLf & "所求因子倒数之和为： " & fz

Else

    Text2 = Text2 & vbCrLf & "所求因子倒数之和为： " & fz & "/" & fm

End If

End Sub

 

Private Function gcd(ByVal x As Long, ByVal y As Long) As Long

Dim r As Long

Do

    r = x Mod y

    x = y

    y = r

Loop Until (y = 0)

gcd = x

End Function

 

Private Sub Command2_Click()

Text1.Text = ""

Text2.Text = ""

Text1.SetFocus

End Sub