【题目1】 字符串“642138579”首尾相联形成一个数字环，依次顺序在数字环中截取2位数、3位数、4位数，使所截取得前两个数相乘等于第三个数。例如42*138=5796。

答：

源程序：

Option Explicit

Dim A(9) As Integer

Private Sub Form_Click()

    Const S As String = "642138579"

    Dim I As Integer, N3 As Long

    Dim Idx As Integer, N1 As Long, N2 As Long

    For I = 1 To 9

        A(I) = Val(Mid(S, I, 1))

    Next I

    For I = 1 To 9

        Idx = I

       Call Mut(Idx, 2, N1)

       Call Mut(Idx + 2, 3, N2)

       Call Mut(Idx + 5, 4, N3)

        If N3 = N1 * N2 Then

            Print N1; "*"; N2; "="; N3

        End If

    Next I

End Sub

 

Private Sub Mut(ByVal Idx As Integer, N As Integer, M As Long)

   Dim I As Integer

   M = 0

   For I = 1 To N

        If Idx > 9 Then Idx = 1

        M = M * 10 + A(Idx)

        Idx = Idx + 1

   Next I

End Sub

 

【题目2】 编写一个高速公路收费程序。已知收费标准如下：

车型	小轿车	客车	货车
收费标准（元/公里）	1.2	1．5	1.8
收费办法	行车里程<=150时, 应付费= 15* 收费标准 行车里程<=300时, 应付费= 30* 收费标准 行车里程<=450时, 应付费= 45* 收费标准 行车里程>450时, 应付费= 60* 收费标准

[编程要求]  

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

2．按“计算”按钮，则运行程序；按“清除”按钮，则将文本框 Text1  和 Text2  清空，并将焦点设置在 Text1 上；按“结束”按钮，则停止程序运行；

3．由于行车里程必须大于 0 ，若在 Text1 中输入的值小于等于0，程序中要给出提示信息及相应处理；

4．程序中至少要包含一个函数过程。

答：

源程序：

Dim cx As Single

Private Sub Command1_Click()

Text2.Text = fun(Val(Trim(Text1.Text)), cx)

End Sub

Private Function fun(ByVal lc As Single, lb As Single) As Single

Select Case lc

  Case Is <= 150

    fun = 15 * lb

  Case Is <= 300

    fun = 30 * lb

  Case Is <= 450

    fun = 45 * lb

  Case Else

    fun = 60 * lb

End Select

 

End Function

Private Sub Command2_Click()

Text1.Text = ""

Text2.Text = ""

Text1.SetFocus

End Sub

 

Private Sub Command3_Click()

End

End Sub

 

Private Sub Option1_Click()

If Option1.Value = True Then cx = 1.2

End Sub

 

Private Sub Option2_Click()

If Option2.Value = True Then cx = 1.5

End Sub

 

Private Sub Option3_Click()

If Option3.Value = True Then cx = 1.8

End Sub

 

Private Sub Text1_Change()

If Val(Trim(Text1.Text)) <= 0 Then

   MsgBox "行车里程小于或等于零，请重新输入数据", vbOKOnly

   Text1.Text = ""

   Text1.SetFocus

   Exit Sub

End If

End Sub

 

[ 题目3] 本程序的功能是,从键盘输入的一个数字串中依次由第1个数字、第2个数字、第3个数字.....开始向后截取1位数、2位数.....，找出其中的素数。例如：输入236759，可截取得到素数：2，23，3，367，67，7，5，59。

答：

源程序：

Option Explicit

Private Function sushu(M As Long) As Boolean

  Dim i As Long

  For i = 2 To Int(Sqr(M))

      If M Mod i = 0 Then Exit Function

  Next i

  sushu = True

End Function

Private Sub Form_Click()

  Dim St As String, C As String

  Dim Num As Long, A() As Long

  Dim i As Integer, J As Integer, K As Integer

  St = InputBox("请输入任一数字串:", "查找素数")

  C = ""

   i = 1: K = 1

  Do While i <= Len(St)

     C = C + Mid(St, K, 1)

   ' Print C;

     Num = Val(C)

     If K <= Len(St) Then

        If sushu(Num) Then

           J = J + 1

           ReDim Preserve A(J)

           A(J) = Num

        End If

      K = K + 1

      Else

        C = ""

       

        i = i + 1

        K = i

     End If

  Loop

 Print St

 For i = 1 To J

  Print A(i)

 Next i

 End Sub

 

[题目4] 在列表框中显示自变量 x  从 0.1~0.7  的 ArcSh(x)  函数值（提示：循环终值为 0.7001 ）， ArcSh(x)   函数的计算公式为：

arcsh(x)=    +…

[编程要求：]

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

2．按“计算”按钮，则开始运行程序，按图示格式显示于列表框中；按“清除”按钮，则将列表框清空，按“结束”按钮，结束程序运行；

