Недавно добавленные исходники

•  DeLiKaTeS Tetris (Тетрис)  166

•  TDictionary Custom Sort  3 340

•  Fast Watermark Sources  3 093

•  3D Designer  4 849

•  Sik Screen Capture  3 348

•  Patch Maker  3 554

•  Айболит (remote control)  3 664

•  ListBox Drag & Drop  3 016

•  Доска для игры Реверси  81 720

•  Графические эффекты  3 946

•  Рисование по маске  3 250

•  Перетаскивание изображений  2 631

•  Canvas Drawing  2 754

•  Рисование Луны  2 584

•  Поворот изображения  2 191

•  Рисование стержней  2 169

•  Paint on Shape  1 569

•  Генератор кроссвордов  2 239

•  Головоломка Paletto  1 767

•  Теорема Монжа об окружностях  2 233

•  Пазл Numbrix  1 685

•  Заборы и коммивояжеры  2 059

•  Игра HIP  1 282

•  Игра Go (Го)  1 230

•  Симулятор лифта  1 475

•  Программа укладки плитки  1 219

•  Генератор лабиринта  1 548

•  Проверка числового ввода  1 367

•  HEX View  1 497

•  Физический маятник  1 358

 
скрыть


Delphi FAQ - Часто задаваемые вопросы

| Базы данных | Графика и Игры | Интернет и Сети | Компоненты и Классы | Мультимедиа |
| ОС и Железо | Программа и Интерфейс | Рабочий стол | Синтаксис | Технологии | Файловая система |



Delphi Sources

Поиск пути




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, которая после выбора первой точки, соединенной с начальной, и включения ее в маршрут вызывает сама себя. При этом в качестве начальной точки задается уже не исходная, а текущая, только что включенная в маршрут.





Похожие по теме исходники

Поисковик

Поиск символа

Поиск файлов

Поиск открытых файлов

 

Findup (поиск дублей)

Дейкстра: поиск кратчайшего пути

A Star (нахождение кратчайшего пути)

Нахождение кратчайшего пути

 



Copyright © 2004-2024 "Delphi Sources" by BrokenByte Software. Delphi World FAQ

Группа ВКонтакте