[题目1]这是一个对原文进行加密的程序，原文全部由大写字母及空格与合法的标点符号组成，加密方法是每个字母依所在原文中的排列次序，奇数位字按ASCII代码序依次前移5位，如字母F前移5位则变成A，但E前移后则变成Z，D则变成F，依此类推；偶数位字符，则按ASCII代码依次后移5位，如字母A后移5位则变成F,但Y后移则变成D,Z则变成E，依此类推。原文中的空格与合法的标点符号保持不变。

答：

源程序：

Private Sub Command1_Click()

    Dim decode As String, encode As String

    Dim i As Integer, st As String * 1

    decode = Text1

    For i = 1 To Len(decode)

         st = Mid(decode, i, 1)

        If st >= "A" And st <= "Z" And i Mod 2 <> 0 Then

              encode = encode & cov1(st)

        ElseIf st >= "A" And st <= "Z" And i Mod 2 = 0 Then

              encode = encode & cov2(st)

        Else

              encode = encode & st

        End If

    Next i

    Text2 = encode

End Sub

 

Private Function cov1(st As String) As String

    Dim n As Integer, k As Integer

    n = Asc(st) - 65 - 5

    If n < 0 Then

        k = n + 26

    Else

        k = n

    End If

    cov1 = Chr(k + 65)

End Function

 

Private Function cov2(st As String) As String

    Dim n As Integer, k As Integer

    n = Asc(st) - 65 + 5  

    If n <= 26 Then

        k = n

    Else

        k = n Mod 26

    End If

    cov2 = Chr(k + 65)

End Function

 

[题目2]编写一个求二项式分布函数的程序，将结果显示在列表框中。二项式分步函数的计算公式是：
　　　　　　　　　　
其中，p,q的定义域为[0，1]，且q=1-p，n为大于0 的正整数，x的取值为0~n之间整数。
[编程要求]
1． 在文本框Text1中输入p值，按回车键后，自动计算q值并显示在文本框Text2中，然后在文本框Text3中输入n值后按“计算”按钮，则开始计算并在列表框中显示结果；按“清除”按钮，则将三个文本框及列表框清空；按“退出”，结束程序运行；
2． 程序中必须包含一个递归函数过程，用于计算二项式函数值。

答：

源程序：

Dim q As Single, p As Single

Private Sub Command1_Click()

Dim i As Integer, n As Integer

n = Val(Text3.Text)

For i = 0 To n

    List1.AddItem "f(" & i & ")=" & CSng(fun(n, p, i))

Next i

End Sub

 

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

If x = 0 Then

    fun = q ^ n

ElseIf x > 0 Then

    fun = fun(n, p1, x - 1) * p1 * (n - x + 1) / (x * q)

End If

End Function

 

Private Sub Command2_Click()

Text1.Text = ""

Text2.Text = ""

Text3.Text = ""

List1.Clear

End Sub

 

Private Sub Command3_Click()

End

End Sub

 

Private Sub Text1_KeyPress(KeyAscii As Integer)

If KeyAscii = 13 Then

    If Val(Text1.Text) > 1 Or Val(Text1.Text) < 0 Then

        MsgBox "请输入0~1之间的数值", vbOKOnly

        Text1.Text = ""

        Text1.SetFocus

        Exit Sub

    End If

    p = Val(Text1.Text)

    q = 1 - Val(Text1.Text)

     Text2.Text = q

     Text3.SetFocus

End If

End Sub

 

[题目3]本程序是一个解压程序。变量encode中存放的是数据的压缩编码，其数据格式是：前8位第一个样本值（其中首位为符号位，0表示正，1表示负），其后每4位为下一个样本值与前一个样本值差值的二进制编码，List2中显示的是以十进制形式表示的各样本实际值。

答：

源程序：

Option Explicit

