DOC

vb

By Elsie Lawrence,2014-08-03 14:25
8 views 0
vb vb vb vb vb vb vb vb vb vb vb vb

随机整数[A,B]

    公式:Int(Rnd*(B-A+1)+A) 1.循环

    1,打印三角形

    方法一,用单重循环

    Private Sub Form_Click() For i = 1 To 8

    Print Tab(15 - i); String(2 * i - 1, "*")

    Next i

    End Sub

    方法二,用多重循环

    Private Sub Form_Click() For i = 1 To 8

    Print Tab(15 - i);

    For j = 1 To 2 * i - 1 Print "*";

    Next j

     Print

    Next i

    End Sub

    (2)求积数部分和

    Private Sub Form_Click() Dim i As Integer

    For i = 1 To 99 Step 2 s = s + i

    Next i

    Print s

    End Sub

3,求100200之间的所有素数。

    Private Sub Form_Click() Dim t As Boolean

    For x = 101 To 200 Step 2 t = True

    For i = 2 To x - 1

    If x Mod i = 0 Then t = False Next i

    If t Then

    k = k + 1

     Print x;

    If k Mod 10 = 0 Then Print End If

    Next x

    End Sub

4,最大公约数、最小公倍数

    Private Sub Form_Click()

     n1 = InputBox("输入 n")

     m1 = InputBox("输入 m")

     If m1 > n1 Then

     m = m1: n = n1

     Else

     m = n1: n = m1

     End If

     r = m Mod n

     Do While r <> 0

     m = n

     n = r

     r = m Mod n

     Loop

     Print m1; ","; n1; "的最大公约数="; n

     Print "最小公倍数=", m1 * n1 / n End Sub

5,水仙花数

    Private Sub Form_Click() For i = 100 To 999

    x = Int(i / 100)

    y = Int((i - x * 100) / 10) z = i - x * 100 - y * 10 If i = x * x * x + y * y * y + z * z * z Then

    Print i,

    End If

    Next i

    End Sub

    (6)最大值、最小值。

    例题 100 200 500 700 8000 900 250 360

    中的最大值和最小值

解法一

    Private Sub Form_Click()

    Dim arrNum(7) As Long Dim lngMax As Long

    Dim lngMin As Long

    Dim i As Integer

arrNum(0) = 100

    arrNum(1) = 200

    arrNum(2) = 500

    arrNum(3) = 700

    arrNum(4) = 8000

    arrNum(5) = 900

    arrNum(6) = 250

    arrNum(7) = 360

    lngMin = arrNum(0)

For i = LBound(arrNum) To UBound(arrNum)

     If arrNum(i) > lngMax Then

     lngMax = arrNum(i)

     End If

     If arrNum(i) < lngMin Then

     lngMin = arrNum(i)

     End If

    Next

MsgBox "max: " & lngMax & vbCrLf & "min: " & lngMin

    End Sub

解法二

    Private Sub Form_Click() Dim AA(10) As Long

    Dim IntMax, IntMin As Long

AA(0) = 100

    AA(1) = 200

    AA(2) = 500

    AA(3) = 700

    AA(4) = 8000

    AA(5) = 900

    AA(6) = 250

    AA(7) = 360

    AA(8) = 1

    AA(9) = 10000

    IntMax = AA(0)

IntMin = AA(0)

    For i = 1 To 9

     If AA(i) > IntMax Then

     IntMax = AA(i)

     End If

     If AA(i) < IntMin Then

     IntMin = AA(i)

     End If

    Next i

    MsgBox "最大是: " & IntMax

    MsgBox "最小是: " & IntMin

    End Sub

解法三

     Private Sub Command1_Click() getmaxmin 100, 200, 500, 700, 8000, 900, 250, 360

    End Sub

    Sub getmaxmin(ParamArray a()) Dim i As Long, max As Double, min As Double

    max = a(0)

    min = a(0)

    For i = 0 To UBound(a)

    max = IIf(max < a(i), a(i), max) min = IIf(min < a(i), min, a(i)) Next

    MsgBox "max number: " & max & vbCrLf & "min number: " & min

    End Sub

2 数组

    1,排序 从小到大排序

     Private Sub Form_Click() Dim a() As Integer

    n = Val(InputBox("n"))

    ReDim a(1 To n) As Integer Randomize

    For i = 1 To n

    a(i) = Int(Rnd * 101 + 100) Print a(i);

    If i Mod 10 = 0 Then Print Next i

For i = 1 To n - 1

    k = i

    For j = i + 1 To n

    If a(k) > a(j) Then k = j Next j

    t = a(i): a(i) = a(k): a(k) = t Next i

    For i = 1 To n

    Print a(i);

    If i Mod 10 = 0 Then Print Next i

