unit1.~pas

是用回朔法实现跳马程序。数据结构入门的好例子

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls;


type
  TForm1 = class(TForm)
    Edit1: TEdit;
    Edit2: TEdit;
    Button1: TButton;
    Memo1: TMemo;
    Edit3: TEdit;
    Button2: TButton;
    Memo2: TMemo;
    Label1: TLabel;
    Label2: TLabel;
    Label3: TLabel;
    Button3: TButton;
    Button4: TButton;
    Label4: TLabel;
    procedure Button1Click(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure Button3Click(Sender: TObject);
    procedure Button4Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;
  const
  stacksize=10000;
  type
   elementtype=record
     x,y:integer;
     order:0..8;
     end;
  stack=class
  element:array[1..stacksize] of elementtype;
  constructor init;
  destructor done;
  procedure push(item:elementtype);
  procedure pop(var item:elementtype);
  function isempty:boolean;
  function isfull:boolean;
  private
     top:word;
  end;
var
  Form1: TForm1;

implementation
{$R *.dfm}
constructor stack.init;
begin
  top:=0;
end;

destructor stack.done;
begin
end;

function stack.isempty:boolean;
begin
 isempty:=top=0;
end;

function stack.isfull :boolean;
begin
isfull:=top=stacksize;
end;

procedure stack.push(item:elementtype);

begin
  top:=top+1;
  element[top]:=item;
end;



procedure stack.pop (var item:elementtype);

   begin
   item :=element[top];
   top:=top-1;
   end;

procedure TForm1.Button1Click(Sender: TObject);

type
  locate=record
    x,y:integer;
    end ;

var
  ge:array[-1..100,-1..100] of 0..1;
  move:array[1..8] of locate;
  g,h,i,j,p,nextmove:integer;
  s:stack;
  currenposition:elementtype;
  find:boolean;
  m,n:integer;
begin
m:=strtoint(edit1.Text );
n:=strtoint(edit1.Text );
find:=false;
s:=stack.init ;
move[1].x :=1;
move[1].y :=2;
move[2].x :=2;
move[2].y :=1;
move[3].x :=2;
move[3].y :=-1;
move[4].x :=1;
move[4].y :=-2;
move[5].x :=-1;
move[5].y :=2;
move[6].x :=-2;
move[6].y :=1;
move[7].x :=-2;
move[7].y :=-1;
move[8].x :=-1;
move[8].y :=-2;
for i:=-1 to m+2 do
  for j:=-1 to n+2 do
   ge[i,j]:=1;
for i:=1 to m do
  for j:=1 to m do
   ge[i,j]:=0;
with currenposition do
  begin
  x:=strtoint(edit2.Text );
  y:=strtoint(edit3.Text );
  order:=0;
  ge[x,y]:=1;
  end;
  s.push(currenposition);

while (not s.isempty) and ( find=false) do
 begin
   s.pop(currenposition);
   with currenposition do
   begin
   order:=order+1;
   while (order<=8) and (s.top <=m*n-1) do
   begin
   g:=x+move[order].x ;
   h:=y+move[order].y ;
   if ge[g,h]=0 then
   begin
     ge[g,h]:=1;
     s.push(currenposition);
     x:=g;
     y:=h;
     order:=0;
     end;
     order:=order+1;
     end;
     if s.top=m*n-1 then
     find:=true
     else
     if order=9 then
     ge[x,y]:=0;
     end;
     end;
     if s.isempty then
     memo1.Text :='输入了错误起始点,请重新输入'
     else
     begin
     s.push(currenposition);
     for p:=1 to s.top do
     begin
      s.pop(currenposition);
     with  currenposition do
     memo1.Text :='x'+inttostr(x)+'y'+inttostr(y)+'-> '+memo1.Text;
     end;
     end;
     end;




procedure TForm1.FormCreate(Sender: TObject);
begin
memo1.Text :='';
memo2.Text :='';
end;

procedure TForm1.Button2Click(Sender: TObject);

type
  locate=record
    x,y:integer;
    end ;

var
  ge:array[-1..100,-1..100] of 0..1;
  move:array[1..8] of locate;
  g,h,i,j,p,nextmove:integer;
  s:stack;
  currenposition:elementtype;
  find:boolean;
  r,t,m,n:integer;

begin
m:=strtoint(edit1.Text );
n:=strtoint(edit1.Text );
find:=false;
move[1].x :=1;
move[1].y :=2;
move[2].x :=2;
move[2].y :=1;
move[3].x :=2;
move[3].y :=-1;
move[4].x :=1;
move[4].y :=-2;
move[5].x :=-1;
move[5].y :=2;
move[6].x :=-2;
move[6].y :=1;
move[7].x :=-2;
move[7].y :=-1;
move[8].x :=-1;
move[8].y :=-2;
for r:=1 to m do
  for t:=1 to n do
   begin
for i:=-1 to m+2 do
  for j:=-1 to n+2 do
   ge[i,j]:=1;
for i:=1 to m do
  for j:=1 to m do
   ge[i,j]:=0;
with currenposition do
  begin
  x:=r;
  y:=t;
  order:=0;
  ge[r,t]:=1;
  end;
  s:=stack.init ;
  s.push(currenposition);

while (not s.isempty) and ( find=false) do
 begin
   s.pop(currenposition);
   with currenposition do
   begin
   order:=order+1;
   while (order<=8) and (s.top <=m*n-1) do
   begin
   g:=x+move[order].x ;
   h:=y+move[order].y ;
   if ge[g,h]=0 then
   begin
     ge[g,h]:=1;
     s.push(currenposition);
     x:=g;
     y:=h;
     order:=0;
     end;
     order:=order+1;
     end;
     if s.top=m*n-1 then
     find:=true
     else
     if order=9 then
     ge[x,y]:=0;
     end;
     end;
     if  not s.isempty then
     memo2.Text :=memo2.Text +'x'+inttostr(r)+'y'+inttostr(t)+'-> ';
     s.done;
     find:=false;
     end;
     if memo2.Text ='' then
     memo2.Text :='没有附合的起始点,即'+edit1.Text +'阶矩阵不符合题意' ;
     end;

    procedure TForm1.Button3Click(Sender: TObject);
begin
edit1.Text :='';
edit2.Text :='';
edit3.Text :='';
memo1.Text :='';
memo2.Text :='';
edit1.SetFocus ;
end;

procedure TForm1.Button4Click(Sender: TObject);
begin
application.Terminate ;

end;

end.