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

迴文判斷

'迴文判斷
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

高中生程式解題系統

http://zerojudge.tw/

尋找完全數

'尋找完全數
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

字數統計

'字數統計
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

10 個 Internet 上的 VB 資源

MSDN Library

VBForDummies.net

Channel 9

ASP.NET Web

The Microsoft Public Newsgroups

.NET 247

Google CodeSearch

kbAlertz

CodePlex

Microsoft Google for Searching

 

摘自：Visual Basic 2008 FOR DUMmIES

書籍推薦

美麗程式：頂尖程式設計師的思考方式 Leading Programmers Explain How They Think

中文版：http://www.books.com.tw/exep/prod/booksfile.php?item=0010399005#catalog

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

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

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