Private Sub Command1_Click()

      Dim encode As String, p As String, i As Integer

      Dim n As Integer

      encode = "010011100011110110110111"

      n = Len(encode)

      i = 1

      Do While n > 0

            If i = 1 Then

                p = Left(encode, 8)

                List1.AddItem p

                p = Left(encode, n - 8)

                i = i + 1

                n = n - 8

            Else

                p = Left(encode, 4)

                List1.AddItem p

                encode = Right(encode, n - 4)

                n = n - 4

            End If

      Loop

      For i = 0 To List1.ListCount - 1

          p = List1.List(i)

          If i = 0 Then

              n = cov(p)

              List2.AddItem Str(n)

          Else

              n = cov(p) + Val(List2.List(i - 1))

              List2.AddItem Str(n)

          End If

      Next i

End Sub

 

Private Function cov(s As String) As Integer

    Dim p As String, n As Integer, i As Integer

    Dim k As Integer, t As String * 1

    p = Left(s, 1)

    s = Right(s, Len(s) - 1)

    k = 0

    For i = Len(s) To 1 Step -1

        t = Mid(s, i, 1)

        cov = cov + t * 2 ^ k

        k = k + 1

    Next i

    If p = 1 Then cov = (-1) * cov

End Function

 

[题目4]编写程序，生成一个各元素均为两位随机正整数的5*5 数组，分别求出主对角线与副对角线的最大元素，若这两个元素的位置不重合，则将它们位置对调。将原数组与两个对角线上的最大元素位置对调后的数组分别输出到两个图片框内。
[编程要求]
1． 按“执行”按钮，生成各元素均为两位随机正整数的5*5数组，并显示在图片Picture1中，然后分别求出主对角线的最大元素，若这两个元素的位置不重合，则将它们位置对调，新数组显示到图片框Picture2中；按“退出”按钮，结束程序运行；
2． 程序中应至少包含一个通用过程，用于计算对角线最大元素及其位置。

答：

源程序：

Private Sub Command1_Click()

Dim a(1 To 5, 1 To 5) As Integer

Dim i As Integer, j As Integer, max2 As Integer, tem As Integer, c1 As Integer, c2 As Integer

Randomize

max2 = 0

Picture1.Cls

Picture2.Cls

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

    Picture1.Print

Next i

c1 = maxce(a)

For i = 1 To 5

 '   If a(i, i) > max1 Then max1 = a(i, i): c1 = i

    If a(i, 6 - i) > max2 Then max2 = a(i, 6 - i): c2 = i

Next i

If c1 <> 6 - c2 Then

    tem = a(c1, c1): a(c1, c1) = a(c2, 6 - c2): a(c2, 6 - c2) = tem

End If

For i = 1 To 5

    For j = 1 To 5

        Picture2.Print a(i, j);

    Next j

    Picture2.Print

    Picture2.Print

Next i

End Sub

 

Private Function maxce(a() As Integer)

Dim i As Integer, max As Integer

max = 0

For i = 1 To 5

    If a(i, i) > max Then max = a(i, i): maxce = i

Next i

End Function

 

[题目5]下面程序的功能是：将随机生成不同的10个两位正整数显示在多行文本框text1中，并将每个数除1和该数本身以外的因子按图中形式显示在一个列表框list1中。

答：

源程序：

Option Explicit

Private Sub Command1_Click()

    Dim i As Integer, st As String, n As Integer, a(10) As Integer

    Dim j As Integer, fn() As Integer, stb As String

    For i = 1 To 10

        n = Int(90 * Rnd) + 10

       For j = 1 To i - 1

          If n = a(j) Then

              i = i - 1

              Exit For

          End If

      Next j

      If j = i Then

          a(i) = n

          st = st & Str(a(i)) & Chr(13) & Chr(10)

      End If

    Next i

    Text1 = st

    For i = 1 To 10

        stb = " "

        Call factor(a(i), fn)

        If UBound(fn) >= 1 Then

            For j = 1 To UBound(fn)

                stb = stb & Str(fn(j))

            Next j

            List1.AddItem "=>" & stb

        Else

            List1.AddItem "=>"

        End If

    Next i

End Sub

 

Private Sub factor(x As Integer, fn() As Integer)

    Dim i As Integer, n As Integer

    ReDim fn(0)

    For i = 2 To x - 1

  

        If x Mod i = 0 Then

            n = n + 1

            ReDim Preserve fn(n)

            fn(n) = i

        End If

    Next i