End Sub

(2)杨辉三角形

    Private Sub command1_Click() Dim a(9, 9) As Integer, i As Integer

    Dim j As Integer, m As Integer For i = 0 To 9

     a(i, i) = 1

     a(i, 0) = 1

    Next i

    For i = 2 To 9

     m = i - 1

     For j = 1 To m

     a(i, j) = a(m, j - 1) + a(m, j)

     Next j

    Next i

    For i = 0 To 9

     For j = 0 To i

     Picture1.Print a(i, j);

     Next j

     Picture1.Print

    Next i

    End Sub

过程

    s=4!+5!+6!

    Private Sub form_click() Print fax(4) + fax(5) + fax(6) End Sub

Private Function fax(k As Integer) As Single

    t = 1

    For i = 2 To k

    t = t * i

    Next i

    fax = t

    End Function

回文数

Private Sub Text1_KeyPress(KeyAscii As Integer)

     If KeyAscii = 13 Then

     If Not IsNumeric(Text1) Then

     MsgBox "输入非数字串!重新输入"

     Text1.Text = ""

     Text1.SetFocus

     Else

     If ish(Text1) Then

     Picture1.Print Text1; "?"

     Else

     Picture1.Print Text1

     End If

     Text1 = ""

     End If

     End If

    End Sub

    Function ish(ss As String) As Boolean

     Dim i%, ls%

     ish = True

     ss = Trim(ss)

     ls = Len(ss)

     For i = 1 To ls \ 2

     If Mid(ss, i, 1) <> Mid(ss, ls + 1 - i, 1) Then

     ish = False

     Exit Function

     End If

     Next i

    End Function

十六进制转十进制

    Private Sub Form_Click() Dim a As String

    a = InputBox("asad")

    Print htod(a), Hex(htod(a)) End Sub

    Private Function htod(h As String) As Double

    For i = 1 To Len(h)

    m = UCase(Mid(h, i, 1)) If m >= "A" And m <= "F" Then x = Asc(m) - 65 + 10

    Else

    x = Val(m)

    End If

    s = s + x * 6 ^ (Len(h) - i) Next i

    htod = s

    End Function

文件

输入,由键盘输入5个学生信息保存到随机文件

    D:\TT\T.DAT

    每个学生包括学号、姓名、总分

    显示,显示不及格的学生信息

    修改,将及格的学生成绩增加5

    删除,删除不及格的学生信息

    结束,结束程序运行

    Private Type xs

    xh As String * 6

    xm As String * 6

    cj As Integer

    End Type

    Dim xs0 As xs

    Private Sub command1_click() Dim I%

    Open "D:\TT\T.DAT" For Random As #1 Len = Len(xs0)

    For I = I To 5

     xs0.xh = InputBox("XH")

     xs0.xm = InputBox("XM")

     xs0.cj = Val(InputBox("CJ"))

     Put #1, , xs0

     Next I

    Close #1

    End Sub

    Private Sub command2_click() Dim I%

    Open "D:\TT\T.DAT" For Random As #1 Len = Len(xs0)

    For I = 1 To LOF(1) / Len(xs0) Get #1, , xs0

    If xs0.cj < 60 Then

    Print xs0.xh, xs0.xm, xs0.cj End If

     Next I

    Close #1

    End Sub

    Private Sub command3_click() Dim I%

    Open "D:\TT\T.DAT" For Random As #1 Len = Len(xs0)

    For I = 1 To LOF(1) / Len(xs0) Get #1, , xs0

    If xs0.cj >= 60 Then

    xs0.cj = xs0.cj + 5

    Put #1, Seek(1) - 1, xs0 End If

     Next I

    Close #1

    End Sub

    Private Sub command4_click() Dim I%

    If Dir("D:\TT\T.TMP") = "D:\TT\T.TMP" Then Kill "D:\TT\T.TMP"

    Open "D:\TT\T.DAT" For Random As #1 Len = Len(xs0)

    Open "D:\TT\T.TMP" For Random As #2 Len = Len(xs0)

    For I = 1 To LOF(1) / Len(xs0) Get #1, , xs0

    If xs0.cj >= 60 Then

    Put #2, , xs0

    End If

     Next I

    Close

    Kill "D:\TT\T.DAT"

    Name "D:\TT\T.TMP" As "D:\TT\T.DAT"

End Sub

    Private Sub command5_click()

End

End Sub

Private Sub Form_Load()

    FontSize = 26

    End

    Sub

Report this document

For any questions or suggestions please email
cust-service@docsford.com