php a星算法,A*算法VB实例(A星算法（八方向）)

【实例简介】A*(A-Star)算法是一种静态路网中求解最短路径最有效的直接搜索方法，也是解决许多搜索问题的有效算法。算法中的距离估算值与实际值越接近，最终搜索速度越快。

【实例截图】

【核心代码】

Option Explicit

Private Const 障碍 As Integer = 1

Private Const 通道 As Integer = 0

Public Type POINTS

x As Integer

y As Integer

End Type

Private Type AStarNode

pos As POINTS '该节点的坐标

father As POINTS

G As Integer

H As Integer

style As Integer '类型，是否可行走

End Type

Public OpenNum As Integer '开启列表中的总结点数-1

Public CloseNum As Integer '关闭列表中的总结点数-1

Public OpenList() As AStarNode '开启表

Public CloseList() As AStarNode '关闭表

Public AStarMap() As AStarNode '地图

'计算出来的地图尺寸

Private minX As Integer

Private minY As Integer

Private maxX As Integer

Private maxY As Integer

'参数：要寻路的二维地图,寻路起点,寻路终点

'返回值：1找到路径，路径存在AStarPath中 0未找到路径

Public AStarPath() As POINTS '路径

Public PathLength As Integer '路径长度

Public Function AStar(map() As Integer, startP As POINTS, endP As POINTS) As Integer

Dim AstartP As AStarNode '起点

Dim AendP As AStarNode '终点

Dim p As POINTS '指针

Dim ArrLength As Long '数组长度

Dim minFP As AStarNode '最小F值的节点

Dim i As Integer '找最小F值for循环的循环变量

'只算一次，降低时间开销

minX = LBound(map, 1)

maxX = UBound(map, 1)

minY = LBound(map, 2)

maxY = UBound(map, 2)

ArrLength = (UBound(map, 1) - LBound(map, 1) 1) * (UBound(map, 2) - LBound(map, 2) 1) - 1

ReDim OpenList(ArrLength) '确定最大范围

ReDim CloseList(ArrLength)

ReDim AStarPath(ArrLength)

'初始化

OpenNum = -1: CloseNum = -1

PathLength = 0

AstartP.pos = startP '将传进来的坐标转换成AStar的节点类型

AendP.pos = endP

CreateAStarMap map, AstartP, AendP '根据游戏地图创建本次寻路的A星地图

AddOpenList AStarMap(AstartP.pos.x, AstartP.pos.y) '将起点加入开启表

Do

If OpenNum = -1 Then AStar = 0: Exit Do '当开启列表为空时，退出循环(没有找到路径)

'把开启列表中G H值最小的点找出来(有多个相同最小值的话，找出靠前的那个)

minFP = OpenList(0)

For i = 0 To OpenNum

If minFP.G minFP.H > OpenList(i).G OpenList(i).H Then '找数组中最小数

minFP = OpenList(i)

End If

Next i

'把这个点从开启列表中删除，加入到关闭列表

DelOpenList minFP

AddCloseList minFP

'搜索该点的邻居

Call Neighbor_Search(minFP, 0, -1) '上

Call Neighbor_Search(minFP, 0, 1) '下

Call Neighbor_Search(minFP, -1, 0) '左

Call Neighbor_Search(minFP, 1, 0) '右

'这里是八方寻路，用不上可以直接注释掉

Call Neighbor_Search(minFP, -1, -1) '上左

Call Neighbor_Search(minFP, 1, -1) '上右

Call Neighbor_Search(minFP, -1, 1) '下左

Call Neighbor_Search(minFP, 1, 1) '下右

If CheckCloseNode(AendP) = True Then '如果终点在关闭列表中，就说明找到了通路，用回溯的方法记录路径

AStar = 1

'寻找回路

p = AendP.pos

Do

AStarPath(PathLength) = p

PathLength = PathLength 1

p = AStarMap(p.x, p.y).father '指针移动

If p.x = startP.x And p.y = startP.y Then Exit Do

Loop

Exit Function

End If

Loop

AStar = 0

'Debug.Print AStarMap(0, 0).H: Debug.Print AStarMap(1, 1).H

End Function

'根据游戏地图创建AStar的寻路地图

Private Sub CreateAStarMap(map() As Integer, startP As AStarNode, endP As AStarNode)

Dim x As Integer

Dim y As Integer

ReDim AStarMap(maxX - minX, maxY - minY) '根据游戏地图确定寻路地图尺寸

'生成寻路地图

For x = minX To maxX

For y = minY To maxY

If map(x, y) = 1 Then

AStarMap(x, y).style = 障碍

AStarMap(x, y).G = 0 '初始化成0，到需要的时候再重新计算

AStarMap(x, y).H = (Abs(x - endP.pos.x) Abs(y - endP.pos.y)) * 10 '对于相同的起点和终点，H为定值，我们需要在这里一次性计算好(曼哈顿距离)