End Sub

[题目6]编写一个求Qi（i）函数表的程序，将结果显示在列表框中。Qi（x）函数的计算公式是：
　
[编程要求]
1． 按“取x值”按钮，通过InputBox函数分别输入自变量的初值sv、终值fv及步长sp。sv,fv,sp的缺省值分别取1.0、1.5、0.05，计算并将自变量数据显示在多行文本框Text1中。再按“求函数值”按钮，则开始计算并在多行文本框Text2中显示结果；按“退出”按钮，结束程序运行；
2． 程序中应一个名为Fact的递归函数过程，用于计算阶乘值。

答：

源程序：

Dim a() As Single

Private Sub Command1_Click()

Dim i As Single, sv As Single, fv As Single, sp As Single, k As Integer

sv = InputBox("请输入初始值", "数据输入", 1!)

fv = InputBox("请输入盅始值", "数据输入", 1.5!)

sp = InputBox("请输入步长值", "数据输入", 0.05)

k = 0

For i = sv To fv Step sp

    k = k + 1

    ReDim Preserve a(k)

    a(k) = i

    Text1.Text = Text1.Text & a(k) & vbCrLf

Next i

End Sub

Private Function fact(n As Integer)

'Dim i As Integer

'fact = 1

'For i = 1 To n

'    fact = fact * i

'Next i

If n = 1 Then

    fact = 1

Else

    fact = fact(n - 1) * n

End If

End Function

 

Private Sub Command2_Click()

Dim i As Integer, sum As Single, s As Single, tem As Single, n As Integer, t As Single

For i = 1 To UBound(a)

    s = Sin(i) / i

    sum = 0

    n = 1

    Do

        tem = (-1) ^ n * i ^ (2 * n + 1) / fact(2 * n + 1)

        t = Abs(tem)

        sum = sum + tem

        n = n + 1

    Loop Until t <= 0.00001

    s = s * sum

    Text2.Text = Text2.Text & s & vbCrLf

Next i

End Sub

 

Private Sub Command3_Click()

End

End Sub

 

[题目7]在20个不同的两位随机数中找出一组数，这组数中任意两个书的组最大公约数 都为1，即两两互质。

答：

源程序：

Option Explicit

Private Sub Command1_Click()

    Dim A(20) As Integer, I As Integer, B() As Integer

    Dim K As Integer, Idx As Integer

    Do While Idx < 20

        K = Int(90 * Rnd) + 10

        For I = 1 To Idx

            If A(I) = K Then Exit For

       Next I

       If I > Idx Then

          Idx = Idx + 1

          A(Idx) = K

          Text1 = Text1 & Str(A(Idx))

          If Idx Mod 10 = 0 Then Text1 = Text1 & vbCrLf

      End If

    Loop

    ReDim B(1)

    B(1) = A(1)

    For I = 2 To 20

        Call Sub1(A(I), B)

    Next I

    For I = 1 To UBound(B)

        Text2 = Text2 & Str(B(I))

        If I Mod 10 = 0 Then Text2 = Text2 & vbCrLf

    Next I

End Sub

 

Private Sub Sub1(Data As Integer, T() As Integer)

    Dim I As Integer, J As Integer, K As Integer

    K = UBound(T)

    For I = 1 To K

        For J = 2 To Data

            If Data Mod J = 0 And T(I) Mod J = 0 Then

                Exit Sub

            End If

        Next J

    Next I

    ReDim Preserve T(K + 1)

    T(K + 1) = Data

End Sub

 

[题目8]程序功能是：从键盘输入一个正整数n,并分别将n²、（n-2）²，…、l² 顺序填入某二维数组第一行中，接下来的每行元素依次循环左移一个数而得。若输入整数4，则生成的二维数组如图所示。

答：

源程序：

Option Base 1

Private Sub Command1_Click()

    Dim I As Integer, j As Integer, a() As Integer

    Dim n As Integer

    n = Val(InputBox("请输入一个正整数", , 4))

    ReDim a(n, n)

    Call data(a(), n)

    For I = 1 To n

        For j = 1 To n

            Picture1.Print a(I, j);

        Next j

        Picture1.Print

    Next I

