[Visual Basic 6.0] 洪水演算法解老鼠走迷宮與最短路徑問題

2013-11-01

摘要:[Visual Basic 6.0] 洪水演算法解老鼠走迷宮與最短路徑問題


Dim RootXY() ' 迷宮二維陣列
'-----------------------------
Private Sub Form_Load()
For I = 0 To 80
    Root(I).Visible = False
Next I
End Sub
'-----------------------------
Private Sub Exit_Click()
End ' 結束
End Sub
'-----------------------------
Private Sub Initialize9x9maze_Click() ' 建立迷宮
For I = 0 To 80 ' 初始化
    Root(I).Visible = True
    Root(I).Tag = "0" ' 全部預設為 0 等於 未拜訪
    Root(I).BackColor = &H80000005 ' 顏色等於白色
Next I
End Sub
'-----------------------------
Private Sub Attach_Obstacles_into_maze_Click() ' 建立牆壁

ObsNumber = 0

Do Until ObsNumber = Val(ObstaclesNumber)
    Inp = Int(Rnd * 81)
    
    If Root(Inp).Tag = "0" Then
        Root(Inp).Tag = "G" ' 預設 G 為牆壁
        Root(Inp).BackColor = vbBlack
        ObsNumber = ObsNumber + 1
    End If
Loop
End Sub
'-----------------------------
Private Sub Attach_S_and_T_into_maze_Click() ' 產生 S 和 T
ReS:
S = Int(Rnd * 81)
If Root(S).Tag = "0" Then Root(S).Tag = "S": Root(S).BackColor = vbGreen: Root(S).Print "S" Else GoTo ReS
ReT:
T = Int(Rnd * 81)
If Root(T).Tag = "0" Then Root(T).Tag = "T": Root(T).BackColor = vbBlue: Root(T).Print "T" Else GoTo ReT
End Sub
'-----------------------------
Private Sub Find_shortest_path_Click()
' 匯入迷宮到二維陣列
ReDim RootXY(1 To 9, 1 To 9)
Dim MyMazeInpX, MyMazeInpY


K = 0

For I = 1 To 9
    For J = 1 To 9
        RootXY(J, I) = Root(K).Tag
        If Root(K).Tag = "S" Then MyMazeInpX = J: MyMazeInpY = I
        K = K + 1
    Next J
Next I

K = 0

For I = 1 To 9
    For J = 1 To 9
        RootXY(J, I) = Root(K).Tag
        If Root(K).Tag = "T" Then OuverX = J: OuverY = I
        K = K + 1
    Next J
Next I

YesOrNo = "No"

Call GORun(MyMazeInpX + 1, MyMazeInpY, 1)
Call GORun(MyMazeInpX - 1, MyMazeInpY, 1)
Call GORun(MyMazeInpX, MyMazeInpY + 1, 1)
Call GORun(MyMazeInpX, MyMazeInpY - 1, 1)

For K = 1 To 81
    For I = 1 To 9
        For J = 1 To 9
            If RootXY(I, J) = K Then
                Call GORun(I + 1, J, K + 1)
                Call GORun(I - 1, J, K + 1)
                Call GORun(I, J + 1, K + 1)
                Call GORun(I, J - 1, K + 1)
            End If
        Next J
    Next I
Next K
    MsgBox Me.Tag
End Sub



Sub GORun(x, y, ID)
    If x < 10 And x > 0 And y < 10 And y > 0 Then
        If RootXY(x, y) = "S" Then
        ElseIf RootXY(x, y) = "T" And YesOrNo = "No" Then
            YesOrNo = "Yes - " & ID
        ElseIf RootXY(x, y) = "0" Then
            RootXY(x, y) = ID
            ShowNow
        End If
    End If
    

End Sub

Sub ShowNow()
    K = 0
    For I = 1 To 9
        For J = 1 To 9
            Root(K).Cls
            Root(K).Print RootXY(J, I)
            K = K + 1
        Next J
    Next I
End Sub

迷宮搜尋系統.rar

#0xDe 從分享中學習

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

回首頁