vb.net 使用A star

关于寻路算法，常见的是A星，不懂的时候会觉得复杂，但是一旦懂了，还是很简单的。

网上有很多相关的算法说明，大家可以先看看，如果实在是不懂，我再写一篇详细点的说明，这里只是把一些基本的代码发出来，大家先看看。

Public Class clsBlockPublic ParentBlock As clsBlockPublic F As IntegerPublic G As IntegerPublic H As IntegerPublic x As IntegerPublic y As IntegerPublic state As IntegerPublic Sub New(ByVal x As Integer, ByVal y As Integer)Me.x = xMe.y = yEnd SubPublic Sub New()End SubPublic Sub CalcF()F = G + HEnd Sub
End Class


Public Class clsMazePublic Const blockStep As Integer = 10Public Const blockOblique As Integer = 14Public Maze(,) As clsBlockPrivate openBlock As List(Of clsBlock)Private closeBlock As List(Of clsBlock)Private MazeWidth As IntegerPrivate MazeHeight As IntegerPrivate startBlock As clsBlockPrivate endBlock As clsBlockPublic Sub New(ByVal maze(,) As clsBlock, ByVal startBlock As clsBlock, ByVal endBlock As clsBlock)Me.Maze = mazeopenBlock = New List(Of clsBlock)(maze.Length)closeBlock = New List(Of clsBlock)(maze.Length)MazeWidth = maze.GetUpperBound(0)MazeHeight = maze.GetUpperBound(1)Me.startBlock = startBlockMe.endBlock = endBlockEnd SubPublic Function FindPath() As clsBlockopenBlock.Add(startBlock)Do While openBlock.Count <> 0Dim msg As String = ""msg = "openBlock："For Each i As clsBlock In openBlockmsg &= i.x & "," & i.y & "," & i.H & "+" & i.G & "  "Next'Console.WriteLine(msg)msg = "closeBlock："For Each i As clsBlock In closeBlockmsg &= i.x & "," & i.y & "," & i.H & "+" & i.G & "  "Next'Console.WriteLine(msg)Dim tmpStart As clsBlock = blockOrderbyF(openBlock)Console.WriteLine("tmpStart: " & tmpStart.x & "," & tmpStart.y)openBlock.RemoveAt(0)closeBlock.Add(tmpStart)Dim surBlock As List(Of clsBlock) = SurroundBlock(tmpStart)For Each singleBlock As clsBlock In surBlockIf openBlock.IndexOf(singleBlock) >= 0 ThenFoundBlock(tmpStart, singleBlock)ElseNotFoundBlock(tmpStart, endBlock, singleBlock)End IfNextIf Not IsNothing(GetBlock(openBlock, endBlock)) ThenReturn GetBlock(openBlock, endBlock)End IfLoopReturn GetBlock(openBlock, endBlock)End FunctionPrivate Function SurroundBlock(ByVal currentBlock As clsBlock) As List(Of clsBlock)Dim sBlock As New List(Of clsBlock)'左右上下If currentBlock.x - 1 >= 0 AndAlso canReach(Maze(currentBlock.x - 1, currentBlock.y)) = True ThensBlock.Add(Maze(currentBlock.x - 1, currentBlock.y))End IfIf currentBlock.x + 1 <= MazeWidth AndAlso canReach(Maze(currentBlock.x + 1, currentBlock.y)) = True ThensBlock.Add(Maze(currentBlock.x + 1, currentBlock.y))End IfIf currentBlock.y - 1 >= 0 AndAlso canReach(Maze(currentBlock.x, currentBlock.y - 1)) = True ThensBlock.Add(Maze(currentBlock.x, currentBlock.y - 1))End IfIf currentBlock.y + 1 <= MazeHeight AndAlso canReach(Maze(currentBlock.x, currentBlock.y + 1)) = True ThensBlock.Add(Maze(currentBlock.x, currentBlock.y + 1))End If'如果是起点For Each aBlock As clsBlock In sBlockIf aBlock.x = startBlock.x And aBlock.y = startBlock.y ThensBlock.Remove(aBlock)Exit ForEnd IfNextReturn sBlockEnd FunctionPrivate Function canReach(ByVal surroundBlock As clsBlock) As BooleanIf closeBlock.IndexOf(surroundBlock) <> -1 ThenReturn FalseEnd IfSelect Case surroundBlock.stateCase 0Return TrueCase ElseReturn FalseEnd SelectEnd Function'按照F值从小到大排列Private Function blockOrderbyF(ByVal blockList As List(Of clsBlock)) As clsBlockDim tmpBlockList As New List(Of clsBlock)tmpBlockList = blockList.OrderBy(Function(e) e.F).ToListopenBlock = tmpBlockListReturn tmpBlockList(0)End FunctionPrivate Sub FoundBlock(ByVal startBlock As clsBlock, ByVal Block As clsBlock)Dim GG = CalcG(startBlock, Block)If G < Block.G ThenBlock.ParentBlock = startBlockBlock.G = GBlock.CalcF()End IfEnd SubPrivate Sub NotFoundBlock(ByVal startBlock As clsBlock, ByVal endBlock As clsBlock, ByVal Block As clsBlock)Block.ParentBlock = startBlockBlock.G = CalcG(startBlock, Block)Block.H = CalcH(endBlock, Block)Block.CalcF()openBlock.Add(Block)End SubPrivate Function CalcG(ByVal startBlock As clsBlock, ByVal Block As clsBlock) As IntegerDim G As Integer = blockStepDim parentG As IntegerIf IsNothing(Block.ParentBlock) ThenparentG = 0ElseparentG = Block.ParentBlock.GEnd IfReturn (G + parentG)End FunctionPrivate Function CalcH(ByVal endBlock As clsBlock, ByVal Block As clsBlock) As IntegerDim singleStep As IntegersingleStep = Math.Abs(Block.x - endBlock.x) + Math.Abs(Block.y - endBlock.y)Return (singleStep * blockStep)End FunctionPrivate Function GetBlock(ByVal blocks As List(Of clsBlock), ByVal block As clsBlock) As clsBlockFor Each singleBlock As clsBlock In blocksIf singleBlock.x = block.x And singleBlock.y = block.y ThenReturn singleBlockEnd IfNextReturn NothingEnd Function
End Class

