【题目1】下面程序功能是：找出100以内满足N+1个连续自然数之和等于其后N个连续自然数之和的序列（例如：4+5+6=7+8就是满足要求的序列）。

答：

源程序：

Option Explicit

Private Sub Command1_Click()

    Dim I As Integer, S As String, Flg As Boolean

    For I = 2 To 10

     Flg = False

    Call Sub1(I, S, Flg)

        If Flg Then

           Text1 = Text1 & S & vbCrLf

        End If

     Next I

End Sub

 

Private Sub Sub1(K As Integer, S As String, F As Boolean)

    Dim I As Integer, Sum1 As Integer, Sum2 As Integer

   Dim N As Integer, Start As Integer

   Do

        Start = Start + 1

        N = Start

        S = N: Sum1 = N

        For I = 1 To K - 1

             N = N + 1

            Sum1 = Sum1 + N

            S = S & "+" & N

        Next I

        N = N + 1

        S = S & "=" & N

        Sum2 = N

        For I = 1 To K - 2

            N = N + 1

            Sum2 = Sum2 + N

            S = S & "+" & N

        Next I

        If Sum1 = Sum2 Then

            F = True

        End If

         N = N + 1

  Loop While Sum1 <> Sum2 And N < 100

End Sub

 

【题目2】本程序的功能是：按设定的数据位数N（N=2、3、3、4、5、6），随机生成20个互不相等正整数，按5个一行的形式输出到 文本框中，并从中找出所有降序数输出到列表框。所谓降序数是指所有高位数字都大于其低位数字的数。例如973就是一个降序数。

【编程要求】

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

2. 在文本框1中输入N值，按“执行”按钮，则开始计算并在文本框2中显示生成的随机数，在列表框中输出其中的降序数；按“清

除”按钮，则将2个文本框及列表框清空，焦点置于文本框1上；按“退出”按钮，结束程序运行；

3. 程序中应定义一个用于判断一个N位数是否是降数的通用过程。

答：

源程序：

Private Sub Command1_Click()

Dim N As Integer, a(1 To 20) As Long, I As Integer, t1 As Long

dim t2 As Long, j As Integer, tem As Long

Randomize

N = Val(Text1.Text)

If N < 2 Or N > 6 Then

    MsgBox "请重新输入位数"

    Text1.Text = ""

    Text1.SetFocus

    Exit Sub

End If

t1 = 10 ^ N

t2 = 10 ^ (N - 1)

For I = 1 To 20

    tem = Int(Rnd * (t1 - t2)) + t2

    For j = 1 To I - 1

        If a(j) = tem Then

            I = I - 1

            Exit For

        End If

    Next j

    If j = I Then a(I) = tem

Next I

j = 0

For I = 1 To 20

    Text2.Text = Text2.Text & a(I) & "  "

    j = j + 1

    If j Mod 5 = 0 Then Text2.Text = Text2.Text & vbCrLf

    If jxs(a(I)) Then List1.AddItem a(I)

Next I

End Sub

 

Private Function jxs(x As Long) As Boolean

Dim S As String, I As Integer

S = CStr(x)

For I = 1 To Len(S) - 1

    If Mid(S, I, 1) <= Mid(S, I + 1, 1) Then

        jxs = False

        Exit Function

    End If

Next I

jxs = True       

End Function

Private Sub Command2_Click()

Text1.Text = ""

Text2.Text = ""

List1.Clear

Text1.SetFocus

End Sub

 

Private Sub Command3_Click()

End

End Sub

 

【题目3】本程序的功能是对字符串加密。密钥为一数字串，每个数字表示将首字符右移的位置，例如，若明文字符串为help me，密钥中第一个数字4表示将首字符h移到位置4，得到新字符串elph me，再取密钥的下一个数字符串进行上述操作，直到最后一个密钥数字处理完就得到密文。若移位超出原文长度，则自动回转（按原文长度取模）。

答：

源程序：

Option Explicit

Private Sub Command1_Click()

    Dim s1 As String, s2 As String, i As Integer, key As Integer

    s1 = Text1

    s2 = Text2

    For i = 1 To Len(s2)

        key = Val(Mid(s2, i, 1))

        Call encode(s1, key)

    Next i

    Text3 = s1

End Sub

 

Private Sub encode(s As String, k As Integer)

    Dim i As Integer, t As String * 1, n As Integer

    t = Mid(s, 1, 1)

    n = k Mod Len(s)

    If n = 0 Then

       n = k

    End If

    For i = 2 To n

        Mid(s, i - 1, 1) = Mid(s, i, 1)

    Next i

    Mid(s, i - 1, 1) = t

End Sub

 

【题目4】本程序的功能是：首先按给定格式（数据以逗号分隔，-1表示数据结束）将输入到文本框1中的数据依次存入一个数组，然后为该组数据建立一个按从大到小次序的索引表并显示在文本框2中。如下土，文本框2中的第一个数据4表示文本框1中4个数最大；

