PDA

Просмотр полной версии : Помогите разобраться с функциями и процедурами (в конкретном примере)



Otclik
21.12.2015, 16:54
Программа находит кротчайший путь шамотного коня до заданной клетки поля.
Прошу, помогите пожалуйста разобраться с алгоритмом поиска и что делают:
- Procedure Push
- function Pop
- function TryXY
- procedure Hod


unit Kon;

interface

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

type
TForm1 = class(TForm)
Sg: TStringGrid;
BitBtn1: TBitBtn;
procedure SgDrawCell(Sender: TObject; ACol, ARow: Integer;
Rect: TRect; State: TGridDrawState);
procedure SgMouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
procedure BitBtn1Click(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;

var
Form1: TForm1;

implementation
{$R *.dfm}

Type
Pzap = ^Tzap;
Tzap = record
x, y, n: integer;
pz, nz: Pzap;
end;

Var
k: Tpoint = (X:4; Y:2);
p: Tpoint = (X:2; Y:2);
aa: array[1..9, 1..9] of byte;

a1, a2: array[1..64] of Tpoint;
z, z0: Pzap;

procedure Clear();
var
i, j: integer;
begin
for i:=-1 to 10 do
for j:=-1 to 10 do
if (i<1)or(j<1)or(i>8)or(j>8)
then aa[i, j]:= 1
else aa[i, j]:= 0;
end;

procedure Push(x,y,a: integer);
var w: Pzap;
begin
if (aa[x, y]>0) then exit;
aa[x, y]:= 1;

New(w);
w.x:= x;
w.y:= y;
w.n:= a;

z0.pz:= w;
w.nz:= z;
w.pz:= nil;
z0:= w;
end;

function Pop(var x,y,a: integer): boolean;

begin
Result:= false;

if z=nil then exit;


z:= z.pz;

x:= z.x;
y:= z.y;
a:= z.n;
Result:= true;
end;

function Get(x,y: integer): integer;

function TryXY(x,y, a: integer): boolean;
begin
Result:= (x=p.X)and(y=p.Y);
if not Result then Push(x, y, a);
end;

var
n: integer;
Res: boolean;

begin
Result:= -1;
n:= 0;
new(z0);
z0.x:= x;
z0.y:= y;
z0.n:= 0;
z0.pz:= nil;
z0.nz:= nil;
z:= z0;

aa[x, y]:= 3;

Repeat
inc(n);
Res:= TryXY(x-1, y-2, n) or
TryXY(x-1, y+2, n) or
TryXY(x+1, y-2, n) or
TryXY(x+1, y+2, n) or
TryXY(x+2, y+1, n) or
TryXY(x+2, y-1, n) or
TryXY(x-2, y+1, n) or
TryXY(x-2, y-1, n);

if Res then
begin
Result:= n;
aa[p.x, p.y]:= 4;
while z<> nil do
begin
aa[z.x, z.y]:= 2;
z:= z.nz;
end;
break;
end;
if not pop(x,y,n) then break;

Until z0=nil;

end;

procedure Hod(x,y: integer; a: integer; var r: integer);
begin
if aa[x, y]>0 then exit;
if (R>=0)and(a>=R) then
begin
aa[x, y]:= 1;
exit;
end;

if (x=p.X)and(y=p.Y) then
begin
{if (a<R)or(R<0) then} R:= a;
aa[x, y]:= 1;
exit;
end;

aa[x, y]:= 1;
inc(a);
Hod(x-1, y-2, a, r);
Hod(x-2, y-1, a, r);
Hod(x-1, y+2, a, r);
Hod(x-2, y+1, a, r);
Hod(x+1, y+2, a, r);
Hod(x+2, y+1, a, r);
Hod(x+1, y-2, a, r);
Hod(x+2, y-1, a, r);
end;



procedure TForm1.SgDrawCell(Sender: TObject; ACol, ARow: Integer;
Rect: TRect; State: TGridDrawState);
var st: string;
begin
if (aCol+aRow)=0 then exit;
st:= '';

with sg.Canvas do
begin
Case aa[aCol, aRow] of
1: brush.Color:= clMedGray;
0: brush.Color:= clWhite;
2: brush.Color:= clNavy;
else brush.Color:= clBlack;
end;

if acol=0 then st:= inttostr(arow) else
if arow=0 then st:= inttostr(acol) else
if (acol=k.X)and(arow=k.Y) then
begin
st:= 'Ê';
brush.Color:= clYellow;
end
else
if (acol=p.X)and(arow=p.Y) then
begin
st:= '*';
brush.Color:= clYellow;
end;
Rectangle(Rect);
Font.Color:= clBlack;
TextOut(rect.Left+7, rect.Top+5, st);
end;
end;

procedure TForm1.SgMouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
var
r, c: integer;
begin
sg.MouseToCell(x,y, c,r);

if (c*r=0) then exit;
if Button= mbLeft then
begin
k.X:= c;
k.Y:= r;
end
else
begin
p.X:= c;
p.Y:= r;
end;

Clear();
sg.Refresh;
end;

procedure TForm1.BitBtn1Click(Sender: TObject);
var r: integer;
begin
Caption:= '';
r:= -1;

Clear();
r:= Get(k.X, k.Y);

Caption:= IntToStr(r);

sg.Refresh;
end;

end.

Сионист
21.12.2015, 17:17
А что такое шамотный конь? Фундамент знаю, лётки знаю, горн знаю, шахту знаю, распар знаю. А конь не попадался.

Otclik
21.12.2015, 17:20
Опечатка, я имел ввиду шахматный

Сионист
21.12.2015, 17:41
push помещает данное в стек, pop извлекает читает данное с вершины стека.

Otclik
21.12.2015, 17:51
Спасибо, уже на шаг ближе к пониманию программы.
Вообще код нашёл где то в интернете, у меня задание просто очень похоже хотелось бы разобраться и на основе свое сделать. Если не трудно, опишите остальные.