版权说明:本文档由用户提供并上传,收益归属内容提供方,若内容存在侵权,请进行举报或认领
文档简介
1、班級:奈米一乙學號: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 + 步數: + 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 + 總算找到了 + 步數: + 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(迷宮橫向格數=?, 請輸入, 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
温馨提示
- 1. 本站所有资源如无特殊说明,都需要本地电脑安装OFFICE2007和PDF阅读器。图纸软件为CAD,CAXA,PROE,UG,SolidWorks等.压缩文件请下载最新的WinRAR软件解压。
- 2. 本站的文档不包含任何第三方提供的附件图纸等,如果需要附件,请联系上传者。文件的所有权益归上传用户所有。
- 3. 本站RAR压缩包中若带图纸,网页内容里面会有图纸预览,若没有图纸预览就没有图纸。
- 4. 未经权益所有人同意不得将文件中的内容挪作商业或盈利用途。
- 5. 人人文库网仅提供信息存储空间,仅对用户上传内容的表现方式做保护处理,对用户上传分享的文档内容本身不做任何修改或编辑,并不能对任何下载内容负责。
- 6. 下载文件中如有侵权或不适当内容,请与我们联系,我们立即纠正。
- 7. 本站不保证下载资源的准确性、安全性和完整性, 同时也不承担用户因使用这些下载资源对自己和他人造成任何形式的伤害或损失。
最新文档
- 人教版九年级化学上册期末考试题(含答案)
- 2023年人教版九年级语文上册期末试卷含参考答案
- 教科版九年级物理上册期末试卷及答案【学生专用】
- 2023年人教版四年级上册语文期末试卷(加答案)
- 新人教版七年级上册《生物》期末试卷(一套)
- 人教版一年级上册语文《期末》考试题及答案【汇编】
- 试卷分析失分原因和改进措施四年级科学
- 湖南电气职业技术学院 2023年单独招生职业技能测试考试(面试)考试大纲
- XXX矿消防器材配置标准
- 部编版2022年四年级语文上册期末考试题及答案【全面】
- 自然灾害应急处置与防范课件
- 广东华兴银行2023年春季招聘工作人员笔试历年难、易错考点试题含答案带详解
- 小学六年级英语教师家长会课件PPT
- 初中音乐-演唱 在灿烂的阳光下 中国人教学设计学情分析教材分析课后反思
- 重庆市坡地高层民用建筑设计防火规范
- 多发伤伴失血性休克急救演练
- 2024年社会工作者之中级社会工作法规与政策题库附答案(典型题)
- 建筑工程土方车辆管理方案
- 《电信运营商液冷技术白皮书》
- 让孩子不发烧、不咳嗽、不积食(全新修订升级版)
- 2023年全国乙卷数学(理科)
评论
0/150
提交评论