Delphi World - это проект, являющийся сборником статей и малодокументированных возможностей  по программированию в среде Delphi. Здесь вы найдёте работы по следующим категориям: delphi, delfi, borland, bds, дельфи, делфи, дэльфи, дэлфи, programming, example, программирование, исходные коды, code, исходники, source, sources, сорцы, сорсы, soft, programs, программы, and, how, delphiworld, базы данных, графика, игры, интернет, сети, компоненты, классы, мультимедиа, ос, железо, программа, интерфейс, рабочий стол, синтаксис, технологии, файловая система...
Поиск пути


unit road_;

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

type
  TForml = class(TForm)
    StringGridl: TStringGrid;
    Edit1: TEdit;
    Edit2: TEdit;
    Label1: TLabel;
    Label2: TLabel;
    Label3: TLabel;
    Button1: TButton;
    Label4: TLabel;
    procedure FormActivate(Sender: TObject);
    procedure ButtonlClickfSender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation
{$R *.DFM}

procedure TForml.FormActivate(Sender: TObject);
var
  i: integer;
begin
  // нумерация строк
  for i := 1 to 10 do
    StringGridl.Cells[0, i] := IntToStr(i); // нумерация колонок

  for i := l to 10 do
    StringGridl.Cells[1, 0] := IntToStr(i);

  // описание предопределенной карты
  StringGridl.Cells[1,2]:='1'
  StringGridl.Cells[2,l]:='1'

  StringGridl.Cells[1, 3] := '1'
  StringGridl.Cells[3, 1] := '1'
  StringGridl.Cells[1, 4] := '1'
  StringGridl.Cells[4, 1] := '1'
  StringGridl.Cells[3, 7] := '1'
  StringGridl.Cells[7, 3] := '1'
  StringGridl.Cells[4, 6] := '1'
  StringGridl.Cells[6, 4] := '1'
  StringGridl.Cells[5, 6] := '1'
  StringGridl.Cells[6, 5] := '1'
  StringGridl.Cells[5, 7] := '1'
  StringGridl.Cells[7, 5] := '1'
  StringGridl.Cells[6, 7] := '1'
  StringGridl.Cells[7, 6] := '1'
end;

procedure TForml.ButtonlClick(Sender: TObject);
const
  N = 10; // кол-во вершин графа var
  map: array[1..N, 1..N] of integer; // Карта.map[i,j]ne 0,

  // если точки i и j соединены
  road: array[1..N] of integer;

  // Дорога - номера точек карты
  incl: array[1..N] of boolean; // incl[1]равен TRUE, если точка

  // с номером i включена в road
  start, finish: integer; // Начальная и конечная точки
  found: boolean; i, j: integer;

  procedure step(s, f, p: integer);
  var
    с: integer; // Номер точки, в которую делаем очередной шаг
    i: integer;
  begin
    if s = f then
    begin
      // Точки s и f совпали !
      found := TRUE;
      Labell.caption := Labell.caption + #13 + 'Путь:';
      for i := l to p - 1 do
        Labell.caption := Labell.caption + ' '
          + IntToStr(road[i]);
    end
    else
    begin
      // выбираем очередную точку
      for c:=l to N do
      begin // проверяем все вершины
        // точка соединена с текущей и не включена в маршрут
        if (map[s, c] <> 0) and (not incite1) then
        begin
          road[p] := c; // добавим вершину в путь
          incl[c] := TRUE; // пометим вершину как включенную
          step(c, f, p + l); incite] := FALSE;
          road[p] := 0;
        end;
      end;
    end;
  end; // конец процедуры step

begin
  Label1.caption: = ' ';
  // инициализация массивов
  for i := l to N do
    road[i] := 0;

  for i := l to N do
    incl[i] := FALSE;

  // ввод описания карты из SrtingGrid.Cells
  for i := l to N do
    for j := 1 to N do
      if StringGrid1.Cells[i, j] <> '' then
        map[i, j] := StrToInt(StringGridl.Cells[i, j];
      else
        map[i, j] := 0;

  start := StrToInt(Editl.text);
  finish := StrToInt(Edit2.text);
  road[l] := start; // внесем точку в маршрут
  incl[start] := TRUE; // пометим ее как включенную
  step(start, finish, 2); //ищем вторую точку маршрута
  // проверим, найден ли хотя бы один путь
  if not found then
    Labell.caption := 'Указанные точки не соединены!';
end;

end.

При запуске программы в момент активизации формы приложения происходит событие onActivate, процедура обработки которого заполняет массив StringGridl.cells значениями, представляющими описание карты. Этаже процедура нумерует строки и столбцы таблицы, заполняя зафиксированные ячейки первого столбца и первой строки StringGridl.

Поиск маршрута инициирует процедура TFormi.Buttoniciick, которая запускается щелчком на кнопке Поиск. Данная процедура для поиска точки, соединенной с исходной точкой, вызывает процедуру step, которая после выбора первой точки, соединенной с начальной, и включения ее в маршрут вызывает сама себя. При этом в качестве начальной точки задается уже не исходная, а текущая, только что включенная в маршрут.

Проект Delphi World © Выпуск 2002 - 2004
Автор проекта: ___Nikolay