文本框2中的最后一个数据8表示文本框1中第8个数最小。

【编程要求】

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

2. 在文本框1中输入测试数据，按“处理”按钮，则按题目要求得到结果并显示在文本框2中；按“清除”按钮，则将2个文本框清空，将焦点置于文本框1上；按“退出”按钮，结束程序运行；

3. 程序中应定义一个根据数组元素的大小从大到小取其排列号的通用过程。

答：

源程序：

Private Sub Command1_Click()

     Dim p() As Integer, k As Integer, d() As Integer

     Dim i As Integer, st As String

     st = Text1

     If Right(st, 2) <> "-1" Then

        MsgBox "您没有输入-1表示数据结束！"

        Text1.SetFocus

        Exit Sub

     End If

     Call lnum(st, p)

     Call ind(p, d)

     st = ""

     For i = 1 To UBound(d)

          st = st & Str(d(i))

     Next i

     Text2 = st

End Sub

 

Private Sub lnum(st As String, p() As Integer)

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

     Do

         n = InStr(st, ",")

         If t <> -1 And n <> 0 Then

               t = Val(Left(st, n - 1))

               k = k + 1

               ReDim Preserve p(k)

               p(k) = t

               st = Right(st, Len(st) - n)

         Else

               Exit Do

         End If

      Loop

End Sub

 

Private Sub Command3_Click()

End

End Sub

 

Private Sub command2_Click()

     Text1 = " ": Text2 = " "

     Text1.SetFocus

End Sub

 

Private Sub ind(p() As Integer, d() As Integer)

      Dim t As Integer, i As Integer, j As Integer, maxv As Integer

      ReDim d(UBound(p))

      For i = 1 To UBound(p)

           d(i) = i

      Next i

      For i = 1 To UBound(p) - 1

           For j = i + 1 To UBound(p)

                If p(i) < p(j) Then

                     t = p(i): p(i) = p(j): p(j) = t

                     t = d(i): d(i) = d(j): d(j) = t

                End If

           Next j

      Next i

End Sub

 

【题目5】下面程序功能是：求出（K+1）个连续数的平方数，其和等于其后的K个连续数的平方数之和。

答：

源程序：

Option Explicit

Private Sub Command1_Click()

    Dim i As Integer, K As Integer

    Dim Flg As Boolean, s As String

    Do

        K = K + 1

        For i = 3 To 100

 Flg = False

            s = i & "^2"

            Call Sub1((i), K, s, Flg)

            If Flg Then

                Text1 = Text1 & s & vbCrLf

            End If

        Next i

    Loop While K < 6

End Sub

 

Private Sub Sub1(N As Integer, K As Integer, s As String, F As Boolean)

    Dim J As Integer, Sum1 As Long, Sum2 As Long, A As Integer

       Sum1 = N ^ 2

       For J = 1 To K

           N = N + 1

           Sum1 = Sum1 + N ^ 2

           s = s & "+" & N & "^2"

       Next J

       N = N + 1

       s = s & "=" & N & "^2"

       Sum2 = N ^ 2

       For A = 1 To K - 1

           N = N + 1

           Sum2 = Sum2 + N ^ 2

           s = s & "+" & N & "^2"

    Next A

    If Sum1 = Sum2 Then

        F = True

    End If

End Sub

 

【题目6】在A盘根目录下建立纯英文的文本文件Data.txt。要求编程用字符串S1替换文件中所有字符子串S，字符串S不区分字母大小写，S1与S长度不一定相同。

文件Data.Txt的内容如下，其中VB、Vb，vB,vb都要求用Visual Basic替换。

This a VB book

We study vb

Vb is very useful

Hello VB

运行程序，替换后的结果见界面图。

【编程要求】

1. 按“开始”按钮，则开始运行程序，将结果按图示格式显示在文本框中；按“清除”按钮，则将文本框清空；按“结束”按钮结束程序运行；

2. 要求编写一个实现字符串替换的通用过程；

3. 不允许使用Instr函数。

答：

源程序：

Private Sub Command1_Click()

Dim S1 As String, S2 As String, i As Integer, tem As String, s As String

S1 = Trim(Text1.Text)

S2 = Trim(Text2.Text)

Open "e:\vb\上机参考答案\data.txt" For Input As #1

i = FileLen("e:\vb\上机参考答案\data.txt")

s = Input(i, 1)

Call Repace(s, S1, S2)

Text3 = s

Close #1

End Sub

 

