unit aStarSearchPath;
interface
uses Classes,SysUtils;
type
pAStarPathNode=^tAStarPathNode;
tAStarPathNode=record
x,y:word;
F:word;
G:word;
H:word;
father:pAStarPathNode; //地图方格的父方格
prev :pAStarPathNode; //链表上的上个节点
next :pAStarPathNode; //链表上的下个节点
end;
tAStarMapBuf=array of byte;
pAStarArea=^tAStarArea; //区域
tAStarArea=record
headNode:pAStarPathNode;
endNode:pAStarPathNode;
end;
var
mapWidth,mapHeight:integer;
mapToX,mapToY:integer;
AStarOpenArea:pAStarArea;
AStarCloseArea:pAStarArea;
pAStarMapBuf:pByte;
nearGBuf:array [0..2,0..2] of byte;
function ArrayOf(buf:pByte;x,y,xSize:word):byte;
function AStarFindPath(var returnPath:tstringlist;fromX,fromY,toX,toY,mapW,mapH:word;mapBuf:pByte):boolean;
function AStarGetHValue(fX,fY:word):word;
function AStarGetGValue(fX,fY,tX,tY:word):word;
procedure AStarInitNearG(x,y:word);
procedure AStarInsertByF(pHead:pAStarArea;thisNode:pAStarPathNode);
function AStarSearchMinF(fatherNode:pAStarPathNode):pAStarPathNode;
implementation
//数组与地图XY的对应关系: ary[y,x] 这样就能对应到地图的(x,y)
//因此传入的地图数组数据，第1个是Y，第2个是X,要注意与数据的位置对应
function AStarFindPath(var returnPath:tstringlist;fromX,fromY,toX,toY,mapW,mapH:word;mapBuf:pByte):boolean;
var
p:pAStarPathNode;
i:integer;
s:string;
begin
result:=false;
pAStarMapBuf:=mapBuf;
mapToX:=toX;
mapToY:=toY;
mapWidth:=mapW;
mapHeight:=mapH;
new(AStarCloseArea); //建立开放区
AStarCloseArea.headNode:=nil;
AStarCloseArea.endNode:=nil;
new(AStarOpenArea); //建立封闭区
AStarOpenArea.headNode:=nil;
AStarOpenArea.endNode:=nil;
new(p); //起点加入开放区
p.x:=fromX;
p.y:=fromY;
p.G:=0;
p.H:=AStarGetHValue(fromx,fromY);
p.F:=p.G+p.H;
p.next:=nil;
p.father:=nil;
AStarOpenArea.headNode:=p;
AStarOpenArea.endNode:=p;
while true do
begin
if (p.x=tox) and (p.y=toy) then break; //找到终点就退出
p:=AStarSearchMinF(p);
if p=nil then exit;
end;
result:=true;
while true do //从终点开始延者父节点返回到起点就是路径
begin
if p=nil then break;
s:=inttostr(p.x)+','+inttostr(p.y);
returnPath.Insert(0,s);
p:=p.father;
end;
end;
//计算到目标点的H值
function AStarGetHValue(fX,fY:word):word;
var
dx,dy:integer;
begin
dx:=abs(fX-mapToX);
dy:=abs(fY-mapToY);
result:=dx*10+dy*10;
end;
//计算周围8个方向的G值
function AStarGetGValue(fX,fY,tX,tY:word):word;
var
dx,dy:integer;
begin
dx:=abs(fX-tX);
dy:=abs(fY)-(tY);
if (dx=0) and (dy=0) then result:=0
else
if dx*dy=0 then result:=10 else result:=14;
end;
//通过指针访问数组
function ArrayOf(buf:pByte;x,y,xSize:word):byte;
var
j:integer;
begin
j:=y*xSize+x;
inc(buf,j);
result:=buf^;
end;
//设置x,y周围8个各自的G值
procedure AStarInitNearG(x,y:word);
var
i,j,v,x1,y1:integer;
p:pbyte;
begin
p:=pAStarMapBuf; //全局地图指针
fillChar(nearGBuf,9,1);
for i:=-1 to 1 do //Y
begin
y1:=y+i;
for j:=-1 to 1 do //X
begin
if nearGBuf[i+1,j+1]=0 then continue; //由于路障被预先处理了
x1:=x+j;
//中间的点,超出地图范围的点不可用
if ((i=0) and (j=0)) or (x1<0) or (y1<0) or (x1>mapWidth) or (y1>mapHeight) then v:=-1
else
begin
v:=ArrayOf(p,x1,y1,mapWidth); //看地图数据里这格是否是路障
v:=AStarGetGValue(x,y,x1,y1) * v; //计算临近的格G值
end;
if (v=0) and ((x1=x) or (y1=y)) then //格子平行方向不可行或竖向不可行，上下或左右的也不可行
begin
if y1=y then //左右边右路障，因方格有角，路障下面和上面的格也不可过
begin
nearGBuf[i,j+1]:=0;
nearGBuf[i+1,j+1]:=v; //自己=0
nearGBuf[i+2,j+1]:=0;
end;
if x1=x then
begin
nearGBuf[i+1,j]:=0;
nearGBuf[i+1,j+1]:=v;
nearGBuf[i+1,j+2]:=0;
end;
continue;
end;
if v<0 then v:=0; //非超出范围的位置
nearGBuf[i+1,j+1]:=v;
end;
end;
end;
//根据thisNode进行F值降序调整链接节点位置或者插入
procedure AStarInsertByF(pHead:pAStarArea;thisNode:pAStarPathNode);
var
p,p2:pAStarPathNode;
F:word;
begin
p:=pHead.headNode;
while true do
begin
if thisNode.F<p.F then //找到F值比自己大的
begin
p2:=p.prev; //上个节点
if p2=nil then //这个节点是头节点
begin
thisNode.prev:=nil;//变成头属性
pHead.headNode:=thisNode; //插入第一个节点作为头
end
else
begin
p2.next:=thisNode; //跟上一个点对接
thisNode.prev:=p2;
end;
p.prev:=thisNode; //插入后对接
thisNode.next:=p;
exit;
end;
if p.next=nil then //末尾
begin
if p=thisNode then exit; //就是自己啦
p.next:=thisNode;
thisNode.prev:=p;
thisNode.next:=nil;
pHead.endNode:=thisNode;
exit;
end;
p:=p.next;
end;
end;
//从开发区中选出F值最小的点
//原理：以基点为中心通过周围8方向辐射的方式不断的添加新格子(以基点作为父节点)到开放区
// (完成这个工作后这个辐射基点要加到封闭区)
// 在辐射的过程中，同时检测早先被加入开放区的格子的G值是不是最小的(从辐射基点到该格子的G值)
// 如果这个基点到该格子的G值更小，则变换这个格子的父节点为基点并重新计算F值
//，然后在开放区中选出最小F值的格子，再继续以选定的点往外辐射,直至辐射到目的点
function AStarSearchMinF(fatherNode:pAStarPathNode):pAStarPathNode;
var
x,y,x1,y1:integer;
p,p2:pAStarPathNode;
pX,pY:integer;
g,h,f:word;
begin
pX:=fatherNode.x;
pY:=fatherNode.y;
AStarInitNearG(pX,pY);//周围的G值如何，路障，原点排除
for y:=1 downto -1 do //Y的3行
begin
for x:=1 downto -1 do //X的3列
begin
x1:=x+pX; //尝试周围的坐标
y1:=y+pY;
g:=nearGBuf[y+1,x+1]; //有可能被预先清0了(路障在中间时)
if g=0 then continue ;//跳过没有G值的
p:=AStarOpenArea.headNode;
while true do //搜索此点是否在开发区内
begin
if p=nil then break;
if (p.x=x1) and (p.y=y1) then break; //在开放区
p:=p.next;
end;
if p<>nil then //在开放区
begin
g:=p.G+g; //起点经由选中点到此点的G值
if g<p.g then //经过此点更近，早先设置的父节点需要更改
begin
p.father:=fatherNode; //更新它的父节点
p.G:=g;
p.F:=p.G+p.H;//重新计算F值
end;
continue;//后面不用再搜索封闭区了
end;
p:=AStarCloseArea.headNode;
while true do //搜索封闭区
begin
if p=nil then break; //没有在封闭区
if (p.x=x1) and (p.y=y1) then break; //在封闭区
p:=p.next;
end;
if p=nil then //这是个新点,设定父节点
begin
new(p);
p.prev:=AStarOpenArea.endNode ; //接到最后的开放节点上
AStarOpenArea.endNode:=p;
p.next:=nil;
p.x:=x1;
p.y:=y1;
p.G:=fatherNode.G+g;
p.H:=AStarGetHValue(x1,y1);
p.F:=p.G+p.H;
p.father:=fatherNode; //父节点，保存是谁把它加入开放区的
AStarInsertByF(AStarOpenArea,p);//插入开发区中
end;
end; // next x
end; //next y;
//把此节点从开放区抽出来，做好开放区节点的重新连接
if fatherNode.prev=nil then //当前点是开放区的第一个
begin
p:=fatherNode.next;//下一个接的准备变成头
p.prev:=nil; //头属性
AStarOpenArea.headNode:=p;//更新头
end
else
begin
p:=fatherNode.next; //下个节点
p.prev:=fatherNode.prev; //连到这个点的上个节点上
fatherNode.prev.next:=p;
end;
//准备加到封闭区的末尾
p:=AStarCloseArea.endNode; //封闭区最末的点
if p=nil then AStarCloseArea.headNode:=fatherNode; //如果没有，那这个也是头也是未
AStarCloseArea.endNode:=fatherNode; //是未位
fatherNode.prev:=nil;
fatherNode.next:=nil;
if p<>nil then //有其他的末位
begin
p.next:=fatherNode; //连到尾巴上
fatherNode.prev:=p;
end;
AStarOpenArea.headNode.prev:=nil; //最小的F已经在首个,设置成首属性
result:=AStarOpenArea.headNode;//返回F值最小的
end;
end.
调用方法： AStarFindPath
地图数据为字节型的数组,大小为mapW x mapH,调用时传入该数组的地址(pByte)