A星(A-Star)寻路算法

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          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                    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)