智能控制作业.docx

1、智能控制作业一、A*寻路算法Attribute VB_Name = mFindPathOption ExplicitDim arrBap() As bPoint 地图状态Dim arrOpen() As fsPoint 开放列表 Dim lOpenSize As Long 开放列表元素个数Dim TCount As Long 目标序号A*寻路函数输入参数 arrMap() as fsPoint 地图障碍物数据 arrPath() as long 路径列表 lPathCount as long 路径长度 pStartPoint as fsPoint 起始点 pGotoPoint as fsPoi

2、nt 目标点 lWidth as long 地图宽度 lHeight as long 地图高度输出参数 类型:long 寻路结果 3 地图格式不正确 2 目标为障碍点 1 寻路成功 0 寻路失败 无法到达 4 已经到达终点 5 目标被占 6 寻路过程中发生错误Public Function fPath(arrMap() As fsPoint, arrPath() As Long, lPathCount As Long, pStartPoint As fsPoint, pGotoPoint As fsPoint, lWidth As Long, lHeight As Long) As Long

3、寻路 Dim i As Long 循环用变量 Dim Count As Long 点的序号或者总数 Dim pCurrentPoint As fsPoint Dim pSearchPoint As fsPoint Dim pSearchX As Long, pSearchY As Long Dim tmpX As Long, tmpY As Long Dim arrXofs(8) As Long, arrYofs(8) As Long XY变化常量数组 Dim arrIofs(8) As Long 序号变化常量数组 Dim tmpOfs As Long 序号变化量On Error GoTo P

4、athErr: 判断地图 If lWidth 1 Or lHeight lHeight - 1 Or pGotoPoint.X lWidth - 1 Then fPath = 2 Exit Function End If If arrMap(TCount).B Or arrMap(TCount).D Then 可以通过或者是门点 fPath = 0 Else 否则退出寻路 fPath = 2 Exit Function End If If arrMap(TCount).lNpcId 0 Then fPath = 5 Exit Function End If If pGotoPoint.Y =

5、pStartPoint.Y And pGotoPoint.X = pStartPoint.X Then fPath = 4 Exit Function End If 设置常数数组 该数组决定了寻路的优先顺序 arrXofs(0) = -1 arrXofs(1) = 1 arrXofs(2) = -1 arrXofs(3) = 1 arrXofs(4) = -1 arrXofs(5) = 1 arrXofs(6) = 0 arrXofs(7) = 0 arrYofs(0) = -1 arrYofs(1) = 1 arrYofs(2) = 1 arrYofs(3) = -1 arrYofs(4)

6、= 0 arrYofs(5) = 0 arrYofs(6) = -1 arrYofs(7) = 1 tmpOfs = 0 - lWidth arrIofs(0) = tmpOfs - 1 arrIofs(1) = lWidth + 1 arrIofs(2) = lWidth - 1 arrIofs(3) = tmpOfs + 1 arrIofs(4) = -1 arrIofs(5) = 1 arrIofs(6) = tmpOfs arrIofs(7) = lWidth 初始化数据 Count = lWidth * lHeight 地图总点数 ReDim arrBap(Count) 清空所有需要

7、用到的列表 ReDim arrOpen(Count) 起始点进入开放列表 Count = pStartPoint.Y * lWidth + pStartPoint.X pStartPoint.Index = Count tmpX = Abs(pStartPoint.X - pGotoPoint.X) tmpY = Abs(pStartPoint.Y - pGotoPoint.Y) pStartPoint.G = 0 If tmpX tmpY Then pStartPoint.H = tmpX Else pStartPoint.H = tmpY End If pStartPoint.F = pS

8、tartPoint.G + pStartPoint.H arrBap(Count).Parent = 0 arrBap(Count).aIndex = 1 arrOpen(1) = pStartPoint lOpenSize = 1 Do While lOpenSize 0 pCurrentPoint = pBinaryHeapDelete() Count = pCurrentPoint.Index arrBap(Count).bClose = True arrBap(Count).aIndex = 0 For i = 0 To 7 pSearchPoint.X = pCurrentPoint

9、.X + arrXofs(i) pSearchPoint.Y = pCurrentPoint.Y + arrYofs(i) Count = pCurrentPoint.Index + arrIofs(i) pSearchPoint.Index = Count If Count = TCount Then 就是终点 arrBap(Count).Parent = pCurrentPoint.Index 保存路径 lPathCount = -1 Do While arrBap(Count).Parent 0 lPathCount = lPathCount + 1 arrPath(lPathCount

10、) = Count Count = arrBap(Count).Parent Loop 起始点放入最后 arrPath(lPathCount + 1) = Count fPath = 1 Exit Function Else If arrMap(Count).B And arrMap(Count).lNpcId = 0 Then 不是障碍点 If Not arrBap(Count).bClose Then 不在关闭列表 pSearchPoint.G = pCurrentPoint.G + 1 tmpX = Abs(pSearchPoint.X - pGotoPoint.X) tmpY = Ab

11、s(pSearchPoint.Y - pGotoPoint.Y) pStartPoint.G = 0 If tmpX tmpY Then pSearchPoint.H = tmpX Else pSearchPoint.H = tmpY End If pSearchPoint.F = pSearchPoint.G + pSearchPoint.H If arrBap(Count).aIndex 0 Then If pSearchPoint.F 0 Then If arrOpen(lSelectIndex).F 0 Then arrOpen(1) = arrOpen(lOpenSize + 1)

