[BIG_BO]

Помогите доделать программу. Я выложил прогу, хотелось бы сделать процедуру, которая по нажатии кнопки будет показывать кратчайший путь от старта до финиша в лабиринте

[BIG_BO]

Вот ссылка проги

[angvelem]

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

Код:

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160 161 162 163 164 165 166 167 168 169 170 171 172 173 174 175 176

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.