整体来说,算法优劣什么的没考虑过。当时就是想如果我用笔在纸上面画一个迷宫应该怎么画,然后代码就写出来了。可能整体的效率很低。
代码实现两个功能:
1、迷宫绘制:
Main函数就是干这个的。
2、迷宫游戏:
Reset函数用来进行一些初始设定(每次玩之前都要设定一下);
其他的就是利用Excel的Worksheet_SelectionChange函数实现“走步”。
有兴趣的朋友可以拿来玩一玩,消磨时间。
具体的使用:
将整个代码拷贝到Sheet1的编辑框(因为Worksheet_SelectionChange函数的限制)。
然后再Sheet1中建立两个按钮:
第一个按钮名字改成“生成”,指向的宏设置为“Main”;
第二个按钮名字叫“开始”,制定的宏设置为“Reset”。
如果顺序错了可能不好用。VBA我也不是很明白,就是没事琢磨了一下,没有系统的学过。
然后,在“H2”的位置输入迷宫的大小,是一个5~250之间的数字。当然也可以适当的修饰一下。比如附图的形式:
附:代码
'
1--Up
' 0--Down
' 3--Left
' 2--Right
' x--Row ; y--Column
' 本程序算法无所谓快慢,完全按着普通人思维方式完成
Dim iMazeSize As Integer
Dim iMaze( 251 , 251 ) As Variant
Dim x, y, iGetRndRet, iPOrder, iNoWay As Integer
Dim subx, suby As Integer
Dim iStartLine As Integer
Dim bInit As Boolean
Dim bGoStart As Boolean
Dim bDrawing As Boolean
Dim CrtRow, CrtClm As Integer
Dim BckRow, BckClm As Integer
Dim iRowMax, iColumnMax As Integer
Dim iStepCnt As Integer
Sub Reset()
bGoStart = Not bGoStart
If (bGoStart) Then
ActiveSheet.Shapes( " Button 2 " ).Select
Selection.Characters.Text = " 结束 "
iStepCnt = 0
ActiveSheet.Cells( 3 , 8 ) = iStepCnt
BckRow = 6
BckClm = 2
OutMazeColor 6 , 2 , 51
Cells( 6 , 2 ).Select
For i = 7 To ActiveSheet.UsedRange.Rows.Count
For j = 5 To ActiveSheet.UsedRange.Columns.Count
If (Cells(i, j).Interior.ColorIndex = 15 ) Then
iRowMax = i
iColumnMax = j
End If
Next
Next
Else
ActiveSheet.Shapes( " Button 2 " ).Select
Selection.Characters.Text = " 开始 "
End If
End Sub
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If ((bGoStart) And ( Not bDrawing)) Then
CrtRow = ActiveCell.Row
CrtClm = ActiveCell.Column
If Not (bInit) Then
BckRow = 6
BckClm = 2
bInit = True
End If
OutMazeColor BckRow, BckClm, 2
If (( Abs (CrtRow - BckRow) <= 1 ) And ( Abs (CrtClm - BckClm) <= 1 )) Then
If (CrtRow = (iRowMax)) And (CrtClm = (iColumnMax)) Then
MsgBox " Succ! "
bGoStart = False
ActiveSheet.Shapes( " Button 2 " ).Select
Selection.Characters.Text = " 开始 "
OutMazeColor CrtRow, CrtClm, 51
ActiveSheet.Cells(CrtRow, CrtClm).Select
ElseIf (Cells(CrtRow, CrtClm).Interior.ColorIndex <> 2 ) Then
CrtRow = BckRow
CrtClm = BckClm
OutMazeColor CrtRow, CrtClm, 51
ActiveSheet.Cells(BckRow, BckClm).Select
Else
iStepCnt = iStepCnt + 1
ActiveSheet.Cells( 3 , 8 ) = iStepCnt
OutMazeColor CrtRow, CrtClm, 51
ActiveSheet.Cells(CrtRow, CrtClm).Select
End If
Else
CrtRow = BckRow
CrtClm = BckClm
OutMazeColor CrtRow, CrtClm, 51
ActiveSheet.Cells(BckRow, BckClm).Select
End If
BckRow = CrtRow
BckClm = CrtClm
End If
End Sub
' 0--Down
' 3--Left
' 2--Right
' x--Row ; y--Column
' 本程序算法无所谓快慢,完全按着普通人思维方式完成
Dim iMazeSize As Integer
Dim iMaze( 251 , 251 ) As Variant
Dim x, y, iGetRndRet, iPOrder, iNoWay As Integer
Dim subx, suby As Integer
Dim iStartLine As Integer
Dim bInit As Boolean
Dim bGoStart As Boolean
Dim bDrawing As Boolean
Dim CrtRow, CrtClm As Integer
Dim BckRow, BckClm As Integer
Dim iRowMax, iColumnMax As Integer
Dim iStepCnt As Integer
Sub Reset()
bGoStart = Not bGoStart
If (bGoStart) Then
ActiveSheet.Shapes( " Button 2 " ).Select
Selection.Characters.Text = " 结束 "
iStepCnt = 0
ActiveSheet.Cells( 3 , 8 ) = iStepCnt
BckRow = 6
BckClm = 2
OutMazeColor 6 , 2 , 51
Cells( 6 , 2 ).Select
For i = 7 To ActiveSheet.UsedRange.Rows.Count
For j = 5 To ActiveSheet.UsedRange.Columns.Count
If (Cells(i, j).Interior.ColorIndex = 15 ) Then
iRowMax = i
iColumnMax = j
End If
Next
Next
Else
ActiveSheet.Shapes( " Button 2 " ).Select
Selection.Characters.Text = " 开始 "
End If
End Sub
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If ((bGoStart) And ( Not bDrawing)) Then
CrtRow = ActiveCell.Row
CrtClm = ActiveCell.Column
If Not (bInit) Then
BckRow = 6
BckClm = 2
bInit = True
End If
OutMazeColor BckRow, BckClm, 2
If (( Abs (CrtRow - BckRow) <= 1 ) And ( Abs (CrtClm - BckClm) <= 1 )) Then
If (CrtRow = (iRowMax)) And (CrtClm = (iColumnMax)) Then
MsgBox " Succ! "
bGoStart = False
ActiveSheet.Shapes( " Button 2 " ).Select
Selection.Characters.Text = " 开始 "
OutMazeColor CrtRow, CrtClm, 51
ActiveSheet.Cells(CrtRow, CrtClm).Select
ElseIf (Cells(CrtRow, CrtClm).Interior.ColorIndex <> 2 ) Then
CrtRow = BckRow
CrtClm = BckClm
OutMazeColor CrtRow, CrtClm, 51
ActiveSheet.Cells(BckRow, BckClm).Select
Else
iStepCnt = iStepCnt + 1
ActiveSheet.Cells( 3 , 8 ) = iStepCnt
OutMazeColor CrtRow, CrtClm, 51
ActiveSheet.Cells(CrtRow, CrtClm).Select
End If
Else
CrtRow = BckRow
CrtClm = BckClm
OutMazeColor CrtRow, CrtClm, 51
ActiveSheet.Cells(BckRow, BckClm).Select
End If
BckRow = CrtRow
BckClm = CrtClm
End If
End Sub