窗口代码：

    Dim mazeWidth As IntegerDim mazeHeight As IntegerConst paddingTop As Integer = 10Const paddingLeft As Integer = 10Const blocksize As Integer = 20Dim pic(,) As PictureBoxDim block(,) As clsBlockDim startBlock As clsBlockDim endBlock As clsBlock

    Private Sub btnCreat2_Click(sender As Object, e As EventArgs) Handles btnCreat2.ClickmazeWidth = Integer.Parse(txtWidth.Text)mazeHeight = Integer.Parse(txtHeight.Text)ReDim pic(mazeWidth - 1, mazeHeight - 1)For i As Integer = 0 To mazeHeight - 1For j As Integer = 0 To mazeWidth - 1pic(j, i) = New PictureBoxpic(j, i).Width = blocksizepic(j, i).Height = blocksizepic(j, i).Left = paddingLeft + j * blocksizepic(j, i).Top = paddingTop + i * blocksizepic(j, i).BorderStyle = BorderStyle.FixedSinglepic(j, i).BackColor = Color.WhiteMe.Controls.Add(pic(j, i))AddHandler pic(j, i).Click, AddressOf pb_ClickNextNextEnd Sub

    Private Sub pb_Click(sender As Object, e As EventArgs)Dim bkColor As ColorIf rbWall.Checked = True Then bkColor = Color.BlackIf rbRoad.Checked = True Then bkColor = Color.WhiteIf rbStart.Checked = True Then bkColor = Color.RedIf rbEnd.Checked = True Then bkColor = Color.BlueDim pb As PictureBox = CType(sender, PictureBox)pb.BackColor = bkColorEnd Sub

    Private Sub btnAStar_Click(sender As Object, e As EventArgs) Handles btnAStar.ClickCall getMaze()Dim maze As New clsMaze(block, startBlock, endBlock)Dim parent As New clsBlockparent = maze.FindPath()Do While Not IsNothing(parent.ParentBlock)Console.WriteLine("坐标: " & parent.x & "," & parent.y)parent = parent.ParentBlockLoopEnd SubPrivate Sub getMaze()mazeWidth = Integer.Parse(txtWidth.Text)mazeHeight = Integer.Parse(txtHeight.Text)ReDim block(mazeWidth - 1, mazeHeight - 1)For i As Integer = 0 To mazeHeight - 1For j As Integer = 0 To mazeWidth - 1block(j, i) = New clsBlock(j, i)Select Case pic(j, i).BackColorCase Color.Whiteblock(j, i).state = 0Case Color.Blackblock(j, i).state = 1Case Color.Redblock(j, i).state = 0startBlock = New clsBlock(j, i)Case Color.Blueblock(j, i).state = 0endBlock = New clsBlock(j, i)End SelectNextNextEnd Sub