Private Sub Repace(s, SubS1, SubS2)

 Dim N As Integer, K As Integer, S1 As String, S2 As String, S3 As String

 Dim i As Integer

 K = Len(SubS1)

 N = Len(s)

 S2 = UCase(SubS1)

 i = 1

  Do While i < N

     S1 = Mid(s, i, K)

     If UCase(S1) = S2 Then

         s = Left(s, i - 1) & SubS2 & Right(s, N - i - K + 1)

         N = N + Len(SubS2) - K

         i = Len(SubS2) + i

     Else

         i = i + 1

      End If

  Loop

End Sub

 

Private Sub Command2_Click()

Text1.Text = ""

Text2.Text = ""

Text3.Text = ""

Text1.SetFocus

End Sub

 

Private Sub Command3_Click()

End

End Sub

 

【题目7】本程序用于验证下列命题：可被37整除的三位整数，其各位数字循环移位后得到的三位数也可被37整除。例如148，481，841都是这样的数（不考虑含有数字0的三位数）。

答：

源程序：

Option Explicit

Private Sub Command1_Click()

    Dim n As Integer, p(2) As Integer, j As Integer

    Dim s As String, f As Boolean

    For n = 100 To 999

        Call pnum(n, p, f)

        If f And n Mod 37 = 0 Then

            s = CStr(n)

            For j = 1 To 2

                If p(j) Mod 37 <> 0 Then

                    MsgBox ("验证失败")

                    Exit Sub

                Else

                    s = s & Str(p(j))

                End If

             Next j

             List1.AddItem s

        End If

    Next n

End Sub

 

Private Sub pnum(ByVal n As Integer, p() As Integer, flag As Boolean)

    Dim i As Integer, k As Integer, h As Integer

    flag = False

    If InStr(CStr(n), "0") = 0 Then flag = True

    For i = 1 To 2

        k = n Mod 100

        h = n \ 100

        p(i) = CStr(k) & CStr(h)

        n = p(i)

    Next i

End Sub

 

【题目8】将若干正整数排成圆圈，依次编号（例如26为第一号）。编写程序，找出拐点元素（所谓拐点元素是指它比左右相邻元素 都大或都小），输出拐点元素的值及位置。

【编程要求】

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

2. 按“运行”按钮，则生成由15个无重复数的两位随机整数数列，显示到文本框内；求出该数列中的怪点元素，按示例格式（数据 ，位置号）显示在列表框中；按“清除”按钮，则文本框、列表框清空，将焦点置于文本框上；按“退出”按钮，结束程序运行；

3. 程序中应定义一个生成没有重复元素的的两位随机整数数组的通用过程。

答：

源程序：

Private Sub Command1_Click()

Dim a(1 To 15) As Integer

Call sub1(a)

For i = 1 To 15

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

Next i

List1.AddItem "元素 位置 "

For i = 2 To 14

    If a(i) > a(i - 1) And a(i) > a(i + 1) Then List1.AddItem a(i) & "  " & i

     If a(i) < a(i - 1) And a(i) < a(i + 1) Then List1.AddItem a(i) & "  " & i

Next i

If a(15) > a(14) And a(15) > a(1) Then List1.AddItem a(15) & "  " & 15

If a(15) < a(14) And a(15) < a(1) Then List1.AddItem a(15) & "  " & 15

If a(1) > a(2) And a(1) > a(15) Then List1.AddItem a(1) & "  " & 1

If a(1) < a(2) And a(1) < a(15) Then List1.AddItem a(1) & "  " & 1

End Sub

 

Private Sub sub1(a() As Integer)

Dim i As Integer, j As Integer, tem

For i = 1 To 15

    tem = Int(Rnd * 90) + 10

    For j = 1 To i - 1

        If a(j) = tem Then

            i = i - 1

            Exit For

        End If

    Next j

    If j = i Then a(i) = tem

Next i

End Sub

 

Private Sub Command2_Click()

Text1.Text = ""

List1.Clear

Text1.SetFocus

End Sub

 

Private Sub Command3_Click()

End

End Sub

 

【题目9】下面程序功能是：已知三角形三个顶点的坐标，通过距离公式求出三边长度，再求出三角形的面积。

答：

源程序：

Option Explicit

Private Sub Command1_Click()

    Dim xy(3, 2) As Single, I As Integer

    Dim st As String, N As Integer, n1 As Integer, s As String

    Text1 = "(28.5,36.7),(12.3,10.9),(45.5,25.4)"

    st = Text1

    Do

       I = I + 1

       N = InStr(st, ")")

       s = Mid(st, 2, N - 1)

       n1 = InStr(s, ",")

       xy(I, 1) = Left(s, n1 - 1)

       xy(I, 2) = Mid(s, n1 + 1, N - n1 - 2)

       If N < Len(st) Then

           st = Right(st, Len(st) - N - 1)

       Else

           Exit Do

       End If

    Loop

    Text2 = area(xy)

End Sub

 