AStarMap(x, y).pos.x = x

AStarMap(x, y).pos.y = y

ElseIf map(x, y) = 0 Then

AStarMap(x, y).style = 通道

AStarMap(x, y).G = 0

AStarMap(x, y).H = (Abs(x - endP.pos.x) Abs(y - endP.pos.y)) * 10

AStarMap(x, y).pos.x = x

AStarMap(x, y).pos.y = y

End If

Next y

Next x

End Sub

'参数：需要添加进来的节点(添加在线性表的尾部)

Private Function AddOpenList(pos As AStarNode) As Integer

OpenNum = OpenNum 1 '总节点数 1

OpenList(OpenNum) = pos '添加节点

End Function

'参数：需要删除的节点(删除后，将线性表尾部节点补充到删除后的空缺位置，为了减小时间复杂度)

Private Function DelOpenList(pos As AStarNode) As Integer

Dim t As AStarNode '临时节点，用于做变量交换

Dim c As AStarNode '临时节点，用于清空对象

Dim i As Integer

For i = 0 To OpenNum

If OpenList(i).pos.x = pos.pos.x And OpenList(i).pos.y = pos.pos.y Then '找到要删除的节点(目标节点)

t = OpenList(OpenNum) 't指向开启表中最后一个节点

OpenList(OpenNum) = c '删除最后一个节点

OpenList(i) = t '把最后一个节点覆盖到目标节点

OpenNum = OpenNum - 1 '开启表长度-1

Exit For '结束不必要的循环

End If

Next i

End Function

'参数：需要添加进来的节点(添加在线性表的尾部)

Private Function AddCloseList(pos As AStarNode) As Integer

CloseNum = CloseNum 1 '总节点数 1

CloseList(CloseNum) = pos '添加节点

End Function

'确认传入节点是否存在于开启表中

Private Function CheckNode(node As AStarNode) As Boolean

Dim i As Integer

For i = 0 To OpenNum

If OpenList(i).pos.x = node.pos.x And OpenList(i).pos.y = node.pos.y Then '找到了

CheckNode = True

Exit Function

End If

Next i

CheckNode = False

End Function

'确认是否在关闭表里

Private Function CheckCloseNode(node As AStarNode) As Boolean

Dim i As Long

For i = 0 To CloseNum

If CloseList(i).pos.x = node.pos.x And CloseList(i).pos.y = node.pos.y Then '找到了

CheckCloseNode = True

Exit Function

End If

Next i

CheckCloseNode = False

End Function

'功能：

'更新开启表中的G值

Private Sub UpdataG()

Dim i As Integer

For i = 0 To OpenNum

If OpenList(i).G <> AStarMap(OpenList(i).pos.x, OpenList(i).pos.y).G Then

OpenList(i).G = AStarMap(OpenList(i).pos.x, OpenList(i).pos.y).G

End If

Next i

End Sub

Private Sub Neighbor_Search(minFP As AStarNode, offsetX As Integer, offsetY As Integer)

Dim AStep As Integer

'越界检测

If minFP.pos.x offsetX > maxX Or minFP.pos.x offsetX < 0 Or minFP.pos.y offsetY > maxY Or minFP.pos.y offsetY < 0 Then Exit Sub

If offsetX = 0 Or offsetY = 0 Then ' 设置单位花费

AStep = 10

Else

AStep = 14

End If

'如果该邻居不是障碍并且不在关闭表中

If AStarMap(minFP.pos.x offsetX, minFP.pos.y offsetY).style <> 障碍 And CheckCloseNode(AStarMap(minFP.pos.x offsetX, minFP.pos.y offsetY)) = False Then

'AStarMap(minFP.pos.x offsetX, minFP.pos.y offsetY).G = minFP.G AStep '给G赋值

If CheckNode(AStarMap(minFP.pos.x offsetX, minFP.pos.y offsetY)) = True Then '存在于开启表中

If minFP.G AStep < AStarMap(minFP.pos.x offsetX, minFP.pos.y offsetY).G Then '如果走新路径更短就更换父节点

AStarMap(minFP.pos.x offsetX, minFP.pos.y offsetY).G = minFP.G AStep

AStarMap(minFP.pos.x offsetX, minFP.pos.y offsetY).father = minFP.pos

Call UpdataG '更新Openlist中的G值

End If

Else '不存在于开启表中

'设置该邻居的父节点为我们上面找到的最小节点(minFP)

AStarMap(minFP.pos.x offsetX, minFP.pos.y offsetY).father = minFP.pos

'计算该点(邻居)的G值

AStarMap(minFP.pos.x offsetX, minFP.pos.y offsetY).G = minFP.G AStep

'把该点加入开启表中

AddOpenList AStarMap(minFP.pos.x offsetX, minFP.pos.y offsetY)

End If

End If

End Sub