主题：[分享]走迷宫,走不出去的回贴

好密啊

這麼密，恐怕要走很久吧？...

老娘才沒那個時間在這瞎磨蹭！！...

你就说你笨，别的啥也别说了

你才笨咧！傻子...

你以為老娘我很閑啊？？.....

老娘我忙的狠，沒空玩迷宮.....

最近一直寫字，寫到我的手真是痛的要命，我得在去敷個熱水了！！....

沒空跟你閒聊！！.....

可省了吧，你会写字呀？你会写字，那大象都能跳把蕾了

眼花花

哥哥

我 就不走了~~~

好伐

我花了一晚上的时间，再参考了网上的一些相关资料，编程解决了这个问题

所用工具：Adobe PhotoShop，Microsoft Visual Basic 6.0

分析可得，迷宫主体部分只有两种颜色，黑和白，显然黑色代表障碍。首先用Photoshop剪切掉迷宫图周围的空白，只剩下中间的主体部分，便于编程读取图片中每一个像素的颜色。 然后再进行编程。大致思路如下： 读取图片，用0和1记录迷宫信息，0代表此点可通，1代表此点不通（障碍或边界）。显然我们的目的是找到一条从开始点到结束点之间的路线，这条路线上的每一点都要是0。从开始点开始按照右，上，左，下的顺序搜索下一点，直到发现下一点是通路而且未曾到过或发现四方均不通（死路）。若找到通路，则移动到找到的下一点；若是死路，则退回去，重新搜索。如此这般循环下去，直到“下一点”是目的地。 保存结果。

在程序中所有尝试的步数（即包含走过的“冤枉路”）：21570 成功走出迷宫的最短步数：1781

代码如下：

Option Explicit

'模拟C++中的堆栈，成功走出迷宫的路径 Dim Path(10000) As Point '路径中的当前索引 Dim CurrentIndex As Integer '迷宫矩阵，或迷宫坐标。0代表通且未到过；1代表不通（有障碍）； '2 代表通且曾到过；3 代成功走出迷宫的路径点 Dim MazeLab(-1 To 601, -1 To 401) As Integer '走出迷宫需要的步数 Dim TotleStep As Integer '自定义点类型 Private Type Point X As Integer Y As Integer End Type

Private Sub Command1_Click() Dim i As Integer Dim j As Integer Dim DataStr As String Dim FileName As String Dim tmp As String Dim tmpInt As Integer 'VB中的白色所代表的数值 Const WhiteColorNum As Long = 256& * 256 * 256 - 1 Command1.Enabled = False '保存迷宫矩阵所建立的文本文档 FileName = App.Path & "\data.txt" Open FileName For Output As 1 '打开文件 Label1.Caption = "正在读取图片像素，可能需要几秒的时间，请稍候..." '以下几行，循环读取迷宫图片中的每个像素颜色 'WhiteColorNum代表白色 For i = 0 To 400 DataStr = "" For j = 0 To 600 If Picture1.Point(j, i) = WhiteColorNum Then tmp = "□" Else tmp = "■" If Picture1.Point(j, i) = WhiteColorNum Then tmpInt = 0 Else tmpInt = 1 MazeLab(j, i) = tmpInt DataStr = DataStr & tmp Next Print #1, DataStr Next Close #1 Label1.Caption = "" MsgBox "生成成功，请查看" & FileName Search '搜索能走出迷宫的路径 Command2.Enabled = True End Sub

Private Sub Command3_Click() '把结果以位图形式保存到磁盘 Dim FileName As String FileName = App.Path & "\output.bmp" SavePicture Picture1.Image, FileName MsgBox "保存成功，请查看" & FileName End Sub

Private Sub Form_Load() '窗体初始化 Picture1.Width = 610 * Screen.TwipsPerPixelX Picture1.Height = 410 * Screen.TwipsPerPixelY Me.Width = 700 * Screen.TwipsPerPixelX Me.Height = 550 * Screen.TwipsPerPixelY '加载迷宫图片 Picture1.Picture = LoadPicture(App.Path & "\source.bmp") End Sub

