97技藝競賽第8題 -- VB2008版

Public Class Form1
    Dim r1Str = ""
    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(Application.StartupPath & "\Test8.txt")
        Dim recArray() = Split(fileContents, vbNewLine)
        For k = 0 To recArray.Length - 1
            proc_one_rec(recArray, k)
        Next
        'MsgBox(r1Str)
        My.Computer.FileSystem.WriteAllText(Application.StartupPath & "\result8.txt", r1Str, False)
        End
    End Sub
    Sub proc_one_rec(ByVal recArray, ByVal k)
        Dim s = recArray(k)
        Dim n = Math.Ceiling(s.length ^ 0.5)
        Dim a(n + 1, n + 1) As String
        For i = 0 To n + 1
            For j = 0 To n + 1
                If i = 0 Or i = n + 1 Or j = 0 Or j = n + 1 Then
                    a(i, j) = "X"
                Else
                    a(i, j) = "#"
                End If
            Next
        Next
        Dim sindex = 1
        Dim x = 1
        Dim y = 1
        Dim dx = 1
        Dim dy = 0
        Dim dirN = 0
        Dim prex = x
        Dim prey = y
        While sindex <= s.length
            '非空位處理，退回原位置，轉向，前進至下一位置
            If a(x, y) <> "#" Then
                x = prex
                y = prey
                dirN = dirN + 1
                dirN = dirN Mod 4
                If dirN = 0 Then
                    dx = 1
                    dy = 0
                End If
                If dirN = 1 Then
                    dx = 0
                    dy = 1
                End If
                If dirN = 2 Then
                    dx = -1
                    dy = 0
                End If
                If dirN = 3 Then
                    dx = 0
                    dy = -1
                End If
                x = x + dx
                y = y + dy
            End If
            a(x, y) = Mid(s, sindex, 1)
            '保留上次位置
            prex = x
            prey = y
            '取得下次位置，下一個字元
            x = x + dx
            y = y + dy
            sindex = sindex + 1
        End While
        '一次結果
        Dim rStr = ""
        For y = 1 To n
            For x = 1 To n
                rStr = rStr + a(x, y)
            Next
            rStr = rStr & vbNewLine
        Next
        rStr = Replace(rStr, "#", " ")
        r1Str = r1Str & rStr & vbNewLine
    End Sub
End Class

97技藝競賽第8題

Problem8：文字繞圈圈(15%)

已知有一個字串，請找出可以將此字串填入的最小正方形，而填入的方式是由正方形的左上角開始，依順時針蚊香方向由外向內填入。

輸入說明：

每組輸入包含一列字串，字串內的字元皆由英文字母及數字所組成，字串的長度最長不會超過1000個字元。

輸出說明：

對於每組測試資料，輸出填入最小正方形後的結果，每組測試資料以一列空白隔開。

輸入範例：

0123456789ABCDE

111111111111111122222222

輸出範例：

0123

BCD4

A E5

9876

11111

12221

12 21

12221

11111

Public Class Form1
    Dim i, j, ri
    Dim r1Str = ""
    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(Application.StartupPath & "\Test8.txt")
        Dim recArray() = Split(fileContents, vbNewLine)

        For ri = 0 To recArray.Length - 1
            proc_one_rec(recArray)
        Next

        'MsgBox(r1Str)
        My.Computer.FileSystem.WriteAllText(Application.StartupPath & "\result8.txt", r1Str, False)
        End
    End Sub
    Sub proc_one_rec(ByVal recArray)
        Dim s = recArray(ri)
        Dim n = Math.Ceiling(s.length ^ 0.5)

        Dim a(n + 1, n + 1) As String
        For i = 0 To n + 1
            For j = 0 To n + 1
                If i = 0 Or i = n + 1 Or j = 0 Or j = n + 1 Then
                    a(i, j) = "X"
                Else
                    a(i, j) = "#"
                End If
            Next
        Next

        Dim sindex = 1

        Dim x = 1
        Dim y = 1
        Dim dx = 1
        Dim dy = 0
        Dim dirN = 0
        Dim prex = x
        Dim prey = y

        While sindex <= s.length
            '非空位處理，退回原位置，轉向，前進至下一位置
            If a(x, y) <> "#" Then
                x = prex
                y = prey
                dirN = dirN + 1
                dirN = dirN Mod 4
                If dirN = 0 Then
                    dx = 1
                    dy = 0
                End If
                If dirN = 1 Then
                    dx = 0
                    dy = 1
                End If
                If dirN = 2 Then
                    dx = -1
                    dy = 0
                End If
                If dirN = 3 Then
                    dx = 0
                    dy = -1
                End If
                x = x + dx
                y = y + dy
            End If

            a(x, y) = Mid(s, sindex, 1)

            '保留上次位置
            prex = x
            prey = y

            '取得下次位置，下一個字元
            x = x + dx
            y = y + dy

            sindex = sindex + 1
        End While

        '一次結果
        Dim rStr = ""
        For y = 1 To n
            For x = 1 To n
                rStr = rStr + a(x, y)
            Next
            rStr = rStr & vbNewLine
        Next
        rStr = Replace(rStr, "#", " ")
        r1Str = r1Str & rStr & vbNewLine
    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