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

Общие вопросы: версии и диалекты, синтаксис языка, cтруктуры и типы данных (массивы, строки, списки...), обработка данных и т.д.
Ответить
Otclik
Сообщения: 5
Зарегистрирован: 21 дек 2015, 16:47

21 дек 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.
Аватара пользователя
Сионист
Сообщения: 1077
Зарегистрирован: 31 мар 2014, 06:18

21 дек 2015, 17:17

А что такое шамотный конь? Фундамент знаю, лётки знаю, горн знаю, шахту знаю, распар знаю. А конь не попадался.
Писать можно на чём угодно, но зачем же так себя ограничивать? Пиши на c.
Otclik
Сообщения: 5
Зарегистрирован: 21 дек 2015, 16:47

21 дек 2015, 17:20

Опечатка, я имел ввиду шахматный
Аватара пользователя
Сионист
Сообщения: 1077
Зарегистрирован: 31 мар 2014, 06:18

21 дек 2015, 17:41

push помещает данное в стек, pop извлекает читает данное с вершины стека.
Писать можно на чём угодно, но зачем же так себя ограничивать? Пиши на c.
Otclik
Сообщения: 5
Зарегистрирован: 21 дек 2015, 16:47

21 дек 2015, 17:51

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