好密啊

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

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

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

你才笨咧！傻子...

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

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

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

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

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

眼花花

哥哥

我 就不走了~~~

好伐

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

所用工具：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源代码，可执行文件

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

点击浏览该文件: