unit SearchUnit; interface uses Contnrs, Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, Dialogs, StdCtrls, MainUnit, ExtCtrls, ComCtrls, NodeUnit, AppEvnts; type TSearchForm = class(TForm) GroupBox1: TGroupBox; CBSource: TComboBox; CBTarget: TComboBox; Label1: TLabel; Label2: TLabel; BSearch: TButton; GroupBox2: TGroupBox; MRoute: TMemo; BCancel: TButton; PBProgress: TProgressBar; TTimi: TTimer; procedure FormShow(Sender: TObject); procedure BCancelClick(Sender: TObject); procedure BSearchClick(Sender: TObject); procedure TTimiTimer(Sender: TObject); private WayFound: boolean; procedure SearchRecursively(var ShortRoute, CurrentRoute: TObjectList; Source, Target: integer); procedure ShowRoute(R: TObjectList; Cap: String); public { Public declarations } end; var SearchForm: TSearchForm; implementation {$R *.dfm} procedure TSearchForm.FormShow(Sender: TObject); var i: integer; begin // Вызывается при отображении формы // Очистк выпадающих списков CBSource.Items.Clear; CBTarget.Items.Clear; MRoute.Clear; // Если количество узлов меньше 2 if GraphForm.GetGraphNodes.Count < 2 then begin BSearch.Enabled := False; CBSource.Enabled := False; CBTarget.Enabled := False; exit; end; // Включение графических жлементов BSearch.Enabled := True; CBSource.Enabled := True; CBTarget.Enabled := True; // Добавление в списки узлов графа for i := 0 to GraphForm.GetGraphNodes.Count - 1 do begin CBSource.Items.Add(IntToStr(i)); CBTarget.Items.Add(IntToStr(i)); end; // Утсановка начальных индексов узлов CBSource.ItemIndex := 0; CBTarget.ItemIndex := 0; end; procedure TSearchForm.BCancelClick(Sender: TObject); begin Self.Close; // При нажатии кнопки закрыть end; procedure TSearchForm.ShowRoute(R: TObjectList; Cap: String); var S: String; i: integer; N: TGraphNode; begin // Отображает маршрут //Формирование маршрута S := ''; for i := 0 to R.Count - 1 do begin N := TGraphNode(R.Items[i]); S := S + IntToStr(N.GetIndex) + ' -> '; end; // Вывод маршрута MessageBox(Self.Handle, PAnsiChar(S), PAnsiChar(Cap), MB_OK); end; procedure TSearchForm.SearchRecursively(var ShortRoute, CurrentRoute: TObjectList; Source, Target: integer); var CurrentNode, TargetNode: TGraphNode; i, j: integer; begin // debug // ShowRoute(ShortRoute, 'ShortRoute: enter point'); // ShowRoute(CurrentRoute, 'CurrentRoute: enter point'); CurrentNode := TGraphNode(CurrentRoute.Items[CurrentRoute.Count - 1]); // переберем все узлы, куда можно пойти (есть связь) for i := 0 to CurrentNode.GetTargetNodes.Count - 1 do begin // очередной узел TargetNode := TGraphNode(CurrentNode.GetTargetNodes[i]); // если мы там уже были - продолжить перебор if (TargetNode.IsVisited) or (TargetNode.GetIndex = Source) then continue; if TargetNode.GetIndex = Target then begin // путь найден - сравним с кратчайшим if (not WayFound) or (ShortRoute.Count > CurrentRoute.Count) then begin WayFound := True; // нашли путь короче чем был, или пути еще не было найдено вообще ShortRoute.Clear; for j := 0 to CurrentRoute.Count - 1 do begin ShortRoute.Add(CurrentRoute.Items[j]); TGraphNode(CurrentRoute.Items[j]).IsVisited := False; end; end; // debug // ShowRoute(ShortRoute, 'ShortRoute: found new way'); // ShowRoute(CurrentRoute, 'CurrentRoute: found new way'); // завершим работу exit; end; // добавим узел в маршрут CurrentRoute.Add(TargetNode); // пометим узел как пройденный TargetNode.IsVisited := True; // обыщем его // debug // ShowRoute(ShortRoute, 'ShortRoute: before recurs'); // ShowRoute(CurrentRoute, 'CurrentRoute: before recurs'); SearchRecursively(ShortRoute, CurrentRoute, Source, Target); // уберем узел из пути CurrentRoute.Remove(TargetNode); // debug // ShowRoute(ShortRoute, 'ShortRoute: after recurs'); // ShowRoute(CurrentRoute, 'CurrentRoute: after recurs'); // отметим как НЕ пройденный TargetNode.IsVisited := False; end; // debug // ShowRoute(ShortRoute, 'ShortRoute: last point'); // ShowRoute(CurrentRoute, 'CurrentRoute: last point'); end; procedure TSearchForm.BSearchClick(Sender: TObject); var ShortRoute, CurrentRoute: TObjectList; i: integer; Node: TGraphNode; begin if CBSource.ItemIndex = CBTarget.ItemIndex then begin MessageBox(Self.Handle, 'Неправильно заданы точки маршрута - они не могут совпадать', 'Внимание', MB_OK or MB_ICONWARNING); exit; end; // проверим нет ли пути напрямую Node := TGraphNode(GraphForm.GetGraphNodes.Items[CBSource.ItemIndex]); for i := 0 to Node.GetTargetNodes.Count - 1 do if TGraphNode(Node.GetTargetNodes.Items[i]).GetIndex = CBTarget.ItemIndex then begin // есть такой путь MRoute.Clear; MRoute.Text := IntToStr(CBSource.ItemIndex) + ' -> ' + IntToStr(CBTarget.ItemIndex); exit; end; // подготовим все к поиску PBProgress.Visible := True; TTimi.Enabled := True; BSearch.Enabled := False; CBSource.Enabled := False; CBTarget.Enabled := False; // пометим все вершины как непосещенные for i := 0 to GraphForm.GetGraphNodes.Count - 1 do TGraphNode(GraphForm.GetGraphNodes.Items[i]).IsVisited := False; // создадим списки для путей ShortRoute := TObjectList.Create; ShortRoute.OwnsObjects := False; CurrentRoute := TObjectList.Create; CurrentRoute.OwnsObjects := False; // добавим исходную вершину в списки ShortRoute.Add(GraphForm.GetGraphNodes.Items[CBSource.ItemIndex]); CurrentRoute.Add(GraphForm.GetGraphNodes.Items[CBSource.ItemIndex]); // запустим поиск WayFound := False; SearchRecursively(ShortRoute, CurrentRoute, CBSource.ItemIndex, CBTarget.ItemIndex); // Включение и выключение элементов PBProgress.Visible := False; TTimi.Enabled := False; BSearch.Enabled := True; CBSource.Enabled := True; CBTarget.Enabled := True; // покажем результаты if ShortRoute.Count = 1 then begin MessageBox(Self.Handle, 'Путь не найден', 'Сообщение', MB_OK or MB_ICONINFORMATION); exit; end; // Очистка минисмального маршрута MRoute.Clear; // Формирование нового минимального маршрута for i := 0 to ShortRoute.Count - 1 do begin Node := TGraphNode(ShortRoute.Items[i]); MRoute.Text := MRoute.Text + IntToStr(Node.GetIndex) + ' -> '; end; MRoute.Text := MRoute.Text + IntToStr(CBTarget.ItemIndex); end; procedure TSearchForm.TTimiTimer(Sender: TObject); begin // Сраотал таймер // Отображаем ход выполнения задачи if PBProgress.Position = PBProgress.Max then PBProgress.Position := PBProgress.Min else PBProgress.Position := PBProgress.Position + 1; end; end.