Private Function area(xy() As Single) As Single

    Dim d(3) As Single, I As Integer, J As Integer, K As Integer, s As Single

    For I = 1 To UBound(xy, 1) - 1

        For J = I + 1 To UBound(xy, 1)

            K = K + 1

            d(K) = Sqr((xy(I, 1) - xy(J, 1)) ^ 2 + (xy(I, 2) - xy(J, 2)) ^ 2)

            s = s + d(K)

        Next J

    Next I

    s = s / 2

    area = Sqr(s * (s - d(1)) * (s - d(2)) * (s - d(3)))

End Function

 

【题目10】输入数据位数K（3～5），编程找出所有由1至9这九个数字组成的K位数，且满足从低位到高位的数字依次增大，任意相邻两位数字之差都大于1。

【编程要求】

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

2.在文本框1中输入数据位数K，单击“开始”按钮，找出所有满足上述条件的K位数，并以每行5个数的形式显示在多行文本框2中；

3.程序中应至少定义一个通用过程，用于判断某个K位数是否满足给定条件。

答：

源程序：

Private Sub Command1_Click()

Dim Num() As Integer, N As Integer, I As Integer, K As Integer

Dim counter As Integer

Text2.Text = ""

K = Val(Text1)

If K < 3 Or K > 5 Then

   MsgBox "请重新输入"

   Text1.Text = ""

   Text1.SetFocus

   Exit Sub

End If

ReDim Num(K)

For N = 10 ^ (K - 1) To 10 ^ K - 1

    For I = 1 To K

        Num(I) = Mid(CStr(N), I, 1)

        If Num(I) = 0 Then   Exit For

    Next I

    If I > K Then

        If Check(Num) Then

            counter = counter + 1

            Text2 = Text2 & Str(N)

            If counter Mod 5 = 0 Then Text2 = Text2 & vbCrLf

         End If

    End If

Next N

End Sub

 

Private Function Check(N() As Integer) As Boolean

     Dim Ub As Integer, I As Integer, J As Integer

     Ub = UBound(N)

     For I = 1 To Ub - 1

          For J = I + 1 To Ub

               If N(I) <= N(J) Or N(I) - N(J) = 1 Then

                    Check = False

                    Exit Function

               End If

          Next J

     Next I

     Check = True

End Function

 

【题目11】下面程序功能是：求出10～99之间所有因子（包括1与该数本身）个数为6的数。

答：

源程序：

Option Explicit

Private Sub Command1_Click()

    Dim I As Integer, cn() As Integer, S As String, J As Integer

    For I = 10 To 99

        Call cd(I, cn)

        If UBound(cn) = 6 Then

            S = CStr(I) & "=>"

            For J = 1 To 6

                S = S & Str(cn(J))

            Next J

            S = S & Chr(13) & Chr(10)

        Text1 = Text1.Text & S

        End If

    Next I

End Sub

 

Private Sub cd(N As Integer, cn() As Integer)

    Dim I As Integer, K As Integer

    For I = 1 To N

        If N Mod I = 0 Then

            K = K + 1

            ReDim Preserve cn(K)

            cn(K) = I

        End If

    Next I

End Sub

 

【题目12】找出1～100之间所有连续4个或4个以上整数组成的序列，要求序列中每个整数均必须具有两个不同素因子。例如，33（素因子3，11），34（素因子2，17），35（素因子5，7），36（素因子2，3），故33，34，35，36就符合要求。

【编程要求】

1. 按“开始”按钮，则开始运行程序，将结果按图示格式显示在文本框中；按“清除”按钮，则将文本框清空；按“结束”按钮，结束程序运行；

2. 程序中至少要有一个通用过程，判断一个数是否有两个不同的素因子。

答：

源程序：

Option Explicit

Private Sub Command1_Click()

   Dim P(25) As Integer, I As Integer, K As Integer

   Dim S As String

   For I = 2 To 100

       If Prime(I) Then

             K = K + 1

             P(K) = I

       End If

   Next I

   For I = 4 To K - 1

        If P(I + 1) - P(I) > 3 Then

              Call Sub1(P(I) + 1, P(I + 1) - 1, P, S)

              If S <> " " Then

                   Text1 = Text1 & "(" & S & ")" & vbCrLf

                   S = " "

              End If

         End If

   Next I

End Sub

 

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

 

Private Sub Sub1(A As Integer, B As Integer, P() As Integer, S As String)

    Dim I As Integer, J As Integer, N As Integer

    Dim Js As Integer

    For I = A To B

         J = 1

         N = 0

         Do While P(J) <= I

                If I Mod P(J) = 0 Then

                      N = N + 1

                End If

                J = J + 1

         Loop

         If N >= 2 Then

              Js = Js + 1: S = S & Str(I)

         Else

              Js = 0: S = " "

         End If

   Next I

   If Js < 4 Then S = " "

End Sub

 

Private Sub Command2_Click()

Text1.Text = ""

End Sub

 

Private Sub Command3_Click()

End

End Sub