End Sub

 

Public Sub data(p() As Integer, m As Integer)

    Dim I As Integer, j As Integer

    For I = 1 To m

        p(1, I) = (m - I + 1) * (m - I + 1)

    Next I

    For I = 2 To m

        For j = 1 To m - 1

            p(I, j) = p(I - 1, j + 1)

        Next j

        p(I, m) = p(I - 1, 1)

    Next I

End Sub

 

[题目9]求积为4056，最小公倍数为n（其值为156或312）的两个数对。
[编程要求]
1． 运行程序，在文本框Text1中输入最小公倍数 （156或312），按“计算”按钮，则开始找符合条件的回溯，并将结果按图示格示显示于文本框Text2;按“清除”按钮，则将文本框清空；按“结束”按钮，结束程序运行；
2． 符合要求的两个书显示在文本框中；数据相同的两组数组中只取一组，小的数放在前面，大数放在后面；例如：13、312和312、13只取13、312 这一对；
3． 编写一个求两个数的最小公倍数的函数过程；
答：

源程序：

Private Sub Command1_Click()

Dim n As Integer, I As Integer

n = Val(Text1.Text)

If n = 156 Or n = 312 Then

  For I = 1 To Sqr(4056)

    If gbs(I, 4056 / I) = n Then

        Text2.Text = Text2.Text & I & "  " & 4056 / I & vbCrLf

    End If

  Next I

Else

  MsgBox "所输入的N值不对"

  Text1.Text = ""

  Text1.SetFocus

End If

End Sub

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

Dim k As Integer, x As Integer, y As Integer

x = m

y = n

Do

    k = m Mod n

    m = n

    n = k

Loop Until k = 0

gbs = x * y / m

End Function

 

Private Sub Command2_Click()

Text1.Text = ""

Text2.Text = ""

Text1.SetFocus

End Sub

 

Private Sub Command3_Click()

End

End Sub

[题目10]这是一个求如下级数和的程序，计算精确到级数第n 项的绝对值小于等于10-5为止。
　

答：

源Option Explicit

Private Sub Command1_Click()

    Dim x As Single, i As Integer, a As Single

    Dim s As Single

    x = Val(Text1)

    i = 1

    Do

        a = fun(x, i)

        If Abs(a) <= 0.00001 Then Exit Do

        s = s + a

        i = i + 1

    Loop

    Text2 = s

End Sub

 

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

    Dim sum As Long, i As Integer

    For i = 1 To n

        sum = sum + fact(i)

    Next i

    fun = (-1) ^ n * x ^ (2 * n - 1) / sum

End Function

 

Private Function fact(ByVal n As Integer) As Long

    fact = 1

    Do While n > 0

        fact = fact * n

        n = n - 1

    Loop

End Function

程序：

 

[题目11]编写程序，随机产生30 个三位正整数，并按每行10 个书的形式输出到一个多行文本框中；在从这些数中找出所有的升序数，按从小到大的次序将升序数输出到一个列表框中。升序数是指各位数字自高位到低位，一个比一个大的整数，如134，278，489等。
[编程要求]
1． 按“处理”按钮，随机产生30个三位正整数，并按每行10个数的形式输出到一个多行文本框Text1中；再从这些数中找出所有的升序社，按从小到大的次序输出到列表框List1中；按“清除”按钮，则清空文本框中内容；按“结束”按钮，结束程序运行；
2． 程序中应定义一个名为flag的函数过程，用于判断某数是否为升序数。
答：

源程序：

Option Base 1

Private Sub Command1_Click()

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

Dim a(30) As Integer, b() As Integer

Randomize

List1.Clear

Text1.Text = ""

j = 0

k = 0

For i = 1 To 30

    a(i) = Int(Rnd * 900) + 100

    If flg(a(i)) = True Then

        k = k + 1

        ReDim Preserve b(k)

        b(k) = a(i)

    End If

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

    j = j + 1

    If j Mod 10 = 0 Then Text1.Text = Text1.Text & vbCrLf

