VB LEARNING: 4月 2009

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

2009年4月14日星期二

計時器綜合應用

Public Class Form1
    Dim s = 0
    Dim m = 0
    Dim str1 = "綜二○一班明天會更好綜二○一班明天會更好"
    Dim i = 0
    Private Sub Form1_Load(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles MyBase.Load
        Timer1.Enabled = True
        Timer1.Interval = 1000
    End Sub

    Private Sub Timer1_Tick(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Timer1.Tick
        Dim j = i Mod 5 + 1
        s = s + 1
        If s >= 60 Then
            m = m + 1
            s = s - 60
        End If
        Label1.Text = Now
        Label2.Text = m & ":" & s
        With Label3
            .Text = Mid(str1, j, 10)
            .Font = New Font("標楷體", 20, FontStyle.Bold)
            .BackColor = Color.Blue
            .ForeColor = Color.Yellow
        End With
        i = i + 1
    End Sub
End Class

2009年4月13日星期一

質因數

'判斷n是否為質數
'Public Class Form1
'    Private Sub Form1_Load(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles MyBase.Load
'        Dim n = 2
'        Dim c = 0
'        For i As Integer = 1 To n
'            If n Mod i = 0 Then
'                c = c + 1
'            End If
'        Next
'        If c = 2 Then
'            MsgBox(n & "是質數")
'        End If
'    End Sub
'End Class

'練習1：列出1-30的所有質數
'Public Class Form1
'    Dim str1
'    Private Sub Form1_Load(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles MyBase.Load
'        For n As Integer = 1 To 30
'            Dim c = 0
'            For i As Integer = 1 To n
'                If n Mod i = 0 Then
'                    c = c + 1
'                End If
'            Next
'            If c = 2 Then
'                str1 = str1 & n & Space(2)
'            End If
'        Next
'        MsgBox(str1)
'    End Sub
'End Class

'練習2：列出110的所有質因數
Public Class Form1
    Dim str1
    Dim i
    Private Sub Form1_Load(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles MyBase.Load
        Dim n = 110
        Dim j
        For i = 1 To n
            If n 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(2)
            End If
        Next
        MsgBox(n & " 的質因數為: " & str1)
    End Sub
End Class

2009年4月10日星期五

程式設計選手訓練測驗二參考答案

Word版參考答案，請以以下連結下載

http://210.70.76.23/jack/Shared%20Documents/選手篩選二ans.doc

2009年4月9日星期四

求質因數

'求質因數
Public Class Form1
    Dim i, j
    Dim str1
    Private Sub Form1_Load(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles MyBase.Load
        Dim n = 110
        For i = 1 To n
            '判斷是否為因數
            If n Mod i = 0 Then
                '第11-17列判斷是否為質數
                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 & " "
                End If
            End If
        Next
        MsgBox(str1)
    End Sub
End Class

2009年4月8日星期三

求 N 的所有質因數

'求 N 的所有質因數
Public Class Form1
    Dim i
    Dim str1
    Private Sub Form1_Load(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles MyBase.Load
        Dim n = 30
        For i = 1 To n
            If n Mod i = 0 Then
                Dim c = 0
                Dim j
                For j = 1 To i
                    If i Mod j = 0 Then
                        c = c + 1
                    End If
                Next
                If c = 2 Then
                    str1 = str1 & i & " "
                End If
            End If
        Next
        MsgBox(str1)
    End Sub
End Class

找出1-30間的質數

'找出1-30間的質數
Public Class Form1
    Dim i
    Dim n
    Dim str1, str2
    Private Sub Form1_Load(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles MyBase.Load
        str1 = "質數："
        str2 = "非質數："
        For n = 1 To 30
            Dim c = 0
            For i = 1 To n
                If n Mod i = 0 Then
                    c = c + 1
                End If
            Next
            If c = 2 Then
                str1 = str1 & n & " "
            Else
                str2 = str2 & n & " "
            End If
        Next
        MsgBox(str1 & vbNewLine & str2)
    End Sub
End Class

檢查N是不是質數

'檢查N是不是質數
Public Class Form1
    Dim i
    Private Sub Form1_Load(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles MyBase.Load
        Dim n = 17
        Dim c = 0
        For i = 1 To n
            If n Mod i = 0 Then
                c = c + 1
            End If
        Next
        If c = 2 Then
            MsgBox(n & "是質數")
        Else
            MsgBox(n & "非質數")
        End If
    End Sub
End Class

求 N1,N2 的最大公因數

'求 N1,N2 的最大公因數
Public Class Form1
    Dim i
    Dim str1
    Private Sub Form1_Load(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles MyBase.Load
        Dim n1 = 24
        Dim n2 = 60

'Dim n1 = Val(InputBox("請輸入第一個數："))
'Dim n2 = Val(InputBox("請輸入第二個數："))

        For i = 1 To n1
            If n1 Mod i = 0 And n2 Mod i = 0 Then
                str1 = i
            End If
        Next
        MsgBox(str1)
    End Sub
End Class

求 N1,N2 的所有公因數

'求 N1,N2 的所有公因數
Public Class Form1
    Dim i
    Dim str1
    Private Sub Form1_Load(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles MyBase.Load
        'Dim n1 = 24
        'Dim n2 = 60

Dim n1 = Val(InputBox("請輸入第一個數："))
Dim n2 = Val(InputBox("請輸入第二個數："))

        For i = 1 To n1
            If n1 Mod i = 0 And n2 Mod i = 0 Then
                str1 = str1 & i & " "
            End If
        Next
        MsgBox(str1)
    End Sub
End Class

求 N 的所有因數

'求 N 的所有因數
Public Class Form1
    Dim i
    Dim str1
    Private Sub Form1_Load(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles MyBase.Load
        Dim n = 24
        For i = 1 To 24
            If n Mod i = 0 Then
                str1 = str1 & i & " "
            End If
        Next
        MsgBox(str1)
    End Sub
End Class

訂閱：文章 (Atom)

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年4月14日 星期二

2009年4月13日 星期一

2009年4月10日 星期五

2009年4月9日 星期四

2009年4月8日 星期三

訂閱

常用連結

標籤

網誌存檔

著作人

總網頁瀏覽量

追蹤者

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年4月14日星期二

2009年4月13日星期一

2009年4月10日星期五

2009年4月9日星期四

2009年4月8日星期三