0xDe

 

#Region "洪水演算法"
    Private Sub ButtonStart_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles ButtonStart.Click
        ' 呼叫洪水演算法
        Type = 0
        Me.Text = Me.Tag
        Dim NowID = 2
        MazeOK = 0
        ' 先向外擴散一次
        GreatDelugeAlgorithm(RouteQueue(0) + 1, RouteQueue(1), NowID, "") ' 上
        GreatDelugeAlgorithm(RouteQueue(0) - 1, RouteQueue(1), NowID, "") ' 下
        GreatDelugeAlgorithm(RouteQueue(0), RouteQueue(1) + 1, NowID, "") ' 右
        GreatDelugeAlgorithm(RouteQueue(0), RouteQueue(1) - 1, NowID, "") ' 左
        NowID = NowID + 1
        Do Until MazeOK = 1
            For i = 12 To 53
                For j = 6 To 70
                    If Val(Maze_Great(i, j)) = (NowID - 1) Then
                        GreatDelugeAlgorithm(i + 1, j, NowID, "")
                        GreatDelugeAlgorithm(i - 1, j, NowID, "")
                        GreatDelugeAlgorithm(i, j + 1, NowID, "")
                        GreatDelugeAlgorithm(i, j - 1, NowID, "")
                    End If
                Next j
            Next i
            NowID = NowID + 1 ' 設定起始編號(向外擴散)
        Loop
        NowID = NowID - 1 ' 把最後的扣除

        For i = 1 To UBound(Maze_Great, 1)
            For j = 1 To UBound(Maze_Great, 2)
                If Val(Maze_Great(i, j)) >= 2 Then
                    Select Case NowID - Val(Maze_Great(i, j))
                        Case Is > 80
                            Maze_Array(i, j).BackColor = Color.FromArgb(0, 102, 204)
                        Case Is > 65
                            Maze_Array(i, j).BackColor = Color.FromArgb(0, 115, 230)
                        Case Is > 40
                            Maze_Array(i, j).BackColor = Color.FromArgb(0, 127, 255)
                        Case Is > 25
                            Maze_Array(i, j).BackColor = Color.FromArgb(41, 148, 255)
                        Case Is > 15
                            Maze_Array(i, j).BackColor = Color.FromArgb(71, 163, 255)
                        Case Is > 10
                            Maze_Array(i, j).BackColor = Color.FromArgb(102, 178, 255)
                        Case Is > 7
                            Maze_Array(i, j).BackColor = Color.FromArgb(133, 194, 255)
                        Case Is > 5
                            Maze_Array(i, j).BackColor = Color.FromArgb(153, 204, 255)
                        Case Is > 3
                            Maze_Array(i, j).BackColor = Color.FromArgb(173, 214, 255)
                        Case Is > 2
                            Maze_Array(i, j).BackColor = Color.FromArgb(194, 223, 255)
                        Case Is > 1
                            Maze_Array(i, j).BackColor = Color.FromArgb(209, 233, 255)
                        Case Is = 1
                            Maze_Array(i, j).BackColor = Color.FromArgb(235, 244, 255)
                    End Select
                End If
            Next j
        Next i
        ' 回朔到起點
        Dim EndID = NowID - 1 ' 最後一位
        ' 從終點開始回朔
        Dim EY = RouteQueue(UBound(RouteQueue) - 2)
        Dim EX = RouteQueue(UBound(RouteQueue) - 1)
        Do Until EndID <= 1
            If ReGreatDelugeAlgorithm(EY + 1, EX, EndID) = 1 Then ' 上
                EndID = EndID - 1
                EY = EY + 1
                EX = EX
            ElseIf ReGreatDelugeAlgorithm(EY - 1, EX, EndID) = 1 Then ' 下
                EndID = EndID - 1
                EY = EY - 1
                EX = EX
            ElseIf ReGreatDelugeAlgorithm(EY, EX + 1, EndID) = 1 Then ' 右
                EndID = EndID - 1
                EY = EY
                EX = EX + 1
            ElseIf ReGreatDelugeAlgorithm(EY, EX - 1, EndID) = 1 Then ' 左
                EndID = EndID - 1
                EY = EY
                EX = EX - 1
            End If
        Loop

    End Sub
    Function GreatDelugeAlgorithm(ByVal SY As Integer, ByVal SX As Integer, ByVal ID As Integer, ByVal StackData As String) ' 洪水演算法
        If (SY > 0 And SY < UBound(Maze_Great, 1)) And (SX > 0 And SX < UBound(Maze_Great, 2)) Then ' 在範圍內
            If (SY = RouteQueue(UBound(RouteQueue) - 2)) And (SX = RouteQueue(UBound(RouteQueue) - 1)) Then ' 如果是終點
                MazeOK = 1
            ElseIf Val(Maze_Great(SY, SX)) = 1 Then ' 如果是道路或編號
                Maze_Great(SY, SX) = ID  ' 給它編號
                Yes = 1
            End If
        End If
    End Function
    Function ReGreatDelugeAlgorithm(ByVal SY As Integer, ByVal SX As Integer, ByVal ID As Integer)
        If (SY > 0 And SY < UBound(Maze_Great, 1)) And (SX > 0 And SX < UBound(Maze_Great, 2)) Then ' 在範圍內
            If Val(Maze_Great(SY, SX)) = ID Then ' 回到上個點
                Maze_Array(SY, SX).BackColor = Color.Chartreuse
                Return 1 ' 有
            End If
        End If
        Return 0 ' 無
    End Function
#End Region

 

#0xDe 從分享中學習

#Facebook：ProgrammerDe (https://www.facebook.com/MicrosoftDes) 有問題歡迎提問