正写这个的时候，居然地震了，虽然我这里不是长宁，但是震感强烈。

愿震区的同胞安好。

vb.net 使用A star相关推荐

VB宏程序实现换行追加符号
关于有这样一个场景,有一次,公司一个同事说,excel表格中,想在每行换行的地方追加"\\"符号,以便该excel表格在导入jira系统的时候,该符号会被系统识别为换行符,方便阅 ...
Windows实时运动控制软核(四):LOCAL高速接口测试之VB.NET
今天,正运动小助手给大家分享一下MotionRT7的安装和使用,以及使用VB.NET对MotionRT7开发的前期准备. 01 MotionRT7简介 MotionRT7是深圳市正运动技术推出的跨平台 ...
vb中可视对象的操作
问题 : 在调试机房结账的部分,这两部分总是出问题,实时错误424. 错误解释: 未找到窗体(错误 424) 后来通过大量的查阅,找到了答案. MSHFlexGrid1是一个"控件" ...
机房收费系统【VB版】——前期准备
前言: 没有源码和参考的机房收费系统,很犯怵的开始,完全不懂如何下手,经过后来小伙伴的交流和巨人的博客. 准备: 1.安装机房收费系统程序 1.1添加ODBC数据源--添加文件DSN--附加数据库-- ...
【VB】学生信息管理系统6——错误调试
因为站在了巨人的肩膀上,在理解代码意思后的调试中,用到之前的别人的CSDN.所以原理查的不是很透彻.这里总结一下我的问题! 1.VB(如下代码)中mrc.EOF = False应该怎么理解呢? Set ...
【VB】学生信息管理系统5——数据库代码
这次学生信息管理系统在代码的理解过程中遇到了一些问题.总结如下: 1. sql server的安装过程各个步骤的意思.在安装SQL Server的时候按照网上的步骤,我觉得这个需要学完整个数据库再返回 ...
【VB】学生信息管理系统4——数据库的发展
由于连接数据的时候出现了很多不懂得问题,为什么要连接,它是怎么连接的,查着查着,就越看越多.又不舍得就这么放过这些问题,所以就耐心看看究竟是怎么回事! 1.自从出现数据库,人们渴望用数据和应用程序做交 ...
【VB】学生信息管理系统2——窗体设计
这次学生系统是照着书敲的,先敲完然后开始调试!中途遇到了很多问题,查了很多,这里不容易系统的总结!所以就针对各个问题,各个击破! 问题一:VB 6.0中,状态栏控件(sbstatusbar):右击选项 ...
【VB】学生信息管理系统1——系统设计怎样开始？
历时两周完成用VB完成的学生信息管理系统.从刚开始只会敲好玩的小程序到现在完整的做出一个像样的系统.自己的编程思维进行了很大的跨越. 这次的学生信息管理系统让我从整体的角度看到了一个系统设计的过程. ...

vb.net 使用A star

vb.net 使用A star相关推荐

最新文章

热门文章