看看我的方法。此程序在TP7.0下编译通过。你自己再测试一下。
const maxn=100;
type node=record
x,y:integer;
end;
var a:array[1..maxn,1..maxn] of integer;
b:array[1..maxn,1..maxn] of byte;
s,d:node;
n,m,i,j,k:integer;
c:char;
change:boolean;
procedure print(x,y:integer);
begin
if (x=s.x) and (y=s.y) then
exit else
case b[x,y] of
1:begin
print(x-1,y);
write('n');
end;
2:begin
print(x+1,y);
write('s');
end;
3:begin
print(x,y-1);
write('e');
end;
4:begin
print(x,y+1);
write('w');
end;
end;
end;
begin
{-----------------Input----------------------}
fillchar(a,sizeof(a),255);
assign(input,'in.txt');
reset(input);
n:=1;
while not eofdo
begin
m:=1;
while not eolndo
begin
read(c);
if c='.' then
else
if c='X' then
a[n,m]:=-2 else
if c='S' then
begin
s.x:=n;
s.y:=m;
end else
begin
d.x:=n;
d.y:=m;
end;
m:=m+1;
end;
readln;
n:=n+1;
end;
n:=n-1;
m:=m-1;
a[s.x,s.y]:=0;
{---------------------Main-----------------------------}
repeat
change:=false;
for i:=1 to ndo
for j:=1 to mdo
if a[i,j]<>-2 then
begin
if a[i,j]=-1 then
a[i,j]:=maxint;
if (i>1) and (a[i-1,j]>=0) then
if a[i,j]>a[i-1,j]+1 then
begin
a[i,j]:=a[i-1,j]+1;
b[i,j]:=1;
end;
if (i<n) and (a[i+1,j]>=0) then
if a[i,j]>a[i+1,j]+1 then
begin
a[i,j]:=a[i+1,j]+1;
b[i,j]:=2;
end;
if (j>1) and (a[i,j-1]>=0) then
if a[i,j]>a[i,j-1]+1 then
begin
a[i,j]:=a[i,j-1]+1;
b[i,j]:=3;
end;
if (j<m) and (a[i,j+1]>=0) then
if a[i,j]>a[i,j+1]+1 then
begin
a[i,j]:=a[i,j+1]+1;
b[i,j]:=4;
end;
if a[i,j]=maxint then
a[i,j]:=-1 else
change:=true;
end;
until not(true) or (a[d.x,d.y]>0);
{----------------------------print---------------------------------------}
if a[d.x,d.y]<0 then
write('no answer') else
print(d.x,d.y);
writeln;
end.