12、lSelectIndex = 1 arrBap(arrOpen(lSelectIndex).Index).aIndex = lSelectIndex 比较子节点 Do While True lLeftChildIndex = lSelectIndex * 2 lRightChildIndex = lLeftChildIndex + 1 If lLeftChildIndex lOpenSize Then 没有左子节点 则结束 Exit Do Else If lLeftChildIndex = lOpenSize Then 只有左子节点 If arrOpen(lSelectIndex).F arr

13、Open(lLeftChildIndex).F Then 父节点F值大 则交换 tmpPoint = arrOpen(lSelectIndex) arrOpen(lSelectIndex) = arrOpen(lLeftChildIndex) arrOpen(lLeftChildIndex) = tmpPoint arrBap(arrOpen(lSelectIndex).Index).aIndex = lLeftChildIndex arrBap(arrOpen(lLeftChildIndex).Index).aIndex = lSelectIndex lSelectIndex = lLeft

14、ChildIndex Else 父节点比子节点F值小 则结束 Exit Do End If Else If lRightChildIndex = lOpenSize Then If arrOpen(lLeftChildIndex).F arrOpen(lLeftChildIndex).F Then 父节点F值大 则交换 tmpPoint = arrOpen(lSelectIndex) arrOpen(lSelectIndex) = arrOpen(lLeftChildIndex) arrOpen(lLeftChildIndex) = tmpPoint arrBap(arrOpen(lSelec

15、tIndex).Index).aIndex = lLeftChildIndex arrBap(arrOpen(lLeftChildIndex).Index).aIndex = lSelectIndex lSelectIndex = lLeftChildIndex Else 父节点比子节点F值小 则结束 Exit Do End If Else If arrOpen(lSelectIndex).F arrOpen(lRightChildIndex).F Then 父节点F值大 则交换 tmpPoint = arrOpen(lSelectIndex) arrOpen(lSelectIndex) =

16、arrOpen(lRightChildIndex) arrOpen(lRightChildIndex) = tmpPoint arrBap(arrOpen(lSelectIndex).Index).aIndex = lRightChildIndex arrBap(arrOpen(lRightChildIndex).Index).aIndex = lSelectIndex lSelectIndex = lRightChildIndex Else 父节点比子节点F值小 则结束 Exit Do End If End If End If End If End If Loop End If pBinar

17、yHeapDelete = tmpResultEnd Function更新一个点 并重新排序Private Sub pBinaryHeapUpdate(Index As Long) Dim lParentIndex As Long Dim lSelectIndex As Long Dim tmpPoint As fsPoint lSelectIndex = Index Do While True lParentIndex = Int(lSelectIndex / 2) If lParentIndex 0 Then If arrOpen(lSelectIndex).F 0 Then ReDim

18、bytChar(iLen - 1) Get #2, 1, bytChar() Close #2 iMapHeight = Val(GetValue(Index_ & strMsg, Height, fMapSet) iMapWidth = Val(GetValue(Index_ & strMsg, Width, fMapSet) nMap(lMapDataID).lWidth = iMapWidth nMap(lMapDataID).lHeight = iMapHeight nMap(lMapDataID).lDataSize = iMapWidth * iMapHeight If nMap(

19、lMapDataID).lDataSize iLen Then Exit Sub 地图数据不正确 ReDim nMap(lMapDataID).cMapData(nMap(lMapDataID).lDataSize - 1) iCount = -1 For i = 0 To iMapHeight - 1 For j = 0 To iMapWidth - 1 iCount = iCount + 1 nMap(lMapDataID).cMapData(iCount).X = j nMap(lMapDataID).cMapData(iCount).Y = i If bytChar(iCount) =

20、 0 Then nMap(lMapDataID).cMapData(iCount).B = False Else nMap(lMapDataID).cMapData(iCount).B = True End If Next Next nMap(lMapDataID).bData = True 读取固定门点 Dim arrData() As String Dim brrData() As String strMsg = GetValue(bDoor, CStr(lMapDataID), fMapSet) arrData = Split(strMsg, _) For m = 0 To UBound

21、(arrData) brrData = Split(arrData(m), ,) If UBound(brrData) 0 Then i = CLng(brrData(1) j = CLng(brrData(0) iCount = iMapWidth * i + j nMap(lMapDataID).cMapData(iCount).B = False nMap(lMapDataID).cMapData(iCount).D = True End If Next 读取死点 strMsg = GetValue(bFault, CStr(lMapDataID), fMapSet) arrData =

22、 Split(strMsg, _) For m = 0 To UBound(arrData) brrData = Split(arrData(m), ,) If UBound(brrData) 0 Then i = CLng(brrData(1) j = CLng(brrData(0) iCount = iMapWidth * i + j nMap(lMapDataID).cMapData(iCount).B = False End If Next 读取活点 strMsg = GetValue(bThrough, CStr(lMapDataID), fMapSet) arrData = Split(strMsg, _) For m = 0 To UBound(arrData) brrData = Split(arrData(m), ,) If UBound(brrData) 0 Then i = CLng(brrData(1) j = CLng(brrData(0) iCount = iMapWidth * i + j nMap(lMapDataID).cMapData(iCount).B = True End If Next Else Close #2 Exit Sub