VB LEARNING: 2009

2009年6月15日星期一

副程式例

'副程式例
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

2009年6月4日星期四

電子通訊錄地圖版

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

2009年5月19日星期二

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

'多行資料求平均及最大最小值
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

2009年5月18日星期一

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

'讀入多筆不定長度資料算平均
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

2009年5月5日星期二

求質因數

'求質因數
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

2009年5月4日星期一

字數統計

'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

2009年4月30日星期四

樂透開獎機模擬

'樂透開獎機
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

Shell Sort - 不定大小陣列版

'Shell Sorting 謝耳排序
'改為不定大小陣列
Public Class Form1
    Dim a() = {90, 95, 92, 93, 94, 96, 91}
    Private Sub Form1_Load(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles MyBase.Load
        Dim i
        Dim str1 = ""
        Dim n = a.Length
        Dim d = n \ 2

        While d <> 0
            Dim isChange As Boolean = False
            For i = 0 To n - 1 - d
                If a(i) > a(i + d) Then
                    Dim t = a(i)
                    a(i) = a(i + d)
                    a(i + d) = t
                    isChange = True
                End If
            Next
            If isChange = False Then
                d = d \ 2
            End If
        End While

        For i = 0 To n - 1
            str1 = str1 & a(i) & Space(3)
        Next
        MsgBox(str1)
    End Sub
End Class

Shell Sort

'Shell Sort 謝耳排序
Public Class Form1
    Dim a() = {90, 95, 92, 93, 94}
    Private Sub Form1_Load(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles MyBase.Load
        Dim i
        Dim str1 = ""
        Dim d = 5 \ 2

        While d <> 0
            Dim isChange As Boolean = False
            For i = 0 To 4 - d
                If a(i) > a(i + d) Then
                    Dim t = a(i)
                    a(i) = a(i + d)
                    a(i + d) = t
                    isChange = True
                End If
            Next
            If isChange = False Then
                d = d \ 2
            End If
        End While

        For i = 0 To 4
            str1 = str1 & a(i) & Space(3)
        Next
        MsgBox(str1)
    End Sub
End Class

2009年4月29日星期三

打磚塊 -- 料一甲20080429版

Public Class Form1
    Dim sco = 0
    Dim loss = 0
    Dim pbox(40) As PictureBox
    Dim ball As Image = Image.FromFile("..\..\ball.gif")
    Dim ballsize
    Dim x, y As Integer
    Dim dx, dy As Integer
    Dim timeAcc As Single = 0

    Private Sub Form1_KeyDown(ByVal sender As Object, ByVal e As System.Windows.Forms.KeyEventArgs) Handles Me.KeyDown
        If e.KeyCode = Keys.Right Then PBox1.Left = PBox1.Left + 50
        If e.KeyCode = Keys.Left Then PBox1.Left = PBox1.Left - 50
    End Sub

    Private Sub Form1_Load(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles MyBase.Load
        KeyPreview = True
        ballsize = 30
        PBox1.Width = 50
        Label1.Text = "得分：" & sco
        Label2.Text = "失球：" & loss
        Me.Width = 474

        Dim i
        For i = 1 To 40
            pbox(i) = New PictureBox
            Dim r = Int(Rnd() * 256)
            Dim g = Int(Rnd() * 256)
            Dim b = Int(Rnd() * 256)
            With pbox(i)
                ' .BackColor = Color.Blue
                .BackColor = Color.FromArgb(255, r, g, b)
                .Width = 55
                .Height = 23
                .Left = 5 + (i Mod 8) * (.Width + 2)
                .Top = 50 + ((i - 1) \ 8) * 25
            End With
            Me.Controls.Add(pbox(i))
        Next
        x = 1
        y = 200
        dx = 1
        dy = 1
        Timer1.Enabled = True
        Timer1.Interval = 50
    End Sub

    Private Sub Form1_Paint(ByVal sender As Object, ByVal e As System.Windows.Forms.PaintEventArgs) Handles Me.Paint
        Dim g As Graphics = e.Graphics
        g.DrawImage(ball, x, y, ballsize, ballsize)
    End Sub

    Private Sub Timer1_Tick(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Timer1.Tick
        '有無打到磚塊
        timeAcc = timeAcc + Timer1.Interval
        Label5.Text = "計時：" & Int(timeAcc / 1000) & "秒"
        Dim i As Integer
        For i = 1 To 40
            If x + ballsize > pbox(i).Left And x < pbox(i).Left + pbox(i).Width And y < pbox(i).Top + ballsize Then
                '第一次打到磚塊回頭
                If pbox(i).Visible = True Then
                    If dy = -1 Then
                        dy = 1
                    Else
                        dy = -1
                    End If
                    pbox(i).Visible = False
                    sco = sco + 1
                    Label1.Text = "得分：" & sco

                    If sco = 40 Then
                        Timer1.Enabled = False
                        MsgBox("成績：" & Int(timeAcc) & "秒")
                    End If

                End If
            End If
        Next

        If x > Me.Width - ballsize Then dx = -1
        '有無擋到球
        If y > 600 - ballsize And x + ballsize > PBox1.Left And x < PBox1.Left + PBox1.Width And y < PBox1.Top + ballsize Then
            dy = -1
        End If

        If y > 650 Then
            loss = loss + 1
            Label2.Text = "失球：" & loss
            ' Timer1.Enabled = False
            y = 200
        End If
        If x < 1 Then dx = 1
        If y < 1 Then dy = 1
        x = x + dx * 10
        y = y + dy * 12
        Me.Refresh()
    End Sub

    Private Sub NUpDown1_ValueChanged(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles NUpDown1.ValueChanged
        ballsize = NUpDown1.Value
    End Sub

    Private Sub NUpDown2_ValueChanged(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles NUpDown2.ValueChanged
        PBox1.Width = NUpDown2.Value
    End Sub
End Class

2009年4月28日星期二

打磚塊 - 201 2009/04/28版

Public Class Form1
    Dim pbox(80) As PictureBox
    Dim Ball As Image = My.Resources.ball
    Dim x, y As Integer
    Dim dx, dy As Integer
    Dim ballsize = 28
    Dim scoAcc = 0
    Dim lossAcc = 0
    Dim dl = 10

    Private Sub Form1_Load(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles MyBase.Load
        KeyPreview = True
        NUpDown1.Value = 70
        NUpDown2.Value = 28
        Label1.Text = "得分數：" & scoAcc
        Label2.Text = "失球數：" & lossAcc
        Randomize()
        Me.Width = 10 + 60 * 8 + 10

Timer1.Interval = 50
Timer1.Enabled = True

        x = 0
        dx = 1
        y = 200
        dy = 1

        Dim i
        For i = 1 To 80
            pbox(i) = New PictureBox
            With pbox(i)
                Dim r = Int(Rnd() * 256)
                Dim g = Int(Rnd() * 256)
                Dim b = Int(Rnd() * 256)
                .BackColor = Color.FromArgb(255, r, g, b)
                .Left = 5 + (i Mod 16) * 30
                .Top = 50 + ((i - 1) \ 16) * 20
                .Width = 29
                .Height = 19
            End With
            Me.Controls.Add(pbox(i))
        Next
        PBox1.Width = 70
    End Sub

    Private Sub NUpDown1_ValueChanged(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles NUpDown1.ValueChanged
        PBox1.Width = NUpDown1.Value
    End Sub

    Private Sub NUpDown2_ValueChanged(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles NUpDown2.ValueChanged
        ballsize = NUpDown2.Value
    End Sub

    Private Sub Form1_KeyDown(ByVal sender As Object, ByVal e As System.Windows.Forms.KeyEventArgs) Handles Me.KeyDown
        If e.KeyCode = Keys.Right Then
            PBox1.Left = PBox1.Left + 50
            If PBox1.Left + PBox1.Width > Me.Width Then PBox1.Left = Me.Width - PBox1.Width
        End If

        If e.KeyCode = Keys.Left Then
            PBox1.Left = PBox1.Left - 50
            If PBox1.Left < 0 Then PBox1.Left = 0
        End If
    End Sub

Private Sub Timer1_Tick(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Timer1.Tick

If x > Me.Width - ballsize Then dx = -1

        '
        Dim i
        For i = 1 To 80
            If y + ballsize > pbox(i).Top And y < pbox(i).Top + pbox(i).Height And (x > pbox(i).Left - ballsize) And (x < pbox(i).Left + pbox(i).Width) Then
                If pbox(i).Visible = True Then
                    pbox(i).Visible = False
                    If dy = 1 Then
                        dy = -1
                    Else
                        dy = 1
                    End If
                    scoAcc = scoAcc + 1
                    Label1.Text = "得分數：" & scoAcc
                    dl = Int(Rnd() * 5) + 10
                    Exit For
                End If
            End If
        Next

        '
        If y + ballsize > PBox1.Top And y < PBox1.Top + PBox1.Height And (x > PBox1.Left - ballsize) And (x < PBox1.Left + PBox1.Width) Then
            dy = -1
        End If

        If y > Me.Height Then
            lossAcc = lossAcc + 1
            Label2.Text = "失球數：" & lossAcc
            NewBall()
        End If

If x < 1 Then dx = 1
If y < 1 Then dy = 1

x = x + dl * dx
y = y + dl * dy

Me.Refresh()
End Sub

    Sub NewBall()
        y = 150
        Dim generator As New Random
        Dim randomValue As Integer = generator.Next(1, Me.Width)
        x = randomValue
        dy = 1
    End Sub

    Private Sub Form1_Paint(ByVal sender As Object, ByVal e As System.Windows.Forms.PaintEventArgs) Handles Me.Paint
        Dim g As Graphics = e.Graphics
        g.DrawImage(Ball, x, y, ballsize, ballsize)
    End Sub
End Class

2009年4月27日星期一

打磚塊 -- 201 過程版 2008/04/27

Public Class Form1
    Dim pbox(40) As PictureBox
    Dim Ball As Image = My.Resources.ball
    Dim x, y As Integer
    Dim dx, dy As Integer
    Dim ballsize = 36

    Private Sub Form1_Load(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles MyBase.Load
        Randomize()
        Me.Width = 10 + 60 * 8 + 10

Timer1.Interval = 50
Timer1.Enabled = True

        x = 0
        dx = 1
        y = 200
        dy = 1

        Dim i
        For i = 1 To 40
            pbox(i) = New PictureBox
            With pbox(i)
                Dim r = Int(Rnd() * 256)
                Dim g = Int(Rnd() * 256)
                Dim b = Int(Rnd() * 256)
                .BackColor = Color.FromArgb(255, r, g, b)
                .Left = 5 + (i Mod 8) * 60
                .Top = 50 + ((i - 1) \ 8) * 20
                .Width = 59
                .Height = 19
            End With
            Me.Controls.Add(pbox(i))
        Next
    End Sub
    Private Sub Form1_KeyDown(ByVal sender As Object, ByVal e As System.Windows.Forms.KeyEventArgs) Handles Me.KeyDown
        If e.KeyCode = Keys.Right Then
            PBox1.Left = PBox1.Left + 50
            If PBox1.Left + PBox1.Width > Me.Width Then PBox1.Left = Me.Width - PBox1.Width
        End If

        If e.KeyCode = Keys.Left Then
            PBox1.Left = PBox1.Left - 50
            If PBox1.Left < 0 Then PBox1.Left = 0
        End If

End Sub

Private Sub Timer1_Tick(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Timer1.Tick

If x > Me.Width - ballsize Then dx = -1

        '
        Dim i
        For i = 1 To 40
            If y + ballsize > pbox(i).Top And y < pbox(i).Top + pbox(i).Height And (x > pbox(i).Left - ballsize) And (x < pbox(i).Left + pbox(i).Width) Then
                If pbox(i).Visible = True Then
                    pbox(i).Visible = False
                    dy = 1
                End If
            End If
        Next

        '
        If y + ballsize > PBox1.Top And y < PBox1.Top + PBox1.Height And (x > PBox1.Left - ballsize) And (x < PBox1.Left + PBox1.Width) Then
            dy = -1
        End If

If x < 1 Then dx = 1
If y < 1 Then dy = 1

x = x + 10 * dx
y = y + 10 * dy

Me.Refresh()
End Sub

End Class

2009年4月24日星期五

宇數統計

'宇數統計
Public Class Form1
    Private Sub Form1_Load(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles MyBase.Load
        Dim rStr = ""
        Dim s = "Where there is a will, there is a way."
        Dim lineArray() = Split(s, " ")
        rStr = "Word:" & lineArray.Length & vbNewLine

        Dim c = 0
        Dim cb = 0
        Dim i = 1
        While Mid(s, i, 1) <> ""
            If Mid(s, i, 1) <> " " Then
                c = c + 1
            Else
                cb = cb + 1
            End If
            i = i + 1
        End While
        rStr = rStr & "character:" & c & Space(3) & "blank:" & cb
        MsgBox(rStr)
    End Sub
End Class

因數分解 -- 多個數

'因數分解 -- 多個數
Public Class Form1
Private Sub Form1_Load(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles MyBase.Load
Dim rStr = ""

Dim n() = {1, 12, 24, 369}

        For j As Integer = 0 To UBound(n)
            Dim nb = n(j)
            Dim str1 = "1"
            Dim i = 2
            While n(j) <> 1
                If n(j) Mod i = 0 Then
                    str1 = str1 & "x" & i
                    n(j) = n(j) / i
                Else
                    i = i + 1
                End If
            End While
            rStr = rStr & nb & "=" & str1 & vbNewLine
        Next
        MsgBox(rStr)
    End Sub
End Class

因數分解 -- 單一數

'因數分解 -- 單一數
Public Class Form1
    Private Sub Form1_Load(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles MyBase.Load
        Dim str1 = ""
        Dim n = 369

        Dim i = 2
        While n <> 1
            If n Mod i = 0 Then
                str1 = str1 & i & Space(2)
                n = n / i
            Else
                i = i + 1
            End If
        End While
        MsgBox(str1)
    End Sub
End Class

迴文判斷

'迴文判斷
Public Class Form1
    Private Sub Form1_Load(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles MyBase.Load
        Dim rStr = ""
        Dim n() = {"12321", "1", "1221", "123454321", "12312", "12"}
        For m As Integer = 0 To UBound(n)
            Dim i = Int(Len(n(m)) / 2) + 1
            Dim isTrue = True

            Dim j = 1
            Dim k = Len(n(m))
            While j < i
                If Mid(n(m), j, 1) <> Mid(n(m), k, 1) Then isTrue = False
                j = j + 1
                k = k - 1
            End While
            rStr = rStr & n(m) & ":" & IIf(isTrue, "迴文", "非迴文") & vbNewLine
        Next
        MsgBox(rStr)
    End Sub
End Class

閏年判斷

'閏年判斷
'西元年被4整除且不被100整除，或被400整除者即為閏年

Public Class Form1

    Private Sub Form1_Load(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles MyBase.Load
        Dim rStr = ""
        Dim y() = {1995, 1996, 1900, 2000}
        For i As Integer = 0 To UBound(y)
            Dim msg = "非閏年"
            If y(i) Mod 4 = 0 Then msg = "閏年"
            If y(i) Mod 100 = 0 Then msg = "非閏年"
            If y(i) Mod 400 = 0 Then msg = "閏年"
            rStr = rStr & msg & vbNewLine
        Next
        MsgBox(rStr)
    End Sub
End Class

兩光法師占卜

'兩光法師時常替人占卜，由於他算得又快有便宜，因此生意源源不絕，時常大排長龍，他想算得更快一點，因此找了你這位電腦高手幫他用電腦來加快算命的速度。

' 他的占卜規則很簡單，規則是這樣的，輸入一個日期，然後依照下面的公式：
'M=月
'D=日
'S=(M*2+D)%3

'得到 S 的值，再依照 S 的值從 0 到 2 分別給與 "普通"、"吉"、"大吉"等三種不同的運勢

'輸入說明：

'月份及日期
'輸出說明：

'運勢
'範例輸入：

'若題目沒有特別說明，則應該以多測資的方式讀取，若不知如何讀取請參考 a001 的範例程式。
'1 1
'1 2
'範例輸出：

'普通
'吉

'提示：

'題目出處：

'Jiangsir -- http://zerojudge.tw/

執行畫面：

程式碼：

Public Class Form1
    Private Sub Form1_Load(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles MyBase.Load
        Dim resultStr = ""
        Dim fileContents As String
        fileContents = My.Computer.FileSystem.ReadAllText("..\..\q3.txt")

Dim lineArray() = Split(fileContents, vbNewLine)

        For i As Integer = 0 To UBound(lineArray)
            Dim colArray = Split(lineArray(i), " ")
            Dim m = colArray(0)
            Dim d = colArray(1)
            Dim S = (m * 2 + d) Mod 3
            Dim temStr = Choose(S + 1, "普通", "吉", "大吉")
            resultStr = resultStr & temStr & vbNewLine
        Next
        MsgBox(resultStr)
    End Sub
End Class

高中生程式解題系統

http://zerojudge.tw/

2009年4月23日星期四

打磚塊--打到磚塊回頭版

'打到磚塊回頭版
Public Class Form1
    Dim pbox(40) As PictureBox
    Dim ball As Image = Image.FromFile("..\..\ball.gif")
    Dim ballsize = 36
    Dim x, y As Integer
    Dim dx, dy As Integer

Private Sub Form1_Load(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles MyBase.Load
Me.Width = 474

        Dim i
        For i = 1 To 40
            pbox(i) = New PictureBox
            Dim r = Int(Rnd() * 256)
            Dim g = Int(Rnd() * 256)
            Dim b = Int(Rnd() * 256)
            With pbox(i)
                ' .BackColor = Color.Blue
                .BackColor = Color.FromArgb(255, r, g, b)
                .Width = 55
                .Height = 23
                .Left = 5 + (i Mod 8) * (.Width + 2)
                .Top = 5 + ((i - 1) \ 8) * 25
            End With
            Me.Controls.Add(pbox(i))
        Next
        x = 1
        y = 166
        dx = 1
        dy = 1
        Timer1.Enabled = True
        Timer1.Interval = 100
    End Sub

    Private Sub Timer1_Tick(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Timer1.Tick
        '有無打到磚塊
        Dim i As Integer
        For i = 1 To 40
            If x + ballsize > pbox(i).Left And x < pbox(i).Left + pbox(i).Width And y < pbox(i).Top + ballsize Then
                '第一次打到磚塊回頭
                If pbox(i).Visible = True Then dy = 1
                pbox(i).Visible = False
            End If
        Next

        If x > Me.Width - ballsize Then dx = -1
        '有無擋到球
        If y > 479 - ballsize And x + ballsize > PBox1.Left And x < PBox1.Left + PBox1.Width And y < PBox1.Top + ballsize Then
            dy = -1
        End If

        If x < 1 Then dx = 1
        If y < 1 Then dy = 1
        x = x + dx * 10
        y = y + dy * 12
        Me.Refresh()
    End Sub
End Class

2009年4月22日星期三

打磚塊--部份完成例

Public Class Form1
    Dim pbox(40) As PictureBox
    Dim ball As Image = Image.FromFile("..\..\ball.gif")
    Dim ballsize = 36
    Dim x, y As Integer
    Dim dx, dy As Integer
    Private Sub Form1_Load(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles MyBase.Load
        Me.Width = 474

        Dim i
        For i = 1 To 40
            pbox(1) = New PictureBox
            Dim r = Int(Rnd() * 256)
            Dim g = Int(Rnd() * 256)
            Dim b = Int(Rnd() * 256)
            With pbox(1)
                ' .BackColor = Color.Blue
                .BackColor = Color.FromArgb(255, r, g, b)
                .Width = 55
                .Height = 23
                .Left = 5 + (i Mod 8) * (.Width + 2)
                .Top = 5 + ((i - 1) \ 8) * 25
            End With
            Me.Controls.Add(pbox(1))
        Next
        dx = 1
        dy = 1
        Timer1.Enabled = True
        Timer1.Interval = 10
    End Sub

    Private Sub Timer1_Tick(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Timer1.Tick
        If x > Me.Width - ballsize Then dx = -1
        If y > Me.Height - ballsize Then dy = -1
        If x < 1 Then dx = 1
        If y < 1 Then dy = 1
        x = x + dx * 10
        y = y + dy * 10
        Me.Refresh()
    End Sub
End Class

2009年4月21日星期二

打磚塊--自動移動擋板版

'自動移動擋板版
Public Class Form1
    Dim pbox(40) As PictureBox
    Dim Ball As Image = My.Resources.ball
    Dim x, y As Integer
    Dim dx, dy As Integer
    Dim ballsize = 36

    Private Sub Form1_Load(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles MyBase.Load
        Randomize()
        Me.Width = 10 + 60 * 8 + 10

Timer1.Interval = 10
Timer1.Enabled = True

        x = 0
        dx = 1
        y = 10
        dy = 1

        Dim i
        For i = 1 To 40
            pbox(i) = New PictureBox
            With pbox(i)
                Dim r = Int(Rnd() * 256)
                Dim g = Int(Rnd() * 256)
                Dim b = Int(Rnd() * 256)
                .BackColor = Color.FromArgb(255, r, g, b)
                .Left = 5 + (i Mod 8) * 60
                .Top = 50 + ((i - 1) \ 8) * 20
                .Width = 59
                .Height = 19
            End With
            Me.Controls.Add(pbox(i))
        Next
    End Sub
    Private Sub Form1_KeyDown(ByVal sender As Object, ByVal e As System.Windows.Forms.KeyEventArgs) Handles Me.KeyDown
        If e.KeyCode = Keys.Right Then PBox1.Left = PBox1.Left + 20
        If e.KeyCode = Keys.Left Then PBox1.Left = PBox1.Left - 20
    End Sub

Private Sub Timer1_Tick(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Timer1.Tick

If x > Me.Width - ballsize Then dx = -1
' If y > 585 - ballsize Then dy = -1

        '
        '
        '自動移動擋板版
        PBox1.Left = x - PBox1.Width / 2
        '
        If y > 585 - ballsize Then
            If (x + ballsize > PBox1.Left) And (x < PBox1.Left + PBox1.Width) Then
                dy = -1
            End If
        End If

If x < 1 Then dx = 1
If y < 1 Then dy = 1

x = x + 10 * dx
y = y + 10 * dy

Me.Refresh()
End Sub

2009年4月20日星期一

打磚塊--部份完成版

'打磚塊--部份完成版
Public Class Form1
    'Dim Ball As Image = Image.FromFile("..\..\resources\ball.gif")
    Dim Ball As Image = My.Resources.ball
    Dim x, y As Integer
    Dim dx, dy As Integer
    Dim ballsize = 36

    Private Sub Form1_KeyDown(ByVal sender As Object, ByVal e As System.Windows.Forms.KeyEventArgs) Handles Me.KeyDown
        If e.KeyCode = Keys.Right Then PBox1.Left = PBox1.Left + 20
        If e.KeyCode = Keys.Left Then PBox1.Left = PBox1.Left - 20
    End Sub

    Private Sub Form1_Load(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles MyBase.Load
        Timer1.Interval = 50
        Timer1.Enabled = True

        x = 0
        dx = 1
        y = 10
        dy = 1
    End Sub

Private Sub Timer1_Tick(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Timer1.Tick

        If x > Me.Width - ballsize Then dx = -1
        If y > 376 - ballsize Then dy = -1
        If x < 1 Then dx = 1
        If y < 1 Then dy = 1

x = x + 10 * dx
y = y + 10 * dy

Me.Refresh()
End Sub

尋找完全數

'尋找完全數
Public Class Form1
    Private Sub Form1_Load(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles MyBase.Load
        Dim t1 As Date = Now
        Dim acct As TimeSpan

        Dim str1 = ""
        Dim c = 0
        Dim i
        Dim n = 6
        For n = 1 To 10000
            Dim s = 0
            For i = 1 To Int(n / 2)
                If n Mod i = 0 Then
                    s = s + i
                End If
            Next
            If s = n Then
                c = c + 1
                acct = Now - t1
                str1 = str1 & c & ":" & n & "-->" & acct.TotalSeconds & "sec" & vbNewLine
            End If
        Next n
        MsgBox(str1)
    End Sub
End Class

2009年4月17日星期五

程式設計儲備選手測驗二成績

姓名	測驗題	程式題	合計得分
紀慈庭	64	20	84
張鈞淇	80	46	126
莊筑鈞	28	30	58
沈孟蓓	52	30	82
鍾佳真	40	30	70
蔡姿儀	60	55	115
葉建佑	68	30	98
楊淳雅	80	30	110
紀慈修	60	40	100

2009年4月16日星期四

打磚塊 -- 畫面準備部份

Public Class Form1
    Dim pbox(40) As PictureBox
    Private Sub Form1_Load(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles MyBase.Load
        Me.Width = 474

2009年4月15日星期三

字數統計

'字數統計
Public Class Form1
    '重覆計算版
    'Private Sub Form1_Load(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles MyBase.Load
    '    Dim str2 = ""
    '    Dim i
    '    Dim c
    '    Dim str1 = "明天會更好，後天會更好，天天更好。明天會更好，後天會更好，天天更好明天會更好，後天會更好，天天更好。明天會更好，後天會更好，天天更好"
    '    ' MsgBox("字串長度為:" & str1.ToString.Length)
    '    Dim j
    '    For j = 1 To str1.ToString.Length
    '        c = 0
    '        For i = 1 To str1.ToString.Length
    '            If Mid(str1, i, 1) = Mid(str1, j, 1) Then c = c + 1
    '        Next
    '        str2 = str2 & Mid(str1, j, 1) & "->共有：" & c & "個" & vbNewLine
    '    Next
    '    MsgBox(str2)
    'End Sub

    '不重覆計算版
    Private Sub Form1_Load(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles MyBase.Load
        Dim strChk = ""
        Dim str2 = ""
        Dim i
        Dim c
        Dim str1 = "明天會更好，後天會更好，天天更好。明天會更好，後天會更好，天天更好明天會更好，後天會更好，天天更好。明天會更好，後天會更好，天天更好"
        ' MsgBox("字串長度為:" & str1.ToString.Length)
        Dim j
        For j = 1 To str1.ToString.Length
            If InStr(strChk, Mid(str1, j, 1)) = 0 Then
                c = 0
                For i = 1 To str1.ToString.Length
                    If Mid(str1, i, 1) = Mid(str1, j, 1) Then c = c + 1
                Next
                str2 = str2 & Mid(str1, j, 1) & "->共有：" & c & "個" & vbNewLine
                strChk = strChk & Mid(str1, j, 1)
            End If
        Next
        MsgBox(str2)
    End Sub
End Class

產生第一至十個 Conway數列項

'產生第一至十個 conway數列項
Public Class Form1
    Private Sub Form1_Load(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles MyBase.Load
        Dim j
        Dim str2 = "1" & vbNewLine
        j = 2
        Dim t = 1
        While j <= 10
            str2 = str2 & conway(t) & vbNewLine
            t = conway(t)
            j = j + 1
        End While
        MsgBox(str2)
    End Sub
    Function conway(ByVal n)
        Dim i, c
        Dim str1 = ""
        i = 1
        c = 0
        While i <= n.ToString.Length
            c = c + 1
            '
            If Mid(n.ToString, i, 1) <> Mid(n.ToString, i + 1, 1) Then
                str1 = str1 & c & Mid(n.ToString, i, 1)
                c = 0
            End If
            i = i + 1
        End While
        conway = str1
    End Function
End Class

訂閱：文章 (Atom)

2009年6月15日 星期一

2009年6月4日 星期四

2009年5月19日 星期二

2009年5月18日 星期一

2009年5月5日 星期二

2009年5月4日 星期一

2009年4月30日 星期四

2009年4月29日 星期三

2009年4月28日 星期二

2009年4月27日 星期一

2009年4月24日 星期五

2009年4月23日 星期四

2009年4月22日 星期三

2009年4月21日 星期二

2009年4月20日 星期一

2009年4月17日 星期五

2009年4月16日 星期四

2009年4月15日 星期三

訂閱

常用連結

標籤

網誌存檔

著作人

總網頁瀏覽量

追蹤者

2009年6月15日星期一

2009年6月4日星期四

2009年5月19日星期二

2009年5月18日星期一

2009年5月5日星期二

2009年5月4日星期一

2009年4月30日星期四

2009年4月29日星期三

2009年4月28日星期二

2009年4月27日星期一

2009年4月24日星期五

2009年4月23日星期四

2009年4月22日星期三

2009年4月21日星期二

2009年4月20日星期一

2009年4月17日星期五

2009年4月16日星期四

2009年4月15日星期三