写得比较仓促，效率好像没以前写的好了
给大家看看，有什么改进方法
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls;
type
TMoveDir = (mdUp, mdDown, mdLeft, mdRight);//移动方向
TMoveObject = class;
TMoveObjects = array of TMoveObject;//移动对象数组
//移动对象类，是精灵和箱子的父类
TMoveObject = class
private
FActive: Boolean;
procedure SetActive(const Value: Boolean);
protected
FTarget : TPoint;
Winner : TMoveObject;
FTurnCount : Integer;
FObjectList : TList;
FRow,
FColumn : Integer;
FMarks : TMoveObjects;
FMap : TStrings;
FPos : TPoint;
FTrace : String;
public
property Active : Boolean read FActive write SetActive;
function Move : Boolean;
virtual;
abstract;//移动方法
constructor Create(ObjectList : TList;
Row, Column : Integer;
Map : TStrings;
Marks : TMoveObjects;
Target : TPoint);
end;
//精灵对象
TSpirit = class(TMoveObject)
private
FBoxPos : TPoint;
public
constructor Create(ObjectList : TList;
Row, Column : Integer;
Map : TStrings;
Marks : TMoveObjects;
Target : TPoint;
BoxPos : TPoint);
reintroduce;
function Move : Boolean;
override;
end;
//箱子对象
TBox = class(TMoveObject)
private
FSpiritPos : TPoint;
function FMoveSpirit(FromPos, Target : TPoint;
var Trace : String;
BoxPos : TPoint) : Boolean;//移动精灵
procedure SetSpiritPos(const Value: TPoint);
protected
FStepCount : Integer;
public
constructor Create(ObjectList : TList;
Row, Column : Integer;
Map : TStrings;
Marks : TMoveObjects;
Target : TPoint);
reintroduce;
function Move : Boolean;
override;//移动箱子
property SpiritPos : TPoint read FSpiritPos write SetSpiritPos;
end;
TForm1 = class(TForm)
Memo1: TMemo;
Button1: TButton;
Memo2: TMemo;
procedure Button1Click(Sender: TObject);
private
procedure FShowAction(Trace : String);//显示移动动画
function FGetShortCut : String;//获取最短路径
public
end;
var
Form1: TForm1;
implementation
uses Types;
{$R *.dfm}
procedure TForm1.Button1Click(Sender: TObject);
var
TickCount : Integer;
S : String;
OldText : String;
begin
TickCount := GetTickCount;
S := FGetShortCut;
Caption := FloatToStr((GetTickCount - TickCount)/1000);
if S = '' then
begin
ShowMessage('Sorry, I can''tdo
it');
Exit;
end;
OldText := Memo1.Lines.Text;
FShowAction(S);
Memo1.Lines.Text := OldText;
end;
{ TMoveObject }
constructor TMoveObject.Create(ObjectList : TList;
Row, Column : Integer;
Map : TStrings;
Marks : TMoveObjects;
Target : TPoint);
begin
FObjectList := ObjectList;
ObjectList.Add(Self);
FActive := True;
FTurnCount := 0;
FRow := Row;
FColumn := Column;
FTrace := '';
FMap := Map;
FMarks := Marks;
FTarget := Target;
end;
procedure TMoveObject.SetActive(const Value: Boolean);
begin
FActive := Value;
end;
{ TSpirit }
constructor TSpirit.Create(ObjectList: TList;
Row, Column: Integer;
Map: TStrings;
Marks: TMoveObjects;
Target: TPoint;
BoxPos: TPoint);
begin
inherited Create(ObjectList, Row, Column, Map, Marks, Target);
FBoxPos := BoxPos;
end;
function TSpirit.Move : Boolean;
var
OldPos : TPoint;
aSpirit,
RaceSpirit : TSpirit;
OldTrace : String;
OldTurnCount : Integer;
function FMove(Dir : TMoveDir) : Boolean;
var
NewTurnCount : Integer;
NewTrace : String;
NewPos : TPoint;
begin
Result := False;
NewPos.X := OldPos.X;
NewPos.Y := OldPos.Y;
NewTurnCount := OldTurnCount;
//根据不同方向移动精灵
case Dir of
mdUp : begin
Dec(NewPos.Y);
NewTrace := OldTrace + 'n';
if (OldTrace <> '') and (OldTrace[Length(OldTrace)] <> 'n') then
Inc(NewTurnCount);
end;
mdDown : begin
Inc(NewPos.Y);
NewTrace := OldTrace + 's';
if (OldTrace <> '') and (OldTrace[Length(OldTrace)] <> 's') then
Inc(NewTurnCount);
end;
mdLeft : begin
Dec(NewPos.X);
NewTrace := OldTrace + 'e';
if (OldTrace <> '') and (OldTrace[Length(OldTrace)] <> 'e') then
Inc(NewTurnCount);
end;
mdRight : begin
Inc(NewPos.X);
NewTrace := OldTrace + 'w';
if (OldTrace <> '') and (OldTrace[Length(OldTrace)] <> 'w') then
Inc(NewTurnCount);
end;
end;
if (NewPos.Y >= 0) and (NewPos.Y <= FRow - 1) and (NewPos.X >= 1) and (NewPos.X <= FColumn) //检查是不是出界
and not (FMap.Strings[NewPos.Y][NewPos.X] in ['#'])//有没有障碍物
and not ((NewPos.X = FBoxPos.X) and (NewPos.Y = FBoxPos.Y))//没碰到箱子
then
begin
//比较达到同一个格子的两个精灵，保留快的，停掉慢的
RaceSpirit := FMarks[NewPos.Y * FColumn + NewPos.X - 1] as TSpirit;
if RaceSpirit <> nil then
begin
if (RaceSpirit.FPos.X <> NewPos.X) or (RaceSpirit.FPos.Y <> NewPos.Y) then
Exit//如果格子所在的精灵的位置不在格子上，说明精灵早已经经过这个格子，新精灵就是慢了
else
if Length(RaceSpirit.FTrace) < Length(NewTrace) then
Exit//比较FTrace（移动记录）长度，短者优胜
else
if RaceSpirit.FTurnCount <= NewTurnCount then
Exit//比较转弯次数，少者优胜
else
begin
RaceSpirit.Active := False;
end;
end;
if (OldPos.X = FPos.X) and (OldPos.Y = FPos.Y) then
aSpirit := Self
else
aSpirit := TSpirit.Create(FObjectList, FRow, FColumn, FMap, FMarks, FTarget, FBoxPos);
with aSpiritdo
begin
FPos.X := NewPos.X;
FPos.Y := NewPos.Y;
FTurnCount := NewTurnCount;
FTrace := NewTrace;
end;
FMarks[NewPos.Y * FColumn + NewPos.X - 1] := aSpirit;//占领格子
Result := (aSpirit.FPos.X = FTarget.X) and (aSpirit.FPos.Y = FTarget.Y);//判断是否到达目的地
if Result then
Winner := aSpirit;//返回胜利者
end;
end;
begin
Result := False;
//保存旧资料
OldPos := FPos;
OldTrace := FTrace;
OldTurnCount := FTurnCount;
//分别向四个方向移动,移动之前先判断箱子不是向后退
if ((OldTrace = '') or (OldTrace[Length(OldTrace)] <> 's')) and FMove(mdUp) then
begin
Result := True;
Exit;
end;
if ((OldTrace = '') or (OldTrace[Length(OldTrace)] <> 'n')) and FMove(mdDown) then
begin
Result := True;
Exit;
end;
if ((OldTrace = '') or (OldTrace[Length(OldTrace)] <> 'w')) and FMove(mdLeft) then
begin
Result := True;
Exit;
end;
if ((OldTrace = '') or (OldTrace[Length(OldTrace)] <> 'e')) and FMove(mdRight) then
begin
Result := True;
end;
if (FPos.X = OldPos.X) and (FPos.Y = OldPos.Y) then
Active := False;
end;
{ TBox }
function TBox.Move: Boolean;
var
OldPos,
OldSpiritPos : TPoint;
aBox,
RaceBox : TBox;
OldTrace : String;
OldTurnCount,
OldStepCount : Integer;
function FMove(Dir : TMoveDir) : Boolean;
var
NewTurnCount,
NewStepCount : Integer;
NewTrace : String;
NewPos,
NewSpiritPos : TPoint;
SpiritTrace : String;
begin
Result := False;
NewPos := OldPos;
NewSpiritPos := OldPos;
NewTurnCount := OldTurnCount;
NewStepCount := OldStepCount + 1;//增加步数
case Dir of
mdUp : begin
Dec(NewPos.Y);
Inc(NewSpiritPos.Y);
if FMoveSpirit(OldSpiritPos, NewSpiritPos, SpiritTrace, OldPos) then
begin
NewTrace := OldTrace + SpiritTrace + 'N';
if (OldTrace <> '') and (OldTrace[Length(OldTrace)] <> 'N') then
Inc(NewTurnCount);
end
else
Exit;
end;
mdDown : begin
Inc(NewPos.Y);
Dec(NewSpiritPos.Y);
if FMoveSpirit(OldSpiritPos, NewSpiritPos, SpiritTrace, OldPos) then
begin
NewTrace := OldTrace + SpiritTrace + 'S';
if (OldTrace <> '') and (OldTrace[Length(OldTrace)] <> 'S') then
Inc(NewTurnCount);
end
else
Exit;
end;
mdLeft : begin
Dec(NewPos.X);
Inc(NewSpiritPos.X);
if FMoveSpirit(OldSpiritPos, NewSpiritPos, SpiritTrace, OldPos) then
begin
NewTrace := OldTrace + SpiritTrace + 'E';
if (OldTrace <> '') and (OldTrace[Length(OldTrace)] <> 'E') then
Inc(NewTurnCount);
end
else
Exit;
end;
mdRight : begin
Inc(NewPos.X);
Dec(NewSpiritPos.X);
if FMoveSpirit(OldSpiritPos, NewSpiritPos, SpiritTrace, OldPos) then
begin
NewTrace := OldTrace + SpiritTrace + 'W';
if (OldTrace <> '') and (OldTrace[Length(OldTrace)] <> 'W') then
Inc(NewTurnCount);
end
else
Exit;
end;
end;
if (NewPos.Y >= 0) and (NewPos.Y <= FRow - 1) and (NewPos.X >= 1) and (NewPos.X <= FColumn) //检查是不是出界
and not (FMap.Strings[NewPos.Y][NewPos.X] in ['#'])//有没有障碍物
then
begin
RaceBox := FMarks[NewPos.Y * FColumn + NewPos.X - 1] as TBox;
if RaceBox <> nil then
begin
if (RaceBox.FPos.X <> NewPos.X) or (RaceBox.FPos.Y <> NewPos.Y) then
Exit//如果竞争箱子已经不在格子上说明，新箱子已经落后
else
if RaceBox.FStepCount < NewStepCount then
Exit//比较步数，少者优胜
else
if RaceBox.FTurnCount < NewTurnCount then
Exit//比较转弯次数，少者优胜
else
if Length(RaceBox.FTrace) <= Length(NewTrace) then
Exit//比较全部步数，包括精灵的，少者优胜
else
begin
RaceBox.Active := False;
end;
end;
if (OldPos.X = FPos.X) and (OldPos.Y = FPos.Y) then
aBox := Self
else
aBox := TBox.Create(FObjectList, FRow, FColumn, FMap, FMarks, FTarget);
with aBoxdo
begin
FPos.X := NewPos.X;
FPos.Y := NewPos.Y;
FTurnCount := NewTurnCount;
FTrace := NewTrace;
FSpiritPos := OldPos;
FStepCount := NewStepCount;
end;
FMarks[NewPos.Y * FColumn + NewPos.X - 1] := aBox;//占领格子
Result := (aBox.FPos.X = FTarget.X) and (aBox.FPos.Y = FTarget.Y);
if Result then
Winner := aBox;//返回胜利者
end;
end;
begin
Result := False;
OldPos := FPos;
OldTrace := FTrace;
OldTurnCount := FTurnCount;
OldSpiritPos := SpiritPos;
OldStepCount := FStepCount;
//向四个方向移动,每次移动之前先判断箱子不是向后退，，
if ((OldTrace = '') or (OldTrace[Length(OldTrace)] <> 'S')) and FMove(mdUp) then
begin
Result := True;
Exit;
end;
if ((OldTrace = '') or (OldTrace[Length(OldTrace)] <> 'N')) and FMove(mdDown) then
begin
Result := True;
Exit;
end;
if ((OldTrace = '') or (OldTrace[Length(OldTrace)] <> 'W')) and FMove(mdLeft) then
begin
Result := True;
Exit;
end;
if ((OldTrace = '') or (OldTrace[Length(OldTrace)] <> 'E')) and FMove(mdRight) then
begin
Result := True;
end;
if (FPos.X = OldPos.X) and (FPos.Y = OldPos.Y) then
Active := False;
end;
function TBox.FMoveSpirit(FromPos, Target : TPoint;
var Trace: String;
BoxPos : TPoint): Boolean;
var
FObjectList : TList;
FMarks : TMoveObjects;
i : Integer;
aSpirit : TSpirit;
ActiveCount : Integer;
Winner : TMoveObject;
begin
//如果开始点和结束点一样，返回空字符串
if (FromPos.X = Target.X) and (FromPos.Y = Target.Y) then
begin
Result := True;
Trace := '';
Exit;
end;
FObjectList := TList.Create;
try
//初始化FMarks（格子数组,用来保存到达格子的精灵，来比较到达某个格子精灵的快慢）
SetLength(FMarks, FRow * FColumn);
for i := 0 to Length(FMarks) - 1do
FMarks := nil;
//创建第一个精灵
aSpirit := TSpirit.Create(FObjectList, FRow, FColumn, FMap, FMarks, Target, BoxPos);
with aSpiritdo
begin
FPos := FromPos;
end;
FMarks[FromPos.Y * FColumn + FromPos.X - 1] := aSpirit;
Winner := nil;
//下面循环每次让每一个精灵走一步，最快到达目的地的精灵就是优胜者
repeat
ActiveCount := 0;
for i := FObjectList.Count - 1do
wnto 0do
begin
aSpirit := FObjectList.Items;
if aSpirit.Active then
begin
Inc(ActiveCount);
if aSpirit.Move then
Winner := aSpirit.Winner;
end
else
FObjectList.Delete(i);
end;
until (Winner <> nil) or (ActiveCount = 0);
if Winner <> nil then
begin
Trace := Winner.FTrace;
Result := True;
end
else
Result := False;
finally
//释放资源
for i := 0 to FObjectList.Count - 1do
begin
aSpirit := FObjectList.Items;
aSpirit.Free;
end;
FObjectList.Free;
end;
end;
procedure TBox.SetSpiritPos(const Value: TPoint);
begin
FSpiritPos := Value;
end;
procedure TForm1.FShowAction(Trace: String);
procedure FSetPoint(P : TPoint;
C : Char);
var
S : String;
begin
S := Memo1.Lines.Strings[P.Y];
S[P.X] := C;
Memo1.Lines.Strings[P.Y] := S;
end;
var
i : Integer;
begin
Pos,
Target,
BoxPos : TPoint;
begin
begin
Pos.X := -1;
Target.X := -1;
BoxPos.X := -1;
for i := 0 to Memo1.Lines.Count -1do
begin
if begin
Pos.X <= 0 then
begin
begin
Pos.X := Pos('S', Memo1.Lines.Strings);
if begin
Pos.X > 0 then
begin
begin
Pos.Y := i;
end;
end;
if Target.X <= 0 then
begin
Target.X := Pos('T', Memo1.Lines.Strings);
if Target.X > 0 then
begin
Target.Y := i;
end;
end;
if BoxPos.X <= 0 then
begin
BoxPos.X := Pos('B', Memo1.Lines.Strings);
if BoxPos.X > 0 then
begin
BoxPos.Y := i;
end;
end;
end;
for i := 0 to Length(Trace)do
begin
case Trace of
'n' : begin
FSetPoint(begin
Pos, '.');
begin
Pos.Y := begin
Pos.Y - 1;
FSetPoint(begin
Pos, 'S');
end;
's' : begin
FSetPoint(begin
Pos, '.');
begin
Pos.Y := begin
Pos.Y + 1;
FSetPoint(begin
Pos, 'S');
end;
'e' : begin
FSetPoint(begin
Pos, '.');
begin
Pos.X := begin
Pos.X - 1;
FSetPoint(begin
Pos, 'S');
end;
'w' : begin
FSetPoint(begin
Pos, '.');
begin
Pos.X := begin
Pos.X + 1;
FSetPoint(begin
Pos, 'S');
end;
'N' : begin
FSetPoint(begin
Pos, '.');
begin
Pos := BoxPos;
FSetPoint(BoxPos, 'S');
BoxPos.Y := BoxPos.Y - 1;
FSetPoint(BoxPos, 'B');
end;
'S' : begin
FSetPoint(begin
Pos, '.');
begin
Pos := BoxPos;
FSetPoint(BoxPos, 'S');
BoxPos.Y := BoxPos.Y + 1;
FSetPoint(BoxPos, 'B');
end;
'E' : begin
FSetPoint(begin
Pos, '.');
begin
Pos := BoxPos;
FSetPoint(BoxPos, 'S');
BoxPos.X := BoxPos.X - 1;
FSetPoint(BoxPos, 'B');
end;
'W' : begin
FSetPoint(begin
Pos, '.');
begin
Pos := BoxPos;
FSetPoint(BoxPos, 'S');
BoxPos.X := BoxPos.X + 1;
FSetPoint(BoxPos, 'B');
end;
end;
Sleep(100);
end;
end;
function TForm1.FGetShortCut: String;
var
FObjectList : TList;
FMarks : TMoveObjects;
i : Integer;
begin
Pos,
Target,
BoxPos : TPoint;
FColumn : Integer;
aBox : TBox;
ActiveCount : Integer;
Winner : TMoveObject;
begin
//取得精灵、箱子、和目标的位置
begin
Pos.X := -1;
Target.X := -1;
BoxPos.X := -1;
for i := 0 to Memo1.Lines.Count -1do
begin
if begin
Pos.X <= 0 then
begin
begin
Pos.X := Pos('S', Memo1.Lines.Strings);
if begin
Pos.X > 0 then
begin
begin
Pos.Y := i;
end;
end;
if Target.X <= 0 then
begin
Target.X := Pos('T', Memo1.Lines.Strings);
if Target.X > 0 then
begin
Target.Y := i;
end;
end;
if BoxPos.X <= 0 then
begin
BoxPos.X := Pos('B', Memo1.Lines.Strings);
if BoxPos.X > 0 then
begin
BoxPos.Y := i;
end;
end;
end;
if (begin
Pos.X > 0) and (BoxPos.X > 0) and (Target.X > 0) then
begin
FObjectList := TList.Create;
try
FColumn := Length(Memo1.Lines.Strings[0]);
//初始化格子数组，用来存放到达格子的箱子，以便比较箱子的快慢
SetLength(FMarks, Memo1.Lines.Count * FColumn);
for i := 0 to Length(FMarks) - 1do
FMarks := nil;
aBox := TBox.Create(FObjectList, Memo1.Lines.Count, FColumn, Memo1.Lines, FMarks, Target);
with aBoxdo
begin
FPos := BoxPos;
SpiritPos := begin
Pos;
end;
FMarks[begin
Pos.Y * FColumn + begin
Pos.X - 1] := aBox;
Winner := nil;
//下面循环每次让每个箱子走一步，最快到达目的地的箱子走的路径就是最短路径
repeat
ActiveCount := 0;
for i := FObjectList.Count - 1do
wnto 0do
begin
aBox := FObjectList.Items;
if aBox.Active then
begin
Inc(ActiveCount);
if aBox.Move then
Winner := aBox.Winner;
end
else
FObjectList.Delete(i);//删除被淘汰的箱子
end;
until (Winner <> nil) or (ActiveCount = 0);
if Winner <> nil then
begin
Result := Winner.FTrace;
end
else
Result := '';
finally
//释放资源
for i := 0 to FObjectList.Count - 1do
begin
aBox := FObjectList.Items;
aBox.Free;
end;
FObjectList.Free;
end;
end;
end;
constructor TBox.Create(ObjectList: TList;
Row, Column: Integer;
Map: TStrings;
Marks: TMoveObjects;
Target: TPoint);
begin
inherited Create(ObjectList, Row, Column, Map, Marks, Target);
FStepCount := 0;
end;
end.