Next i

For i = 1 To UBound(b) - 1

    For j = i + 1 To UBound(b)

        If b(i) > b(j) Then

            t = b(j): b(j) = b(i): b(i) = t

        End If

    Next j

Next i

For i = 1 To UBound(b)

    List1.AddItem b(i)

Next i

End Sub

Private Function flg(x As Integer) As Boolean

Dim i As Integer

Dim s As String

Dim l As Integer

s = CStr(x)

For i = 1 To Len(s) - 1

    If Mid(s, i, 1) > Mid(s, i + 1, 1) Then flg = False: Exit Function

Next i

flg = True

End Function

Private Sub Command2_Click()

Text1.Text = ""

List1.Clear

End Sub

 

Private Sub Command3_Click()

End

End Sub

[题目12]统计英文字符串中以各种字母为首的单词数量（单词之间用空格或其他非字母字符分隔），统计是不分大小写。

答：

源程序：

Private Sub Command1_Click()

    Dim s As String, i As Integer, L As Integer

    Dim ch(1 To 26) As Integer, flag As Boolean

    s = Text1

    Call count1(ch, s)

    For i = 1 To 26

        If ch(i) <> 0 Then

            List1.AddItem "以" & Chr(i + 97 - 1) & "字母为首的单词有" & ch(i) & "个"

        End If

    Next i

End Sub

 

Public Sub count1(ch() As Integer, s As String)

    Dim i As Integer, flag As Boolean

    Dim s1 As String * 1, j As Integer

    flag = True

    For i = 1 To Len(s)

        s1 = Mid(s, i, 1)

        If s1 >= "A" And s1 <= "Z" Then s1 = LCase(s1)

        If s1 >= "a" And s1 <= "z" Then

            If flag Then

                    j = Asc(s1) - Asc("a") + 1

                    ch(j) = ch(j) + 1

                    flag = False

            End If

        Else

            flag = True

        End If

    Next i

End Sub

 

[题目13]编程产生一个5*5的数组，数组的前两列有公式（13*行号+7*列号）产生，后三列中的每个元素由起前面两列对应的元素的平均值取整后得到。再把该数组中的本身是素数并且其逆序数（指的是个位和十位颠倒后的得到的数）也是素数的元素找出来。例如37和73都是素数。
[编程要求]
1． 按“产生数组”按钮，生成符合要求的数组并显示在图片picture1中；再按“处理”按钮，则把符合要求的数组元素所在的行、列和元素显示在列表框list1中；按“结束”按钮，结束程序运行；
2． 程序中应定义一个名为prime的珩上过程，用于判断某个数是否为素数。

答：

源程序：

Option Base 1

Dim a(5, 5) As Integer

Private Sub Command1_Click()

Dim i As Integer, j As Integer

For i = 1 To 5

    For j = 1 To 2

        a(i, j) = 13 * i + 7 * j

    Next j

 Next i

 For i = 1 To 5

    For j = 3 To 5

        a(i, j) = Int((a(i, j - 1) + a(i, j - 2)) / 2)

    Next j

Next i

For i = 1 To 5

    For j = 1 To 5

        Picture1.Print a(i, j);

    Next j

    Picture1.Print

Next i

End Sub

 

Private Function prime(x As Integer) As Boolean

Dim i As Integer

prime = False

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

    If x Mod i = 0 Then Exit Function

Next i

prime = True

End Function

 

Private Sub Command2_Click()

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

For i = 1 To 5

    For j = 1 To 5

        tem = CStr(a(i, j))

        s = ""

        For k = Len(tem) To 1 Step -1

            s = s & Mid(tem, k, 1)

        Next k

        If prime(a(i, j)) And prime(CInt(s)) Then

            List1.AddItem " 第" & i & "行第" & j & "列元素值为： " & a(i, j)

        End If

    Next j

Next i

End Sub

 

Private Sub Command3_Click()

Picture1.Cls

List1.Clear

End Sub

 

Private Sub Command4_Click()

End

End Sub