副程式例

'副程式例
Public Class Form1
    Private Sub Form1_Load(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles MyBase.Load
        '氣泡排序 
        Dim a() = {95, 90, 98, 92, 96} 
        sortIt(a) 
        printIt(a)

        Dim b() = {95, 90, 98, 92, 96, 87, 90, 98, 92, 96, 87, 90, 98, 92, 96, 87, 90, 98, 92, 96, 87, 90, 98, 92, 96, 87, 90, 98, 92, 96, 87} 
        sortIt(b) 
        printIt(b)

        Dim c() = {95, 90} 
        sortIt(c) 
        printIt(c)

        Dim a() = {95, 90, 98, 92, 96}
        selSortIt(a)
        printIt(a)

        Dim b() = {95, 90, 98, 92, 96, 87, 90, 98, 92, 96, 87, 90, 98, 92, 96, 87, 90, 98, 92, 96, 87, 90, 98, 92, 96, 87, 90, 98, 92, 96, 87}
        selSortIt(b)
        printIt(b)

        Dim c() = {95, 90}
        selSortIt(c)
        printIt(c)
    End Sub

    Sub sortIt(ByVal a)
        Dim i, j
        For j = 0 To a.length - 1 - 1
            For i = 0 To a.length - 1 - 1
                If a(i) > a(i + 1) Then
                    change(a(i), a(i + 1))
                End If
            Next
        Next
    End Sub

    Sub selSortIt(ByVal a)
        Dim i, j
        For j = 0 To a.length - 1 - 1
            For i = j + 1 To a.length - 1
                If a(j) > a(i) Then
                    change(a(j), a(i))
                End If
            Next
        Next
    End Sub

    Sub change(ByRef x, ByRef y)
        Dim t = x
        x = y
        y = t
    End Sub

    Sub printIt(ByVal a)
        Dim i
        Dim str1 = ""
        For i = 0 To a.length - 1
            str1 = str1 & a(i) & " "
        Next
        MsgBox(str1)
    End Sub
End Class

電子通訊錄地圖版

Public Class Form1

    Private Sub 聯絡資料BindingNavigatorSaveItem_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles 聯絡資料BindingNavigatorSaveItem.Click
        Me.Validate()
        Me.聯絡資料BindingSource.EndEdit()
        Me.聯絡資料TableAdapter.Update(Me.Db1DataSet.聯絡資料)

    End Sub

    Private Sub Form1_Load(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles MyBase.Load
        'TODO: 這行程式碼會將資料載入 'Db1DataSet.聯絡資料' 資料表。您可以視需要進行移動或移除。
        Me.聯絡資料TableAdapter.Fill(Me.Db1DataSet.聯絡資料)
        Label1.Text = "點按圖形可改變圖片大小"
        Label1.ForeColor = Color.Red
    End Sub

    Private Sub 地圖PictureBox_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles 地圖PictureBox.Click
        If 地圖PictureBox.SizeMode = PictureBoxSizeMode.CenterImage Then
            地圖PictureBox.SizeMode = PictureBoxSizeMode.StretchImage
        Else
            地圖PictureBox.SizeMode = PictureBoxSizeMode.CenterImage
        End If
    End Sub

End Class

多行資料求平均及最大最小值

'多行資料求平均及最大最小值
Public Class Form1
    Dim i, s
    Dim c(60) As Integer
    Private Sub Form1_Load(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles MyBase.Load
        Dim fileContents As String
        fileContents = My.Computer.FileSystem.ReadAllText("C:\d1.txt")
        '取代分行符號為空白間隔
        fileContents = Replace(fileContents, vbNewLine, " ")
        '去檔案後面空白
        fileContents = Trim(fileContents)
        Dim c1() = Split(fileContents, " ")
        For i = 0 To UBound(c1)
            c(i) = Val(c1(i))
        Next

        Dim cMax = c(0)
        Dim cMin = c(0)
        For i = 0 To UBound(c1)
            If c(i) > cMax Then cMax = c(i)
            If c(i) < cMin Then cMin = c(i)
            s = s + c(i)
        Next
        Dim str1 = "最大：" & cMax & vbNewLine & "最小：" & cMin & vbNewLine & "平均：" & _
                    Int(s / (UBound(c1) + 1) * 10 + 0.5) / 10 & vbNewLine & "共" & UBound(c1) + 1 & "筆"
        MsgBox(str1)
        ' My.Computer.FileSystem.WriteAllText("C:\d2.txt", str1, True)
        End
    End Sub
End Class

讀入多筆不定長度資料算平均

'讀入多筆不定長度資料算平均
Public Class Form1
    Dim i, j
    Dim s
    Private Sub Form1_Load(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles MyBase.Load
        Dim fileContents As String
        fileContents = My.Computer.FileSystem.ReadAllText("f:\T1.txt")

        Dim r() = Split(fileContents, vbNewLine)
        Dim n = 0
        For j = 0 To UBound(r)
            If r(j) <> "" Then
                Dim c() = Split(r(j), " ")
                For i = 0 To UBound(c)
                    n = n + 1
                    s = s + Val(c(i))
                Next
            End If
        Next
        MsgBox("共" & n & "筆,平均：" & Int(s / n + 0.5))
    End Sub
End Class

求質因數

'求質因數
Public Class Form1
    Dim i, j, k
    Dim str1, str2
    Private Sub Form1_Load(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles MyBase.Load
        Dim n() = {24, 36, 55, 110, 2300}
        For k = 0 To n.Length - 1
            str1 = n(k) & "->"
            For i = 1 To n(k)
                If n(k) Mod i = 0 Then
                    Dim c = 0
                    For j = 1 To i
                        If i Mod j = 0 Then c = c + 1
                    Next
                    If c = 2 Then str1 = str1 & i & Space(3)
                End If
            Next
            str2 = str2 & str1 & vbNewLine
        Next
        MsgBox(str2)
    End Sub
End Class

字數統計

'1算多少個半形字母含空白 38
'2算多少個英文字母不含空白，含標點符號 30
'3算多少個英文字母不含空白，不含標點符號 28
'4算多少個英文字 9
'5算有多少個e 6
'6統計分別各有多少個字母 W: 1   h: 3  e: 6 ....
Public Class Form1
    Dim i, c, j
    Dim str1 = ""
    Private Sub Form1_Load(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles MyBase.Load
        Dim s = " Where there is a will,   there is a way."
        'ans1
        'MsgBox(s.length)

        'ans2
        'For i = 1 To s.length
        '    If Mid(s, i, 1) <> " " Then c = c + 1
        'Next
        'MsgBox(c)

        'ans3
        'For i = 1 To s.length
        '    If Mid(s, i, 1) <> " " And Mid(s, i, 1) <> "," And Mid(s, i, 1) <> "." Then c = c + 1
        'Next
        'MsgBox(c)

        'ans4
        'For i = 2 To s.length
        '    If Mid(s, i, 1) = " " And Mid(s, i - 1, 1) <> " " Then c = c + 1
        'Next
        'MsgBox(c + 1)

        'ans5
        'For i = 1 To s.length
        '    If Mid(s, i, 1) = "e" Then c = c + 1
        'Next
        'MsgBox(c)

        'ans6
        For j = 1 To s.length
            If InStr(str1, Mid(s, j, 1)) = 0 Then
                c = 0
                For i = 1 To s.length
                    If Mid(s, i, 1) = Mid(s, j, 1) Then c = c + 1
                Next
                str1 = str1 & Mid(s, j, 1) & " : " & c & vbNewLine
            End If
        Next
        MsgBox(str1)
    End Sub
End Class

樂透開獎機模擬

'樂透開獎機
Public Class Form1
    Dim dx(10)
    Dim dy(10)
    Dim isStop(10) As Boolean
    Dim stopLoc = 1
    Dim pbox(10) As PictureBox
    Private Sub Form1_Load(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles MyBase.Load
        Randomize()
        Me.BackColor = Color.White

        pbox(1) = PictureBox1
        pbox(2) = PictureBox2
        pbox(3) = PictureBox3
        pbox(4) = PictureBox4
        pbox(5) = PictureBox5
        pbox(6) = PictureBox6
        pbox(7) = PictureBox7
        pbox(8) = PictureBox8
        pbox(9) = PictureBox9
        pbox(10) = PictureBox10

        Timer1.Enabled = True
        Timer1.Interval = 100
        Dim i
        For i = 1 To 10
            isStop(i) = False
            dx(i) = 1
            dy(i) = 1
            With pbox(i)
                .Image = Image.FromFile("..\..\resources\b" & i & ".gif")
                .Left = Int(Rnd() * 420 + 88)
                .Width = 35
                .Height = 35
                .SizeMode = PictureBoxSizeMode.StretchImage
                .BackColor = Color.White
            End With
        Next
    End Sub

    Private Sub Timer1_Tick(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Timer1.Tick
        Dim i
        For i = 1 To 10
            If isStop(i) <> True Then
                If pbox(i).Left > 275 And pbox(i).Left < 310 And pbox(i).Top > 366 And pbox(i).Top < 389 Then
                    pbox(i).Left = stopLoc
                    pbox(i).Top = 484
                    dx(i) = 0
                    dy(i) = 0
                    isStop(i) = True
                    stopLoc = stopLoc + pbox(1).Width
                End If

                pbox(i).Left = pbox(i).Left + 20 * dx(i)
                If pbox(i).Left > 512 - 10 Then dx(i) = -1
                If pbox(i).Left < 87 + 10 Then dx(i) = 1

                pbox(i).Top = pbox(i).Top + 20 * dy(i)
                If pbox(i).Top > 378 - 10 Then dy(i) = -1
                If pbox(i).Top < 71 + 10 Then
                    dy(i) = 1
                    pbox(i).Top = pbox(i).Top + Int(Rnd() * 10) * dy(i)
                End If
            End If
        Next
    End Sub
End Class