智能控制作业Word格式文档下载.docx
《智能控制作业Word格式文档下载.docx》由会员分享，可在线阅读，更多相关《智能控制作业Word格式文档下载.docx（16页珍藏版）》请在冰豆网上搜索。
1寻路成功
0寻路失败无法到达
4已经到达终点
5目标被占
6寻路过程中发生错误
※※※※※※※※※※※※※※※※※※※※※※※※※※※※※※※※※※※※※※※※
PublicFunctionfPath（arrMap（）AsfsPoint,arrPath（）AsLong,lPathCountAsLong,pStartPointAsfsPoint,pGotoPointAsfsPoint,lWidthAsLong,lHeightAsLong）AsLong'
寻路
DimiAsLong'
循环用变量
DimCountAsLong'
点的序号或者总数
DimpCurrentPointAsfsPoint
DimpSearchPointAsfsPoint
DimpSearchXAsLong,pSearchYAsLong
DimtmpXAsLong,tmpYAsLong
DimarrXofs（8）AsLong,arrYofs（8）AsLong'
XY变化常量数组
DimarrIofs（8）AsLong'
序号变化常量数组
DimtmpOfsAsLong'
序号变化量
OnErrorGoToPathErr:
判断地图
IflWidth<
1OrlHeight<
1Then
fPath=3'
地图数据不正确
ExitFunction
EndIf
TCount=pGotoPoint.Y*lWidth+pGotoPoint.X'
TCount=pGotoPoint.Index
判断是否为障碍物
IfpGotoPoint.Y>
lHeight-1OrpGotoPoint.X>
lWidth-1Then
fPath=2
IfarrMap（TCount）.BOrarrMap（TCount）.DThen
可以通过或者是门点
fPath=0
Else'
否则退出寻路
IfarrMap（TCount）.lNpcId<
>
0Then
fPath=5
IfpGotoPoint.Y=pStartPoint.YAndpGotoPoint.X=pStartPoint.XThen
fPath=4
设置常数数组该数组决定了寻路的优先顺序
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）=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'
地图总点数
ReDimarrBap（Count）
清空所有需要用到的列表
ReDimarrOpen（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
IftmpX>
tmpYThen
pStartPoint.H=tmpX
Else
pStartPoint.H=tmpY
pStartPoint.F=pStartPoint.G+pStartPoint.H
arrBap（Count）.Parent=0
arrBap（Count）.aIndex=1
arrOpen
（1）=pStartPoint
lOpenSize=1
DoWhilelOpenSize>
0
pCurrentPoint=pBinaryHeapDelete（）
Count=pCurrentPoint.Index
arrBap（Count）.bClose=True
arrBap（Count）.aIndex=0
Fori=0To7
pSearchPoint.X=pCurrentPoint.X+arrXofs（i）
pSearchPoint.Y=pCurrentPoint.Y+arrYofs（i）
Count=pCurrentPoint.Index+arrIofs（i）
pSearchPoint.Index=Count
IfCount=TCountThen'
就是终点
arrBap（Count）.Parent=pCurrentPoint.Index
保存路径
lPathCount=-1
DoWhilearrBap（Count）.Parent<
lPathCount=lPathCount+1
arrPath（lPathCount）=Count
Count=arrBap（Count）.Parent
Loop
起始点放入最后
arrPath（lPathCount+1）=Count
fPath=1
IfarrMap（Count）.BAndarrMap（Count）.lNpcId=0Then'
不是障碍点
IfNotarrBap（Count）.bCloseThen'
不在关闭列表
pSearchPoint.G=pCurrentPoint.G+1
tmpX=Abs（pSearchPoint.X-pGotoPoint.X）
tmpY=Abs（pSearchPoint.Y-pGotoPoint.Y）
pSearchPoint.H=tmpX
pSearchPoint.H=tmpY
pSearchPoint.F=pSearchPoint.G+pSearchPoint.H
IfarrBap（Count）.aIndex<
IfpSearchPoint.F<
arrOpen（arrBap（Count）.aIndex）.FThen
更新开放列表
pBinaryHeapUpdatearrBap（Count）.aIndex
加入到开放列表
pBinaryHeapAddpSearchPoint
Next
PathErr:
fPath=6
EndFunction
增加一个值到末尾并重新排序
PrivateSubpBinaryHeapAdd（pAddPointAsfsPoint）
DimlParentIndexAsLong
DimlSelectIndexAsLong
DimtmpPointAsfsPoint
lOpenSize=lOpenSize+1
arrOpen（lOpenSize）=pAddPoint
arrBap（arrOpen（lOpenSize）.Index）.aIndex=lOpenSize
lSelectIndex=lOpenSize
DoWhileTrue
lParentIndex=Int（lSelectIndex/2）
IflParentIndex>
IfarrOpen（lSelectIndex）.F<
=arrOpen（lParentIndex）.FThen
比父节点F值小交换
tmpPoint=arrOpen（lSelectIndex）
arrOpen（lSelectIndex）=arrOpen（lParentIndex）
arrOpen（lParentIndex）=tmpPoint
arrBap（arrOpen（lSelectIndex）.Index）.aIndex=lParentIndex
arrBap（arrOpen（lParentIndex）.Index）.aIndex=lSelectIndex
lSelectIndex=lParentIndex
比父节点F值大不处理
ExitDo
无父节点走人
EndSub
取出第一个值并重新排序
PrivateFunctionpBinaryHeapDelete（）AsfsPoint
DimtmpResultAsfsPoint
DimlLeftChildIndexAsLong
DimlRightChildIndexAsLong
tmpResult=arrOpen
（1）
lOpenSize=lOpenSize-1
把最后一个点移动到最前面
IflOpenSize>
arrOpen
（1）=arrOpen（lOpenSize+1）
lSelectIndex=1
arrBap（arrOpen（lSelectIndex）.Index）.aIndex=lSelectIndex
比较子节点
lLeftChildIndex=lSelectIndex*2
lRightChildIndex=lLeftChildIndex+1
IflLeftChildIndex>
lOpenSizeThen
没有左子节点则结束
IflLeftChildIndex=lOpenSizeThen'
只有左子节点
IfarrOpen（lSelectIndex）.F>
arrOpen（lLeftChildIndex）.FThen'
父节点F值大则交换
arrOpen（lSelectIndex）=arrOpen（lLeftChildIndex）
arrOpen（lLeftChildIndex）=tmpPoint
arrBap（arrOpen（lSelectIndex）.Index）.aIndex=lLeftChildIndex
arrBap（arrOpen（lLeftChildIndex）.Index）.aIndex=lSelectIndex
lSelectIndex=lLeftChildIndex
父节点比子节点F值小则结束
IflRightChildIndex<
=lOpenSizeThen
IfarrOpen（lLeftChildIndex）.F<
=arrOpen（lRightChildIndex）.FThen'
左边F值小
arrOpen（lRightChildIndex）.FThen'
arrOpen（lSelectIndex）=arrOpen（lRightChildIndex）
arrOpen（lRightChildIndex）=tmpPoint
arrBap（arrOpen（lSelectIndex）.Index）.aIndex=lRightChildIndex
arrBap（arrOpen（lRightChildIndex）.Index）.aIndex=lSelectIndex
lSelectIndex=lRightChildIndex
pBinaryHeapDelete=tmpResult
更新一个点并重新排序
PrivateSubpBinaryHeapUpdate（IndexAsLong）
lSelectIndex=Index
arrOpen（lParentIndex）.FThen
加载地图数据
PublicSubpAddMapData（lMapDataIDAsLong,strMsgAsString）
DimbytChar（）AsByte
DimMapFileAsString
DimiLenAsLong
DimiAsLong,jAsLong
DimmAsLong,iCountAsLong
DimiMapWidthAsLong
DimiMapHeightAsLong
MapFile=App.Path&
"
\Data\cMap\"
&
strMsg&
.dat"
OpenMapFileForBinaryAs#2
iLen=LOF
（2）
IfiLen>
ReDimbytChar（iLen-1）
Get#2,1,bytChar（）
Close#2
iMapHeight=Val（GetValue（"
Index_"
strMsg,"
Height"
fMapSet））
iMapWidth=Val（GetValue（"
Width"
nMap（lMapDataID）.lWidth=iMapWidth
nMap（lMapDataID）.lHeight=iMapHeight
nMap（lMapDataID）.lDataSize=iMapWidth*iMapHeight
IfnMap（lMapDataID）.lDataSize<
iLenThenExitSub'
ReDimnMap（lMapDataID）.cMapData（nMap（lMapDataID）.lDataSize-1）
iCount=-1
Fori=0ToiMapHeight-1
Forj=0ToiMapWidth-1
iCount=iCount+1
nMap（lMapDataID）.cMapData（iCount）.X=j
nMap（lMapDataID）.cMapData（iCount）.Y=i
IfbytChar（iCount）=0Then
nMap（lMapDataID）.cMapData（iCount）.B=False
nMap（lMapDataID）.cMapData（iCount）.B=True
nMap（lMapDataID）.bData=True
读取固定门点
DimarrData（）AsString
DimbrrData（）AsString
strMsg=GetValue（"
bDoor"
CStr（lMapDataID）,fMapSet）
arrData=Split（strMsg,"
_"
）
Form=0ToUBound（arrData）
brrData=Split（arrData（m）,"
"
IfUBound（brrData）>
i=CLng（brrData
（1））
j=CLng（brrData（0））
iCount=iMapWidth*i+j
nMap（lMapDataID）.cMapData（iCount）.D=True
读取死点
bFault"
读取活点
bThrough"
ExitSub
升级会员 