quote:以下是引用like821080在2013-07-19 15:43:17的发言：
迷宫形状

' (2,1)
' ■↓■■■■■■■
' ■ ■
' ■ ■ ■■ ■
' ■ ■■ ■ ■
' ■ ■ ■ ■
' ■ ■■ ■ ■
' ■ ■■ ■■
' ■ ■ ■
' ■■■■■■■↓■
' (8,9)
Const x = 9: Const y = 9 '迷宫大小

Const xIn = 2: Const yIn = 1
Const xExit = 8: Const yExit = 9 '出口位置

'迷宫数据
Const Data = "101111111100000001101001101101100101100010101101100101100011011101000001111111101"

'为了使坐标统一,我们不使用a(0,0)..
Dim a(x, y) As Integer '迷宫数组

Dim nx As Integer, ny As Integer '记录当前x,y值
Dim xs(x * y), ys(x * y) As Integer '存放已行路线各步x,y值
Dim s(x * y) As Integer '存放已行各步路线前进方向

Dim p As Integer '深度搜索指针
Dim d As Integer '搜索走向指针 1-右,2-上,3-左,4-下

Dim v(4, 2) As Integer '走向

'动态添加一个Label
Private WithEvents Label1 As Label

Private Sub Form_Load()
Set Label1 = Me.Controls.Add("VB.Label", "Label1")
Label1.BackColor = &H8000000D
Label1.Width = 100
Label1.Height = 100
End Sub

Private Sub Form_Click()
'初始化迷宫形状和数据
Cls
Dim i As Integer, j As Integer
For j = 1 To 9
For i = 1 To 9
a(i, j) = Mid(Data, (j - 1) * 9 + i, 1)
Form1.CurrentX = (i - 1) * 150 + 500
Form1.CurrentY = (j - 1) * 150 + 500
If a(i, j) = "1" Then
Print "■"
Else
Print " "
End If
Next i
Next j

Label1.Visible = True
Label1.Move (xIn - 1) * 150 + 520, (yIn - 1) * 150 + 520, 100, 100

'初始化走向
'此处有个Bug...开始时搜索路径可能会跑到迷宫外
'搜索走向优先级:右-下-上-左
v(1, 1) = 1 'x轴上向右
v(1, 2) = 0 'y轴上向右
v(2, 1) = 0 'x轴上向下
v(2, 2) = 1 'y轴上向下
v(3, 1) = 0 'x轴上向上
v(3, 2) = -1 'y轴上向上
v(4, 1) = -1 'x轴上向左
v(4, 2) = 0 'y轴上向左

'初始化入口等数据
nx = xIn: ny = yIn: p = 0: xs(p) = nx: ys(p) = ny: d = 0

Do
d = d + 1 '搜索前进方向
If d <= 4 Then '前进方向有效

If a(xs(p) + v(d, 1), ys(p) + v(d, 2)) = 0 Then '如果此处是空地
nx = xs(p) + v(d, 1): ny = ys(p) + v(d, 2) '前进
p = p + 1 '进栈
s(p) = d: xs(p) = nx: ys(p) = ny '数据存入数组
a(nx, ny) = 2 '标记,不能再走
d = 0 '全新方位搜索

Label1.Move (nx - 1) * 150 + 520, (ny - 1) * 150 + 520, 100, 100
STime '延时
End If
Else
'方便看出不可走的地方
Label1.Move (xs(p) - 1) * 150 + 520, (ys(p) - 1) * 150 + 520, 100, 100
Form1.CurrentX = (xs(p) - 1) * 150 + 520
Form1.CurrentY = (ys(p) - 1) * 150 + 500
Form1.Print "-"
STime '延时
d = s(p) '取出前进方向
p = p - 1 '出栈
End If
Loop Until nx = xIn And ny = yIn And d > 4 Or nx = xExit And ny = yExit '如果回到出点或抵达终点结束循环

If nx = xIn And ny = yIn Then '如果回到起点
MsgBox "No Way!" '无路可走
Else
For i = 1 To p '输出路径
Form1.CurrentX = (xs(i) - 1) * 150 + 520
Form1.CurrentY = (ys(i) - 1) * 150 + 500
Form1.Print "*"
Next i
End If
End Sub

'延时,方便看效果
Private Sub STime()
Dim ii As Integer
For ii = 0 To 6000
DoEvents: DoEvents: DoEvents
Next ii
End Sub


这个是VB编写的，我在网上找到的

---