1、班級:奈米一乙學(xué)號:49914019姓名:陳聖倫老師:謝慶存,小老鼠走迷宮,程式介面,選擇迷宮開始 老鼠 出口,程式碼,Public Class Form1 Dim PicBox(50, 50) As PictureBox Dim SqWidth, FWidth, FHeight, MazeX, MazeY, k, Totalm, Totaln, x, y, dx, dy, AI, Steps(50, 50) As Integer Dim Map(50, 50) As Integer Dim StepTotal As Integer Dim RandMapVal As Single Dim n

2、ewgames As Boolean Dim title As String Dim cross(50, 50) As Integer Dim InMaze As IO.StreamReader Dim ImPortF, InString As String Dim MapRow, StartPx, StartPy, EndPx, EndPy, TotalStep As Integer,Private Sub Form1_Load(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles MyBase.Load ti

3、tle = 老鼠走迷宮 Me.Text = title Me.ShowPath.Enabled = False Me.Stopmouse.Enabled = False Me.Stopmouse.Enabled = False EditMaze.CheckOnClick = True ToolStatus.Text = 閒置中 newgames = True MazeX = 50 MazeY = 50 SqWidth = 15 FWidth = SqWidth * (MazeX + 3) FHeight = SqWidth * (MazeY + 4) + 40 Me.Width = FWidt

4、h Me.Height = FHeight For i As Integer = 1 To 50 For j As Integer = 1 To 50 Call initial(i, j) Next Next InMaze = IO.File.OpenText(MazeMap.txt) Call MapGen() Me.Text = title End Sub,Sub initial(ByVal i As Integer, ByVal j As Integer) Dim mypic As New PictureBox Me.Controls.Add(mypic) PicBox(i, j) =

5、mypic End Sub Private Sub AddEvents(ByVal CtrlParent As Control) Dim pic As Control For Each pic In CtrlParent.Controls If TypeOf pic Is PictureBox Then AddHandler pic.MouseClick, AddressOf MapEdit End If Next End Sub,Private Sub MapEdit(ByVal sender As Object, ByVal e As System.Windows.Forms.MouseE

6、ventArgs) If NewMap.Enabled = True Then Exit Sub End If ToolStatus.Text = 迷宮編輯中 With DirectCast(sender, PictureBox) If e.Button = Windows.Forms.MouseButtons.Left Then If .Tag = 1 Then .BackColor = Color.White .Tag = 0 Else .BackColor = Color.Black .Tag = 1 End If End If If e.Button = Windows.Forms.M

7、ouseButtons.Right Then If .Tag = 0 Or .Tag = 1 Or .Tag = 3 Then .BackColor = Color.Chocolate .Tag = 2 ElseIf .Tag = 2 Then .BackColor = Color.LawnGreen .Tag = 3 End If End If End With End Sub,Sub newgameset(ByVal i As Integer, ByVal j As Integer) Dim Px, Py As Integer Me.ShowPath.Enabled = True If i

8、 MazeX Or j MazeY Then Px = MazeX * SqWidth Py = MazeY * SqWidth + 15 Map(i, j) = 1 Else Px = i * SqWidth Py = j * SqWidth + 15 End If With PicBox(i, j) .SetBounds(Px, Py, SqWidth, SqWidth) .BackColor = Color.White .Tag = 0 If i = 1 Or j = 1 Or i = MazeX Or j = MazeY Then .BackColor = Color.Black .T

9、ag = 1 End If If i = StartPx And j = StartPy Then .BackColor = Color.Chocolate .Tag = 2 End If If i = EndPx And j = EndPy Then .BackColor = Color.LawnGreen .Tag = 3 End If End With End Sub,Sub retag() If newgames = False Then PicBox(x, y).BackColor = Color.White Else PicBox(StartPx, StartPy).BackCol

10、or = Color.Chocolate PicBox(EndPx, EndPy).BackColor = Color.LawnGreen End If newgames = False Dim i, j As Integer For i = 0 To MazeX For j = 0 To MazeY Steps(i, j) = 100000 If i 0 And j 0 Then With PicBox(i, j) If .Tag = 0 Then .BackColor = Color.White Steps(i, j) = 1 cross(i, j) = 0 ElseIf .Tag = 3

11、 Then Steps(i, j) = 0 .BackColor = Color.LawnGreen ElseIf .Tag = 2 Then Steps(i, j) = 100000 .BackColor = Color.Chocolate Else .BackColor = Color.Black Steps(i, j) = 100000 End If End With End If Next j Next i End Sub,Private Sub ShowPath_Click(ByVal sender As System.Object, ByVal e As System.EventA

12、rgs) Handles ShowPath.Click x = StartPx y = StartPy TotalStep = 0 AI = 1 Call retag() PicBox(EndPx, EndPy).BackColor = Color.LawnGreen Me.Stopmouse.Enabled = True ShowPath.Enabled = False Steps(x, y) = 10000 Timer1.Interval = 100 Timer1.Enabled = True End Sub,Private Sub Timer1_Tick(ByVal sender As

13、System.Object, ByVal e As System.EventArgs) _ Handles Timer1.Tick Dim MinStep As Integer = 10000 Me.Text = title + 步數(shù)： + CStr(TotalStep) ToolStatus.Text = ( & CStr(x) & , & CStr(y) & ) Randomize() k = 0 If Steps(x + 1, y) 2 Then cross(x, y) = cross(x, y) + 1 End If If cross(x, y) 1 Then Steps(x, y)

14、= Steps(x, y) - 1 cross(x, y) = 0 End If,If Steps(x + 1, y) = MinStep Then MinStep = Steps(x + 1, y) k = k + 1 End If If Steps(x, y + 1) = MinStep Then MinStep = Steps(x, y + 1) k = k + 1 End If If Steps(x - 1, y) = MinStep Then MinStep = Steps(x - 1, y) k = k + 1 End If If Steps(x, y - 1) = MinStep

15、 Then MinStep = Steps(x, y - 1) k = k + 1 End If If (PicBox(x + 1, y).Tag = 0 Or PicBox(x + 1, y).Tag = 3) And Steps(x + 1, y) = MinStep And Steps(x + 1, y) 8 Then dx = 1 dy = 0 ElseIf (PicBox(x, y + 1).Tag = 0 Or PicBox(x, y + 1).Tag = 3) And Steps(x, y + 1) = MinStep And Steps(x, y + 1) 8 Then dx

16、= 0 dy = 1 ElseIf (PicBox(x - 1, y).Tag = 0 Or PicBox(x - 1, y).Tag = 3) And Steps(x - 1, y) = MinStep And Steps(x - 1, y) 8 Then dx = -1 dy = 0 ElseIf (PicBox(x, y - 1).Tag = 0 Or PicBox(x, y - 1).Tag = 3) And Steps(x, y - 1) = MinStep And Steps(x, y - 1) 8 Then dx = 0 dy = -1 Else,Call fittness()

17、End If x = x + dx y = y + dy If x = EndPx And y = EndPy Then TotalStep = TotalStep + 1 Me.Text = title + 總算找到了 + 步數(shù)： + CStr(TotalStep) PicBox(x, y).BackColor = Color.Chocolate PicBox(x - dx, y - dy).BackColor = Color.White ShowPath.Enabled = True Timer1.Enabled = False Stopmouse.Enabled = False Exit

18、 Sub End If If PicBox(x, y).Tag = 0 Then PicBox(x, y).BackColor = Color.Chocolate PicBox(x - dx, y - dy).BackColor = Color.White TotalStep = TotalStep + 1 Else x = x - dx y = y - dy End If Steps(x, y) = Steps(x, y) + 1 If Steps(x, y) 20 Then Call retag() End Sub,Sub fittness() Dim Rn, Sums, Fitness(

19、4) As Single Randomize() Rn = Rnd() Sums = Steps(x + 1, y) + Steps(x, y + 1) + Steps(x - 1, y) + Steps(x, y - 1) Fitness(1) = (Sums - Steps(x + 1, y) / (Sums * 3) Fitness(2) = (Sums - Steps(x, y + 1) / (Sums * 3) Fitness(3) = (Sums - Steps(x - 1, y) / (Sums * 3) Fitness(4) = (Sums - Steps(x, y - 1)

20、/ (Sums * 3) For i As Integer = 2 To 4 Fitness(i) = Fitness(i - 1) + Fitness(i) Next If Rn Fitness(1) Then dx = 1 dy = 0 ElseIf Rn Fitness(2) Then dx = 0 dy = 1 ElseIf Rn Fitness(3) Then dx = -1 dy = 0 Else dx = 0 dy = -1 End If End Sub,Private Sub GameOver_Click(ByVal sender As System.Object, ByVal

21、 e As System.EventArgs) Handles GameOver.Click End End Sub Private Sub Stopmouse_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Stopmouse.Click PicBox(x, y).BackColor = Color.White PicBox(StartPx, StartPy).BackColor = Color.Chocolate Timer1.Enabled = False ShowPath.Enabled

22、 = True Stopmouse.Enabled = False Call retag() End Sub Private Sub X25_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles X25.Click MazeX = 25 MazeY = 25 StartPx = 1 StartPy = 2 EndPx = MazeX EndPy = MazeY - 1 Me.Text = title SqWidth = 15 FWidth = SqWidth * (MazeX + 3) FHeight

23、 = SqWidth * (MazeY + 4) + 40 Me.Width = FWidth Me.Height = FHeight For i As Integer = 1 To 50 For j As Integer = 1 To 50 Call newgameset(i, j) Next Next Me.Refresh() End Sub,Private Sub X50_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles X50.Click Me.Text = title MazeX = 5

24、0 MazeY = 50 StartPx = 1 StartPy = 2 EndPx = MazeX EndPy = MazeY - 1 SqWidth = 10 FWidth = SqWidth * (MazeX + 3) FHeight = SqWidth * (MazeY + 4) + 40 Me.Width = FWidth Me.Height = FHeight For i As Integer = 1 To MazeX For j As Integer = 1 To MazeY Call newgameset(i, j) Next Next Me.Refresh() End Sub

25、,Private Sub menual_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles menual.Click Me.Text = title askx: MazeX = Val(InputBox(迷宮橫向格數(shù)=?, 請輸入, 25) If MazeX 50 Then MsgBox(不得大於) GoTo askx End If If MazeX 50 Then MsgBox(不得大於) GoTo asky End If If MazeY 5 Then MsgBox(不得小於) GoTo ask

26、y End If If MazeY = 25 Then SqWidth = 15 Else SqWidth = 10 End If StartPx = 1 StartPy = 2 EndPx = MazeX EndPy = MazeY - 1 FWidth = SqWidth * (MazeX + 3) FHeight = SqWidth * (MazeY + 4) + 40 Me.Width = FWidth Me.Height = FHeight For i As Integer = 1 To 50 For j As Integer = 1 To 50 Call newgameset(i,

27、 j) Next Next Me.Refresh() End Sub,Private Sub ImportMaze_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles ImportMaze.Click Me.Text = title On Error Resume Next OpenFileDialog1.FileName = OpenFileDialog1.Filter = 迷宮輸入檔(*.txt)|*.txt OpenFileDialog1.ShowDialog() ImPortF = Open

28、FileDialog1.FileName If ImPortF = Then Exit Sub InMaze = IO.File.OpenText(ImPortF) Call MapGen() InMaze.Close() End Sub,Sub MapGen() Dim Lndata As Array MapRow = 0 Do If InMaze.EndOfStream Then Exit Do MapRow = MapRow + 1 InString = InMaze.ReadLine If InString.Contains(,) Then Lndata = Split(InStrin

29、g, ,) ElseIf InString.Contains( ) Then Lndata = Split(Trim(InString), ) Else Lndata = InString.ToCharArray End If For i As Integer = 0 To UBound(Lndata) Map(i + 1, MapRow) = Val(Lndata(i) Next MazeX = UBound(Lndata) + 1 Loop MazeY = MapRow If MazeX 50 Or MazeY 50 Then MsgBox(超過地圖大小(50 x 50)的限制) Exit

30、 Sub End If If MazeY = 25 Then SqWidth = 15 Else SqWidth = 10 End If FWidth = SqWidth * (MazeX + 3) FHeight = SqWidth * (MazeY + 4) + 40 Me.Width = FWidth Me.Height = FHeight For i As Integer = 1 To 50 For j As Integer = 1 To 50 Call newgameset(i, j) If Map(i, j) = 1 Then With PicBox(i, j) .BackColo

31、r = Color.Black .Tag = 1 End With ElseIf Map(i, j) = 2 Then StartPx = i StartPy = j With PicBox(i, j) .BackColor = Color.Chocolate .Tag = 2 End With ElseIf Map(i, j) = 3 Then EndPx = i EndPy = j With PicBox(i, j) .BackColor = Color.LawnGreen .Tag = 3 End With Else With PicBox(i, j) .BackColor = Colo

32、r.White .Tag = 0 End With End If Next Next Call ChkMap() Me.Refresh() End Sub,Private Sub ExportMaze_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles ExportMaze.Click Me.Text = title On Error Resume Next Dim ExMaze As IO.StreamWriter Dim ExPortF, StringLn As String SaveFileD

33、ialog1.FileName = SaveFileDialog1.Filter = 迷宮輸出檔(*.txt)|*.txt SaveFileDialog1.ShowDialog() ExPortF = SaveFileDialog1.FileName If ExPortF = Then Exit Sub ExMaze = New IO.StreamWriter(ExPortF) For j As Integer = 1 To MazeY StringLn = For i As Integer = 1 To MazeX StringLn = StringLn + CStr(PicBox(i, j

34、).Tag) Next ExMaze.WriteLine(StringLn.TrimEnd) Next ExMaze.Close() End Sub,Private Sub EditMaze_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles EditMaze.Click Me.Text = title NewMap.Enabled = Not NewMap.Enabled ImportMaze.Enabled = Not ImportMaze.Enabled ExportMaze.Enabled

35、= Not ExportMaze.Enabled ShowPath.Enabled = Not ShowPath.Enabled Call AddEvents(Me) newgames = True Call retag() If NewMap.Enabled = True Then Call ChkMap() ToolStatus.Text = 閒置中 Else ToolStatus.Text = 迷宮編輯中 End If End Sub,Sub ChkMap() Dim mazein, mazeout As Integer For i As Integer = 1 To MazeX For

36、 j As Integer = 1 To MazeY If PicBox(i, j).Tag = 2 Then StartPx = i StartPy = j mazein = mazein + 1 End If If PicBox(i, j).Tag = 3 Then EndPx = i EndPy = j mazeout = mazeout + 1 End If Next Next PicBox(StartPx, StartPy).BackColor = Color.Chocolate PicBox(EndPx, EndPy).BackColor = Color.LawnGreen If mazein 1 Or mazeout 1 Then MsgBox(有兩個以上的入口或出口，請重新編輯地圖) NewMap.Enabled = N