[angvelem]

У меня давно валяется чей-то пример. Посмотри, если нужно выкину весь проект:

Код:

unit PathFinder;

interface

type
 TPoint  = record
            X : longint;
            Y : longint;
           end;

 TTile    = record
             TerrType : byte;
             Status   : byte;
             value    : real;
             gval     : real;
             hval     : real;
             fval     : real;
             Prev     : TPoint;
            end;


const
  ttWall   = 0; // препятствие
  ttType1  = 1; // тип территории 1 - самый плохо проходимый тип территории
  ttType2  = 2; // тип территории 2
  ttType3  = 3; // тип территории 3
  ttType4  = 4; // тип территории 4
  ttType5  = 5; // тип территории 5
  ttClear  = 6; // проходимая клетка - самый хорошо проходимый тип территории

  tsPath       = 1; // путь
  tsUnvisited  = 2; // непосещенная точка
  tsBound      = 3; // граничная точка
  tsPassed     = 4; // проверенная точка
  tsStart      = 5; // точка старта
  tsFinish     = 6; // точка финиша


  MaxX   = 56;
  MaxY   = 56;

 Courses : array [1..8] of TPoint=((X:0;Y:-1),(X:1;Y:-1),(X:1;Y:0),(X:1;Y:1),
                                   (X:0;Y:1),(X:-1;Y:1),(X:-1;Y:0),(X:-1;Y:-1));
 Marks   : Set of byte = [tsPath, tsBound, tsPassed];

 MaxBoundSize = 500;

type
 TMap     = array[0..101,0..101] of TTile;
 TBound   = array[1..MaxBoundSize] of TPoint;

 function FindPath(Src,Dst: TPoint;var Map: TMap): boolean;
 function EqualPoints(a,b:TPoint):boolean ;

implementation

function EqualPoints(a,b:TPoint):boolean ;
begin
 Result:=(A.X=B.X) and (A.Y=B.Y);
end;
function Point(AX , AY : integer): TPoint;
begin
 Result.X:=AX;
 Result.Y:=AY;
end;

function Max(x,y: real):real;
begin
 if x>y then Result:=x else Result:=y;
end;

function Min(x,y: real):real;
begin
 if x>y then Result:=y else Result:=x;
end;

function HEst(A,B: TPoint; dx2,dy2:real): real;
var dx,dy,cross : real;
begin
 dx:= A.X - B.X;
 dy:= A.Y - B.Y;
// dx2:= Src.X - Dst.X;
// dy2:= Src.Y - Dst.Y;
 cross:= dx*dy2 - dx2*dy;
 if( cross<0 ) then cross:=-cross;
 Result:= max(abs(dx), abs(dy))+cross*0.001;

// Result:=sqrt(sqr(A.x-B.x)+sqr(A.y-B.y));
end;


function FindPath(Src,Dst: TPoint;var Map: TMap): boolean;
var
         A : TPoint;
     i,j,k : byte;
     dx,dy : real;
     Bound : TBound;
     BSize : integer;

const kk   : array[0..1] of real=(1.42,1);

function FindMin: integer;
var i,n: integer;
begin
  n:=1;
  for i:=1 to BSize do
    if Map[bound[n].X,bound[n].Y].fval>Map[bound[i].X,bound[i].Y].fval
      then n:=i;
  result:=n;
end;

procedure AddToBound(Point:TPoint);
begin
 if BSize>=MaxBoundSize then exit;
 BSize:=BSize+1;
 Bound[BSize]:=Point;
end;

begin // FindPath
 dx:=Src.X-Dst.X;
 dy:=Src.Y-Dst.Y;
 Map[Src.X,Src.Y].Status:=tsBound;
 Map[Dst.X,Dst.Y].Status:=tsFinish;
 BSize:=1;
 Map[Src.x,Src.y].gval:=0;
 Map[Src.x,Src.y].hval:=HEst(Src,Dst,dx,dy);
 Map[Src.x,Src.y].fval:=Map[Src.x,Src.y].gval+Map[Src.x,Src.y].hval;
 Bound[1]:=Src;
 Result:=False;
 while BSize>0 do
  begin
      k:=FindMin; //BSize;
      i:=Bound[k].x;
      j:=Bound[k].y;
      Map[bound[k].X,bound[k].Y].Status:=tsPassed;
      bound[k]:=bound[BSize];
      BSize:=BSize-1;
        for k:=1 to 8 do
         begin
          A.X:=i+Courses[k].X;
          A.Y:=j+Courses[k].Y;
          if Map[A.x,A.y].TerrType<>ttWall then
           case Map[A.x,A.y].Status of
            tsUnvisited:
                       begin
                        Map[A.X,A.Y].gval:=Map[i,j].gval+Map[A.X,A.Y].value*kk[k mod 2];
                        Map[A.X,A.Y].fval:=Map[A.X,A.Y].gval+HEst(A,Dst,dx,dy);
                        Map[A.X,A.Y].Prev:=Point(i,j);
                        Map[A.X,A.Y].Status:=tsBound;
                        AddToBound(A);
                       end;
            tsFinish :
                       begin
                        Map[A.X,A.Y].Prev:=Point(i,j);
                        Map[Src.X,Src.Y].Status:=tsStart;
                        Result:=True;
                        exit;
                       end;
 {           tsBound  :
                       begin
                        _gval:=Map[i,j].gval+Map[A.X,A.Y].value*kk[k mod 2];
                        if _gval<Map[A.X,A.Y].gval then
                         begin
                           Map[A.X,A.Y].gval:=_gval;
                           Map[A.X,A.Y].fval:=Map[A.X,A.Y].gval+HEst(A,Dst);
                           Map[A.X,A.Y].Prev:=Point(i,j);
                           AddToBound(A);
                         end;
                       end;}
           end;
         end;
  end;
 Map[Src.X,Src.Y].Status:=tSStart;
end;

end.