Public Sub Search() '关键函数，寻找迷宫出路 Dim CurX As Integer Dim CurY As Integer Dim i As Integer CurrentIndex = 1 Path(1).X = 0 '迷宫入口点横坐标 Path(1).Y = 200 '迷宫入口点纵坐标 '以下6行是在迷宫的外圈砌一道虚拟的墙，防止越界 For i = -1 To 401 MazeLab(-1, i) = 1 Next For i = -1 To 601 MazeLab(i, -1) = 1 Next '关键循环。搜索能走通的路径，直到走到终点 While Not (CurX = 600 And CurY = 200) CurX = Path(CurrentIndex).X CurY = Path(CurrentIndex).Y '如果当前点右边的点可通且“未来过”（数值0），则…… If MazeLab(CurX + 1, CurY) = 0 Then '向右走 '路径中的下一点横坐标等于当前坐标值加一 Path(CurrentIndex + 1).X = CurX + 1 Path(CurrentIndex + 1).Y = CurY '将当前点设置为“已经来过”（数值2） MazeLab(CurX + 1, CurY) = 2 ElseIf MazeLab(CurX, CurY - 1) = 0 Then '向上走 Path(CurrentIndex + 1).X = CurX Path(CurrentIndex + 1).Y = CurY - 1 MazeLab(CurX, CurY - 1) = 2 ElseIf MazeLab(CurX, CurY + 1) = 0 Then '向下走 Path(CurrentIndex + 1).X = CurX Path(CurrentIndex + 1).Y = CurY + 1 MazeLab(CurX, CurY + 1) = 2 ElseIf MazeLab(CurX - 1, CurY) = 0 Then '向左走 Path(CurrentIndex + 1).X = CurX - 1 Path(CurrentIndex + 1).Y = CurY MazeLab(CurX - 1, CurY) = 2 Else '假如向右、上、下、左等走不通，则退回路径的上一点 CurrentIndex = CurrentIndex - 2 End If CurrentIndex = CurrentIndex + 1 Wend TotleStep = CurrentIndex OutputData '输出结果到文本文档 End Sub

Public Sub OutputData() '将结果以文本数据的形式保存到磁盘 Dim i As Integer Dim j As Integer Dim FileName As String '以下循环将结果路径经过的点状态设置为3 For i = 1 To TotleStep - 2 MazeLab(Path(i).X, Path(i).Y) = 3 Next Dim DataStr As String Dim CurStr As String FileName = App.Path & "\data2.txt" Picture1.Refresh Open FileName For Output As 2 For i = 0 To 400 DataStr = "" For j = 1 To 600 Select Case MazeLab(j, i) Case 0 '该点无障碍且从未到过 CurStr = "□" Case 1 '该点有障碍 CurStr = "■" Case 3 '结果路径！！ CurStr = "★" Case 2 '该点无障碍且曾到过 CurStr = "☆" End Select DataStr = DataStr & CurStr Next Print #2, DataStr Next Close #2 End Sub

Private Sub Command2_Click() '绘制结果图 Dim i As Integer Dim j As Integer Picture1.Picture = LoadPicture Picture1.Cls Picture1.AutoRedraw = True For i = 0 To 400 For j = 0 To 600 Select Case MazeLab(j, i) Case 0 Picture1.PSet (j, i), vbWhite Case 1 Picture1.PSet (j, i), vbBlack Case 3 Picture1.PSet (j, i), vbBlue Case 2 Picture1.PSet (j, i), vbWhite End Select Next Next Picture1.AutoRedraw = False End Sub

程序运行后所生成的结果如下（修改成了GIF格式）：

此主题相关图片如下：

主体部分601*401像素，可利用Photoshop，ACDSee等图象处理软件放大观看

也可在下面附件中观看用文本文档存储的迷宫“数字”信息

附件（限期删除）：迷宫数据矩阵，结果的图片形式及ASCII文本形式，VB源代码，可执行文件

下载信息  [文件大小：   下载次数： ]

点击浏览该文件: