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