3．程序至少要有一个函数过程；

4． 当数列某一项值的绝对值小于 0.000001 时就不再累加。

答：

源程序：

Private Sub Command1_Click()

Dim i As Single, n As Integer

Dim sum As Single, s1 As Single

For i = 0.1 To 0.7001 Step 0.1

    sum = i

    s1 = 0

    n = 1

    Do

      s1 = fun(i, n)

      sum = sum + (-1) ^ n * s1

      n = n + 1

    Loop Until s1 < 0.000001

    List1.AddItem i & ":" & sum

Next i

 

End Sub

Private Function fun(x As Single, n As Integer) As Single

Dim p As Single, i As Integer

p = 1

For i = 1 To n

    p = p * (2 * i - 1) / (2 * i)

Next i

fun = p * x ^ (2 * n + 1) / (2 * n + 1)

End Function

Private Sub Command2_Click()

List1.Clear

End Sub

 

Private Sub Command3_Click()

End

End Sub

 

[题目5]下面程序的功能是找出1000以内这样的正整数N：它的不同值的因子（包括1和N在内）之和是一个素数，例如16，1+2+4+8+16=31。

答：

源程序：

Option Explicit

Option Base 1

Private Sub Command1_Click()

   Dim i As Integer, k As Integer, Sum As Integer

   For i = 2 To 1000

        Sum = 0

        Call Fctor(i, Sum)

         If Prime(Sum) Then

           k = k + 1

           Text1.Text = Text1.Text & Str(i) & " "

           If k Mod 5 = 0 Then Text1 = Text1 & Chr(13) & Chr(10)

        End If

    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

Private Function Prime(n As Integer) As Boolean

    Dim M As Integer

    For M = 2 To Sqr(n)

        If n Mod M = 0 Then Exit Function    

    Next M

    Prime = True

End Function

 

Private Sub Command2_Click()

Text1.Text = ""

End Sub

 

Private Sub Command3_Click()

End

End Sub

 

[题目6] 编写模拟翻硬币的程序。设硬币画面为 1，字面为 0。10个硬币画面向上围成一圈，按顺时针方向数硬币，凡数到可被3或被7整除的数时，将该硬币翻转。从1数到指定的次数，显示这些硬币的状态。

[编程要求]

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

2．按“翻转硬币”按钮，则将初值显示在“初始状态”文本框中，并按题目要求进行硬币翻转处理，从1数到输入到“次数”文本框中的数字，再将结果显示在“当前状态”文本框中（如图所示）；

3．按“清除”按钮，则将三个文本框清空，并将焦点设在“次数”文本框上；按“结束”按钮，则结束程序运行；

4．程序中至少要包含一个通用过程。

答：

源程序：

Dim a(1 To 10) As Integer, idx As Integer

Private Sub Command1_Click()

Dim i As Integer, n As Integer, k As Integer, t As Integer

Text3.Text = ""

Text1.Text = ""

If Val(Trim(Text2.Text)) = 0 Then

   MsgBox "请输入翻转次数", vbOKOnly

   Text2.SetFocus

   Exit Sub

Else

   n = Val(Trim(Text2.Text))

End If

For i = 1 To 10

  Text1.Text = Text1.Text & a(i) & "  "

Next i

k = 0

Do While k < n - 1

         k = k + 1

         If k Mod 3 = 0 Or k Mod 7 = 0 Then

            If k + idx > 10 And (k + idx) Mod 10 <> 0 Then

            t = (k + idx) Mod 10

            ElseIf k + idx > 10 And (k + idx) Mod 10 = 0 Then

            t = 10

            Else

            t = k + idx

            End If

          If a(t) = 1 Then

              a(t) = 0

          Else

              a(t) = 1

          End If

         End If

 Loop

 k = k + 1

  If k + idx > 10 And (k + idx) Mod 10 <> 0 Then

      k = (k + idx) Mod 10

  ElseIf k + idx > 10 And (k + idx) Mod 10 = 0 Then

      k = 10

    Else

     k = k + idx

  End If

   If a(k) = 1 Then

          a(k) = 0

   Else

          a(k) = 1

   End If

idx = k

For i = 1 To 10

  Text3.Text = Text3.Text & a(i) & "  "

Next i

End Sub

 

Private Sub Command2_Click()

Dim i As Integer

For i = 1 To 10

 a(i) = 1

Next i

Text2.SetFocus

idx = 0

Text1.Text = ""

Text2.Text = ""

Text3.Text = ""

Text2.SetFocus

End Sub

 

Private Sub Command3_Click()

End

End Sub

 

Private Sub Form_Activate()

Dim i As Integer

For i = 1 To 10

 a(i) = 1

Next i

Text2.SetFocus

idx = 0

End Sub