Нахождение кратчайшего пути
	
	
тогда d (s, v) - расстоянию от s до v. 
       Заметим, что для того чтобы определить  расстояние  от  s  до  t,  мы 
вычисляем здесь расстояния от s до всех вершин графа. 
       Не известен  ни  один  алгоритм  нахождения  расстояния  между  двумя 
фиксированными  вершинами,  который  был  бы  существенным   образом   более 
эффективным,  нежели   известные   алгоритмы   определения   расстояния   от 
фиксированной вершины до всех остальных. 
       Описанная общая схема является неполной, так как  она  не  определяет 
очередности, в которой  выбираются  вершины  u  и  v  для  проверки  условия 
минимальности расстояния. Эта очередности, как будет  показано  ниже,  очень 
сильно влияет на  эффективность  алгоритма.  Опишем  теперь  более  детально 
методы  нахождения   расстояния   от   фиксированной   вершины,   называемой 
источником, его всегда будем обозначать через s, до  всех  остальных  вершин 
графа. 
       Сначала  представим   алгоритм   для   общего   случая,   в   котором 
предполагается только отсутствие контуров  с  отрицательной  длиной.  С  эти 
алгоритмом обычно связывают имена Л.Р. Форда и Р.Е. Беллмана. 
              3. Программа определения кратчайшего пути в графе 
                    1 3.1. Язык программирования Delphi. 
       Delphi - язык и среда программирования,  относящаяся  к  классу  RAD- 
(Rapid Application Development - «Средство быстрой  разработки  приложений») 
средств CASE -  технологии.  Delphi  сделала  разработку  мощных  приложений 
Windows  быстрым  процессом,  доставляющим  вам   удовольствие.   Приложения 
Windows, для создания которых требовалось  большое  количество  человеческих 
усилий  например  в  С++,  теперь  могут  быть  написаны  одним   человеком, 
использующим Delphi. 
       Интерфейс Windows обеспечивает полное перенесение  CASE-технологий  в 
интегрированную систему поддержки работ по созданию  прикладной  системы  на 
всех фазах жизненного цикла работы и проектирования системы. 
       Delphi   обладает   широким   набором   возможностей,   начиная    от 
проектировщика  форм  и  кончая  поддержкой  всех  форматов  популярных  баз 
данных.  Среда  устраняет  необходимость  программировать  такие  компоненты 
Windows общего назначения, как метки, пиктограммы и даже диалоговые  панели. 
Работая в Windows , вы неоднократно видели одинаковые  «объекты»  во  многих 
разнообразных приложениях. Диалоговые панели (например Choose  File  и  Save 
File) являются примерами многократно  используемых  компонентов,  встроенных 
непосредственно в Delphi, который позволяет приспособить  эти  компоненты  к 
имеющийся задаче, чтобы они работали именно так, как требуется  создаваемому 
приложению. Также здесь имеются предварительно определенные визуальные и  не 
визуальные  объекты,  включая  кнопки,  объекты  с  данными,  меню   и   уже 
построенные диалоговые панели. С  помощью  этих  объектов  можно,  например, 
обеспечить  ввод  данных  просто  несколькими  нажатиями  кнопок  мыши,   не 
прибегая к  программированию.  Это  наглядная  реализация  применений  CASE- 
технологий в современном  программировании  приложений.  Та  часть,  которая 
непосредственно  связана   с   программированием   интерфейса   пользователя 
системой получила название визуальное программирование 
       Визуальное программирование как  бы  добавляет  новое  измерение  при 
создании создании приложений, давая возможность изображать  эти  объекты  на 
экране   монитора   до   выполнения   самой   программы.   Без   визуального 
программирования  процесс  отображения  требует  написания  фрагмента  кода, 
создающего и настающего объект «по месту».  Увидеть  закодированные  объекты 
было  возможно  только  в  ходе  исполнения  программы.  При  таком  подходе 
достижение того, чтобы объекты  выглядели  и  вели  себя  заданным  образом, 
становится   утомительным   процессом,   который    требует    неоднократных 
исправлений  программного  кода  с   последующей   прогонкой   программы   и 
наблюдения за тем, что в итоге получилось. 
       Благодаря средствам визуальной разработки можно работать с объектами, 
держа их перед глазами и получая результаты практически  сразу.  Способность 
видеть объекты такими, какими они появляются в  ходе  исполнения  программы, 
снимает необходимость проведения множества операций вручную, что  характерно 
для работы в среде не обладающей визуальными средствами  —  вне  зависимости 
от того, является она объектно-ориентированной  или  нет.  После  того,  как 
объект помещен в форму среды визуального программирования, все его  атрибуты 
сразу отображаются в виде кода, который соответствует объекту  как  единице, 
исполняемой в ходе работы программы. 
       Размещение объектов в Delphi  связано  с  более  тесными  отношениями 
между объектами и реальным программным  кодом.  Объекты  помещаются  в  вашу 
форму, при этом  код,  отвечающий  объектам,  автоматически  записывается  в 
исходный  файл.  Этот  код  компилируется,  обеспечивая  существенно   более 
высокую производительность, чем  визуальная  среда,  которая  интерпретирует 
информацию лишь в ходе исполнения программы. 
           1 3.2. Программа «Определение кратчайшего пути в графе» 
       Программа «Определение кратчайшего пути в графе» разработана в среде 
«Delphi», работает под ОС «Windows»-95,98,2000,NT. 
       Программа позволяет вводить, редактировать, сохранять графы в файл, 
загружать из файла. Также реализован алгоритм нахождения кратчайшего пути. 
       Интерфейс программы имеет следующий вид: 
[pic] 
       Верхняя панель кнопок предназначена для редактирования графа. 
       Кнопка «Загрузить» [pic] предназначена для загрузки ранее 
сохраненного графа из файла. 
       Кнопка «Сохранить» [pic] предназначена для сохранения графа в файл. 
       Кнопка  «Переместить»  [pic]  предназначена  для  перемещения  вершин 
графа. 
       Кнопка «Удалить» [pic] предназначена для удаления вершин графа. 
       При нажатии на кнопку «Новый»  [pic]  рабочее  поле  программы  будет 
очищено и появится возможность ввода нового графа. 
       Кнопка «Помощь» [pic] вызывает помощь программы. 
       Для очистки результатов работы алгоритма определения кратчайшего пути 
в графе необходимо нажать кнопку «Обновить» [pic]. 
       При нажатии на кнопку «Настройки» [pic] на экране  появится  окно,  в 
котором можно настроить параметры сетки  рабочего  поля  программы  и  цвета 
вводимого графа. 
       Окно настроек выглядит следующим образом: 
                                    [pic] 
       Нижняя панель кнопок предназначена для установки параметров  ввода  и 
запуска алгоритма  определения  кратчайшего  пути  в  графе.  Данная  панель 
состоит из четырех кнопок: 
       При включенной кнопке «Показывать сетку» [pic] отображается сетка для 
удобства ввода вершин. 
       Для автоматического ввода длины ребра графа необходимо нажать  кнопку 
[pic]. 
       При включенной кнопке «Выравнивать  по  сетке»  [pic]  новые  вершины 
будут автоматически выравниваться по координатной сетке. 
      Если выбрать две различные вершины (щелчком левой кнопки мыши) и 
      нажать на кнопку [pic], то программа найдет кратчайший путь между 
                                 вершинами. 
       Алгоритм определения кратчайшего пути между  вершинами  графа  описан 
следующим модулем программы: 
       unit MinLength; 
       interface 
       uses 
         Windows, Messages, SysUtils, Classes, Graphics, Controls, Dialogs, 
         StdCtrls,IO,Data,AbstractAlgorithmUnit; 
       type 
         TMinLength = class(TAbstractAlgorithm) 
         private 
            StartPoint:integer; 
            EndPoint:integer; 
            First:Boolean; 
            Lymbda:array of integer; 
            function Proverka:Boolean; 
         public 
            procedure Make; 
         end; 
       var 
         MyMinLength: TMinLength; 
       implementation 
       uses MainUnit, Setting; 
       procedure TMinLength.Make; 
                var i ,j  : integer; 
                   PathPlace,TempPoint:Integer; 
                   flag:boolean; 
                begin 
                  with MyData do begin 
            StartPoint:=MyIO.FirstPoint; 
            EndPoint:=MyIO.LastPoint; 
                            SetLength(Lymbda,Dimension+1); 
                   SetLength(Path,Dimension+1); 
                  for i:=1 to Dimension do 
                     Lymbda[i]:=100000; 
                  Lymbda[StartPoint]:=0; 
                  repeat 
                    for i:=1 to Dimension do 
                       for j:=1 to Dimension do 
                          if Matrix[i,j]=1 then 
                              if     (    (    Lymbda[j]-Lymbda[i]    )    > 
MatrixLength[j,i] ) 
                              then Lymbda[j]:=Lymbda[i] + MatrixLength[j,i]; 
                  until Proverka ; 
                  Path[1]:= EndPoint ; 
                  j:=1; 
                  PathPlace:=2; 
                  repeat 
                    TempPoint:=1; 
                    Flag:=False; 
                    repeat 
                      if ( Matrix[ Path[ PathPlace-1 ],TempPoint] =1  )and ( 
                         Lymbda[ Path[ PathPlace-1] ] = 
                          ( Lymbda[TempPoint] + MatrixLength[ Path[PathPlace- 
1 ], TempPoint] ) ) 
                          then Flag:=True 
                          else Inc( TempPoint ); 
                    until Flag; 
                    Path[ PathPlace ]:=TempPoint; 
                    inc( PathPlace ); 
                     MyIO.DrawPath(Path[   PathPlace-2   ],Path[   PathPlace 
-1],true); 
        //            ShowMessage('f'); 
                  until(Path[ PathPlace - 1 ] = StartPoint); 
       //            MyIO.DrawPath(Path[   PathPlace-1   ],Path[   PathPlace 
],true); 
                  end; 
                end; 
       function TMinLength.Proverka:Boolean; 
                var i,j:integer; 
                    Flag:boolean; 
                begin 
                  i:=1; 
                  Flag:=False; 
                  With MyData do begin 
                  repeat 
                    j:=1; 
                    repeat 
                      if Matrix[i,j]=1 then 
                       if  (   Lymbda[j]-Lymbda[i]   )>MatrixLength[j,i]then 
Flag:=True; 
                      inc(j); 
                    until(j>Dimension)or(Flag); 
                    inc(i); 
                  until(i>Dimension)or(Flag); 
                  Result:=not Flag; 
                  end; 
                end; 
       end. 
       Рабочее поле программы предназначено для визуального ввода графов. 
       Рабочее поле с введенным графом выглядит следующим образом: 
                                    [pic] 
                                 ЗАКЛЮЧЕНИЕ 
       Теория графов находит широкое применение в различных областях науки и 
техники: 
                             Графы и информация 
       Двоичные деревья играют  весьма  важную  роль  в  теории  информации. 
Предположим, что определенное число сообщений требуется закодировать в  виде 
конечных последовательностей различной длины, состоящих из нулей  и  единиц. 
Если вероятности кодовых слов заданы, то наилучшим считается код, в  котором 
средняя  длина  слов  минимальна  по  сравнению  с  прочими  распределениями 
вероятности. Задачу о построении такого оптимального кода  позволяет  решить 
алгоритм Хаффмана. 
       Двоичные кодовые деревья  допускают  интерпретацию  в  рамках  теории 
поиска. Каждой вершине при этом сопоставляется вопрос, ответить  на  который 
можно  либо  "да",  либо  "нет".  Утвердительному  и  отрицательному  ответу 
соответствуют два ребра, выходящие из вершины.  "Опрос"  завершается,  когда 
удается установить то, что требовалось. 
       Таким образом, если кому-то понадобится взять  интервью  у  различных 
людей, и ответ на очередной вопрос будет зависеть  от  заранее  неизвестного 
ответа на предыдущий вопрос, то план такого  интервью  можно  представить  в 
виде двоичного дерева. 
                                Графы и химия 
       Еще А. Кэли рассмотрел задачу о возможных структурах насыщенных  (или 
предельных) углеводородов, молекулы которых задаются формулой: 
       CnH2n+2 
       Молекула каждого предельного углеводорода представляет собой  дерево. 
Если удалить все атомы водорода,  то  оставшиеся  атомы  углеводорода  также 
будут образовывать дерево, каждая вершина которого имеет степень не выше  4. 
Следовательно, число возможных структур   предельных  углеводородов,  т.  е. 
число гомологов данного вещества, равно числу деревьев с  вершинами  степени 
не больше четырех. 
       Таким образом, подсчет числа гомологов предельных углеводородов также 
приводит к задаче о перечислении деревьев определенного типа. Эту  задачу  и 
ее обобщения рассмотрел Д. Пойа. 
                              Графы и биология 
       Деревья  играют  большую  роль  в  биологической  теории   ветвящихся 
процессов. Для простоты мы рассмотрим только одну  разновидность  ветвящихся 
процессов  –  размножение  бактерий.  Предположим,  что  через  определенный 
промежуток  времени  каждая  бактерия  либо  делится  на  две  новые,   либо 
погибает. Тогда для потомства одной бактерии мы получим двоичное дерево. 
       Нас будет интересовать лишь  один  вопрос:  в  скольких  случаях  n-е 
поколение  одной  бактерии  насчитывает  ровно  k   потомков?   Рекуррентное 
соотношение, обозначающее число необходимых  случаев,  известно  в  биологии 
под  названием  процесса  Гальтона-Ватсона.  Его  можно  рассматривать   как 
частный случай многих общих формул. 
                               Графы и физика 
       Еще недавно одной  из  наиболее  сложных  и  утомительных  задач  для 
радиолюбителей было конструирование печатных схем. 
       Печатной  схемой  называют  пластинку  из   какого-либо   диэлектрика 
(изолирующего  материала),  на  которой   в   виде   металлических   полосок 
вытравлены  дорожки.  Пересекаться  дорожки  могут  только  в   определенных 
точках, куда устанавливаются необходимые элементы (диоды, триоды,  резисторы 
и другие), их пересечение в других местах  вызовет  замыкание  электрической 
цепи. 
       В ходе решения этой  задачи  необходимо  вычертить  плоский  граф,  с 
вершинами в указанных точках. 
       Итак, из  всего  вышесказанного  неопровержимо  следует  практическая 
ценность теории графов. 
                              СПИСОК ЛИТЕРАТУРЫ 
1. Белов Теория Графов, Москва, «Наука»,1968. 
2. Новые  педагогические  и  информационные  технологии  Е.С.Полат,  Москва, 
   «Akademia» 1999 г. 
3.  Кузнецов  О.П.,  Адельсон-Вельский  Г.М.   Дискретная   математика   для 
   инженера. – М.: Энергоатомиздат, 1988. 
4. Кук Д., Бейз Г. Компьютерная математика. – М.: Наука, 1990. 
5.  Нефедов  В.Н.,  Осипова  В.А.  Курс   дискретной   математики.   –   М.: 
   Издательство МАИ, 1992. 
6. Оре О. Теория графов. – М.: Наука, 1980. 
7. Исмагилов Р.С.,  Калинкин  А.В.  Матеpиалы  к  пpактическим  занятиям  по 
   куpсу: Дискpетная математика по теме: Алгоpитмы на гpафах.  -  М.:  МГТУ, 
   1995 
8. Смольяков Э.Р. Введение в теоpию гpафов. М.: МГТУ, 1992 
9. Hечепуpенко М.И. Алгоpитмы и пpогpаммы pешения задач на гpафах  и  сетях. 
   - Hовосибиpск: Hаука, 1990 
10. Романовский И.В. Алгоpитмы pешения экстpемальных  задач.  -  М.:  Hаука, 
   1977 
11. Писсанецки С. Технология разреженных матриц. - М.: Мир, 1988 
12. Севастьянов Б.А. Вероятностные модели. - М.: Наука, 1992 
13. Бочаров П.П., Печинкин А.В. Теория  вероятностей.  -  М.:  Изд-во  РУДН, 
   1994 
                                 ПРИЛОЖЕНИЕ 
           1 Текст программы определения кратчайшего пути в графе 
Модуль управления интерфейсом программы: 
unit MainUnit; 
interface 
uses 
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, 
   StdCtrls,PaintingGraph, ComCtrls, ToolWin, ImgList, Menus, 
  ActnList, ExtCtrls; 
const 
  crMyCursor = 5; 
type 
  TForm1 = class(TForm) 
    SaveDialog1: TSaveDialog; 
    OpenDialog1: TOpenDialog; 
    ImageList1: TImageList; 
    ImageList2: TImageList; 
    LoadMenu: TPopupMenu; 
    ControlBar1: TControlBar; 
    ToolBar3: TToolBar; 
    OpenButton: TToolButton; 
    SaveButton: TToolButton; 
    ToolButton15: TToolButton; 
    ClearButton: TToolButton; 
    UpdateButton: TToolButton; 
    HelpButton: TToolButton; 
    ToolButton26: TToolButton; 
    RemovePointButton: TToolButton; 
    ToolButton28: TToolButton; 
    ToolButton32: TToolButton; 
    SettingButton: TToolButton; 
    ControlBar2: TControlBar; 
    AlgoritmToolBar: TToolBar; 
    KommiTool: TToolButton; 
    ToolButton: TToolButton; 
    NotFarButton: TToolButton; 
    MinLengthButton: TToolButton; 
    ToolButton5: TToolButton; 
    MovePointButton: TToolButton; 
    ActionList1: TActionList; 
    AShowGrig: TAction; 
    ASnapToGrid: TAction; 
    ASave: TAction; 
    ALoad: TAction; 
    ADelete: TAction; 
    GridToolBar: TToolBar; 
    Clock: TLabel; 
    Timer1: TTimer; 
    ShowGridButton: TToolButton; 
    AutoLengthButton: TToolButton; 
    SnapToGridButton: TToolButton; 
    PaintBox1: TPaintBox; 
    procedure FormMouseDown(Sender: TObject; Button: TMouseButton; 
      Shift: TShiftState; X, Y: Integer); 
    procedure FormCreate(Sender: TObject); 
    procedure FormMouseMove(Sender: TObject; Shift: TShiftState; X, 
      Y: Integer); 
    procedure FormPaint(Sender: TObject); 
    procedure FormKeyDown(Sender: TObject; var Key: Word; 
      Shift: TShiftState); 
    procedure ClearButtonClick(Sender: TObject); 
    procedure KommiToolButtonClick(Sender: TObject); 
    procedure PaintingToolButtonClick(Sender: TObject); 
    procedure SnapToGridButtonClick(Sender: TObject); 
    procedure HelpButtonClick(Sender: TObject); 
    procedure AutoLengthButtonClick(Sender: TObject); 
    procedure SettingButtonClick(Sender: TObject); 
    procedure NotFarButtonClick(Sender: TObject); 
    procedure MinLengthButtonClick(Sender: TObject); 
    procedure MovePointButtonClick(Sender: TObject); 
    procedure RemovePointButtonClick(Sender: TObject); 
    procedure Timer1Timer(Sender: TObject); 
    procedure ALoadExecute(Sender: TObject); 
    procedure AShowGrigExecute(Sender: TObject); 
    procedure ASaveExecute(Sender: TObject); 
    procedure PaintBox1Paint(Sender: TObject); 
    procedure UpdateButtonClick(Sender: TObject); 
    procedure EilerButtonClick(Sender: TObject); 
    procedure ClockClick(Sender: TObject); 
  private 
    procedure MyPopupHandler(Sender: TObject); 
    { Private declarations } 
  public 
    { Public declarations } 
  end; 
var 
  Form1: TForm1; 
implementation 
uses IO,Data,Commercial,DrawingObject,Setting,NotFar,MinLength, Eiler, 
  SplashScreen; 
{$R *.DFM} 
procedure TForm1.FormMouseDown(Sender: TObject; Button: TMouseButton; 
  Shift: TShiftState; X, Y: Integer); 
begin 
if Button=mbLeft then  begin 
  MyIO.FormMouseDown( X, Y); 
  if (MyIO.State=msMove)then 
      if MyIO.FirstPointActive then 
         Cursor := crMyCursor 
      else begin 
         Repaint; 
         Cursor := crDefault; 
      end; 
    end 
else 
  MyIO.MakeLine(X, Y); 
end; 
procedure TForm1.FormCreate(Sender: TObject); 
begin 
Screen.Cursors[crMyCursor] := LoadCursor(HInstance, 'Shar'); 
MyIO:=TIO.Create(PaintBox1.Canvas); 
MyData:=TData.Create; 
MyDraw:=TDrawingObject.Create(PaintBox1.Canvas); 
SaveDialog1.InitialDir:=ExtractFilePath(Application.ExeName)+'Grafs'; 
OpenDialog1.InitialDir:=ExtractFilePath(Application.ExeName)+'Grafs'; 
end; 
procedure TForm1.FormMouseMove(Sender: TObject; Shift: TShiftState; X, 
  Y: Integer); 
begin 
MyIO.DrawLine(x,y); 
end; 
procedure TForm1.FormPaint(Sender: TObject); 
begin 
PaintBox1Paint(Sender); 
end; 
procedure TForm1.FormKeyDown(Sender: TObject; var Key: Word; 
  Shift: TShiftState); 
begin 
if (Key=vk_Escape) then 
  begin 
  MyData.Remove(MyData.Dimension); 
  MyDraw.Remove(MyData.Dimension); 
  Repaint; 
  end; 
end; 
procedure TForm1.MyPopupHandler(Sender: TObject); 
var s:string; 
begin 
  with Sender as TMenuItem do begin 
      s:=Caption; 
      MyData.Load(s); 
      System.Delete(s,length(s)-4,5); 
      MyDraw.Load(s+'.pos'); 
  end; 
Repaint; 
end; 
procedure TForm1.ClearButtonClick(Sender: TObject); 
begin 
MyData.Clear; 
MyDraw.Clear; 
Repaint; 
end; 
procedure TForm1.KommiToolButtonClick(Sender: TObject); 
begin 
 If MyData.Dimension-1 then 
    if State=msLining then begin 
      MyData.Rebro(ActivePoint,i); 
      if AutoLength then begin 
        V1:=MyDraw.FindByNumber(ActivePoint); 
        V2:=MyDraw.FindByNumber(i); 
        MyData.SetRebroLength(ActivePoint,i,Round( 
               sqrt(sqr(Mashtab*(V1.x-V2.x)/ GrigStep)+ 
                    sqr(Mashtab*(V1.y-V2.y)/ GrigStep)))); 
      end; 
      MyCanvas.MoveTo(xs,ys); 
      MyCanvas.LineTo(xt,yt); 
      DrawPath(ActivePoint,i,false); 
      State:=msNewPoint; 
      MyDraw.SetUnActive(ActivePoint); 
    end 
else begin 
   ActivePoint:=i; 
   State:=msLining; 
   xs:=MyDraw.FindByNumber(i).x;  xt:=xs; 
   ys:=MyDraw.FindByNumber(i).y;  yt:=ys; 
   MyDraw.SetActive(i); 
 end ; 
end; 
procedure TIO.DrawLine(x1,y1:Integer); 
begin 
if State=msLining then 
with MyCanvas do 
    begin 
      Pen.Width:=2; 
      Pen.Color:=MovingColor; 
      Pen.Mode:=pmXor; 
      Pen.Style:=psSolid; 
      MoveTo(xs,ys); 
      LineTo(xt,yt); 
      MoveTo(xs,ys); 
      LineTo(x1,y1); 
     xt:=x1; 
     yt:=y1; 
    end; 
{if State=msMove then 
with MyCanvas do 
    begin 
      Pen.Width:=2; 
      Pen.Color:=MovingColor; 
      Pen.Mode:=pmXor; 
      Pen.Style:=psSolid; 
      MoveTo(xs,ys); 
      LineTo(xt,yt); 
      MoveTo(xs,ys); 
      LineTo(x1,y1); 
     xt:=x1; 
     yt:=y1; 
    end;} 
end; 
procedure TIO.FormMouseDown( X, Y: Integer); 
 var Mini,Maxi,i,j,Temp,Te:integer; 
           b,k:real; 
           Flag:Boolean; 
   function StepRound(Num,Step:integer):integer; 
     begin 
       if (Num mod Step)>(Step/2)then Result:=Num- Num mod Step+Step 
         else Result:=(Num div Step)*Step; 
     end; 
         begin 
         Te:=MyDraw.FindNumberByXY(X,Y); 
         if (Te=-1)and(state<>msMove) then 
           with MyData,MyDraw do begin 
             i:=1; 
             j:=1; 
             Flag:=false; 
             repeat 
               repeat 
                 if (Dimension>0)and(Matrix[i,j]=1) then begin 
                     Mini:=Min(FindByNumber(i).x,FindByNumber(j).x); 
                     Maxi:=Max(FindByNumber(i).x,FindByNumber(j).x); 
                     if Mini<>Maxi then 
                        k:=(FindByNumber(i).y- 
FindByNumber(j).y)/(FindByNumber(i).x-FindByNumber(j).x) 
                        else k:=0; 
                     b:= FindByNumber(i).y- (k*FindByNumber(i).x) ; 
                     if (X>=Mini)and(X=(k*X+b-8) )and ( YDimension); 
               inc(j); 
               i:=1; 
             until(Flag)or(j>Dimension); 
           end 
            else begin 
              if FirstPointActive then begin 
                if State=msMove then  begin 
                  flag:=true; 
                  MyDraw.move(FirstPoint,x,y); 
                  MyDraw.SetUnActive(FirstPoint); 
                  DrawAll; 
                  FirstPointActive:=False; 
                end; 
                 LastPoint:=Te 
              end 
              else begin 
                  FirstPoint:=Te; 
                  FirstPointActive:=True; 
              end; 
              MyDraw.SetActive(Te); 
              if State=msDelete then 
                  RemovePoint(Te); 
              Exit; 
            end; 
             if not flag then begin 
               if FSnapToGrid then 
IONewPoint(StepRound(x,GrigStep),StepRound(y,GrigStep)) 
                 else IONewPoint(x,y);end; 
         end; 
procedure TIO.Select(FirstPoint,LastPoint:integer); 
         var s:string; 
         begin 
           with MyData do  begin 
             DrawPath(FirstPoint,LastPoint,true); 
             S:=InputBox('Ввод','Введите длину ребра ',''); 
             if(s='')or(not(StrToInt(S) in [1..250]))then begin 
              ShowMessage('Некорректно введена длина'); 
              exit; 
             end; 
     {      if Oriented then 
             if Matrix[FirstPoint,LastPoint]<>0 then 
               MatrixLength[FirstPoint,LastPoint]:=StrToInt(S)else 
               MatrixLength[LastPoint,FirstPoint]:=StrToInt(S) 
            else 
            begin } 
           LengthActive:=True; 
           SetRebroLength(FirstPoint,LastPoint,StrToInt(S)); 
         //   end; 
           DrawPath(FirstPoint,LastPoint,false); 
           end; 
         end; 
procedure TIO.DrawPath(First,Last:integer;Light:boolean=false); 
          var s:string; 
          begin 
          with MyDraw,MyCanvas do 
            begin 
 {!!pmMerge}  Pen.Mode:=pmCopy; 
             Pen.Width:=2; 
             brush.Style:=bsClear; 
             Font.Color:=TextColor; 
             PenPos:=FindByNumber(First); 
             if Light then begin 
                Pen.Color:=clYellow; 
                SetActive(First); 
                SetActive(Last); 
                end 
               else        Pen.Color:=RebroColor; 
             LineTo(FindByNumber(Last).x, 
                          FindByNumber(Last).y  ); 
             if (MyData.LengthActive)and 
                (MyData.MatrixLength[First,Last]<>0) then 
              begin 
               s:=IntToStr(MyData.MatrixLength[First,Last]); 
               TextOut((FindByNumber(Last).x+FindByNumber(First).x)div 2, 
                             (FindByNumber(Last).y+FindByNumber(First).y) 
div 2-13,s); 
              end; 
              DrawSelf(First); 
              DrawSelf(Last); 
            end; 
          end; 
procedure TIO.DrawAll; 
var i,j:byte; 
          begin 
            for  i:=1  to MyData.Dimension do 
            for  j:=1  to MyData.Dimension do 
               if MyData.Matrix[i,j]=1 then DrawPath(i,j,false); 
            MyDraw.DrawAll; 
          end; 
procedure TIO.IONewPoint(xPos,yPos:integer); 
          begin 
            MyData.NewPoint; 
            MyDraw.NewPoint(xPos,yPos); 
            MyDraw.DrawAll; 
          end; 
procedure TIO.DrawCoordGrid(x,y,x1,y1:integer); 
var i,j,nx,ny,nx1,ny1:integer; 
begin 
   if FDrawGrid then begin 
     nx:=x div GrigStep; 
     nx1:=x1 div GrigStep; 
     ny:=y div GrigStep; 
     ny1:=y1 div GrigStep; 
     MyCanvas.Brush.Style:=bsClear; 
     MyCanvas.Pen.Color:=GridColor; 
     for  i:=1  to nx1-nx do 
        for  j:=1  to ny1-ny do 
           MyCanvas.Pixels[i*GrigStep,y1-j*GrigStep]:=GridColor; 
     end; 
   if FDrawCoord then 
    with MyCanvas do begin 
     Pen.Width:=1; 
     MoveTo(nx+GrigStep,y-5); 
     LineTo(nx+GrigStep,y1+2); 
     LineTo(x1-4,y1+2); 
                           {horizontal} 
     for  i:=1  to nx1-nx do   begin 
        MoveTo(nx+i*GrigStep,y1-1); 
        LineTo(nx+i*GrigStep,y1+5); 
        TextOut(nx+i*GrigStep-5,y1+8,IntToStr((i-1)*Mashtab)); 
     end;                  {vertical} 
     for  i:=1 to ny1-ny  do begin 
        MoveTo(x+2,y1-GrigStep*i); 
        LineTo(x+7,y1-GrigStep*i); 
        TextOut(x-15,y1-i*GrigStep-GrigStep div 2,IntToStr(i*Mashtab)); 
     end; 
    end; 
end; 
constructor TIO.Create(Canvas:TCanvas); 
begin 
   GrigStep:=20; 
 FSnapToGrid:=true; 
   GridColor:=clBlack; 
   RebroColor:=clMaroon; 
   MovingColor:=clBlue; 
   TextColor:=clBlack; 
     Mashtab:=1; 
    MyCanvas:=Canvas; 
       State:=msNewPoint; 
  FDrawCoord:=false; 
end; 
procedure TIO.RemovePoint(Num: integer); 
var j:integer;N,MPenPos:TPoint; 
begin 
  {with MyCanvas do begin 
      Pen.Width:=2; 
      Pen.Color:=RebroColor; 
      Pen.Mode:=pmXor; 
      Pen.Style:=psSolid; 
      MPenPos:=MyDraw.FindByNumber(Num); 
  for  j:=1  to MyData.Dimension do 
   if MyData.Matrix[Num,j]=1 then begin 
      N:=MyDraw.FindByNumber(j); 
      PolyLine([MPenPos,N]); 
    end;} 
{      Pen.Mode:=pmNot; 
    for  j:=1  to MyData.Dimension do 
   if MyData.Matrix[Num,j]=1 then begin 
      N:=MyDraw.FindByNumber(j); 
      PolyLine([MPenPos,N]); 
    end; 
  end;} 
                  MyData.Remove(Num); 
                  MyDraw.Remove(Num); 
end; 
end. 
Модуль визуального отображения графа в окне программы: 
unit DrawingObject; 
interface 
uses 
  Classes, Windows, Graphics,dialogs,SysUtils; 
type 
    Colors=(Red,RedLight,Blue,Yellow,Green,Purple); 
    Obj=record 
       Place         :TRect; 
       PlaceX,PlaceY :integer; 
       Color         :Colors ; 
    end; 
  TDrawingObject = class(TObject) 
  protected 
    MyCanvas:TCanvas; 
  public 
    Dim:integer; 
    Bitmaps:array[1..6]of TBitmap; 
    Arr:array of Obj; 
    constructor Create(Canvas:TCanvas); 
    procedure Remove(Num:integer); 
    procedure NewPoint(x,y:integer); 
    procedure DrawSelf(Num:integer); 
    procedure DrawSelfXY(X,Y:integer); 
    function HasPoint(Num,X,Y:integer): Boolean; 
    destructor Destroy ; 
    procedure DrawAll; 
    procedure Clear; 
    procedure Save(FileName:string); 
    procedure Load(FileName:string); 
    procedure SetActive(Num:integer); 
    procedure SetUnActive(Num:integer); 
    procedure SetAllUnActive; 
    procedure Move(number,x,y:integer); 
    procedure SetColor(Num:integer;NewColor:byte); 
    function FindByNumber(Num:integer): TPoint; 
    function FindNumberByXY(X,Y:integer):integer ; 
  end; 
var MyDraw:TDrawingObject; 
implementation 
procedure TDrawingObject.Clear; 
begin 
  Dim:=0; 
  Arr:=nil; 
end; 
procedure TDrawingObject.NewPoint(x,y:integer); 
begin 
  inc(Dim); 
  SetLength(Arr,Dim+1); 
  with Arr[Dim] do 
  begin 
  PlaceX:=x; 
  PlaceY:=y; 
  Place.Left:=x-Bitmaps[1].Width div 2; 
  Place.Top:=y-Bitmaps[1].Width div 2; 
  Place.Right:=x+Bitmaps[1].Width div 2; 
  Place.Bottom:=y+Bitmaps[1].Width div 2; 
  Color :=Red; 
  end; 
end; 
constructor TDrawingObject.Create(Canvas:TCanvas); 
var i:byte; 
begin 
  MyCanvas:=Canvas; 
  Dim:=0; 
  for i:=1 to 6 do 
     Bitmaps[i]:=TBitmap.Create; 
  Bitmaps[1].LoadFromResourceName(hInstance,'nBit'); 
  Bitmaps[2].LoadFromResourceName(hInstance,'aBit'); 
  Bitmaps[3].LoadFromResourceName(hInstance,'Blue'); 
  Bitmaps[4].LoadFromResourceName(hInstance,'Yellow'); 
  Bitmaps[5].LoadFromResourceName(hInstance,'Green'); 
  Bitmaps[6].LoadFromResourceName(hInstance,'Purple'); 
  for i:=1 to 6 do 
     Bitmaps[i].Transparent:=True; 
end; 
procedure TDrawingObject.DrawSelfXY(X,Y:integer); 
begin 
  DrawSelf(FindNumberByXY(X,Y)); 
end; 
procedure TDrawingObject.DrawSelf(Num:integer); 
begin 
 with Arr[Num] do 
     case Color of 
        Red:      MyCanvas.Draw(Place.Left,Place.Top,Bitmaps[1]); 
        RedLight: MyCanvas.Draw(Place.Left,Place.Top,Bitmaps[2]); 
        Blue:     MyCanvas.Draw(Place.Left,Place.Top,Bitmaps[3]); 
        Green:    MyCanvas.Draw(Place.Left,Place.Top,Bitmaps[4]); 
        Yellow:   MyCanvas.Draw(Place.Left,Place.Top,Bitmaps[5]); 
        Purple:   MyCanvas.Draw(Place.Left,Place.Top,Bitmaps[6]); 
       else 
       MyCanvas.Draw(Place.Left,Place.Top,Bitmaps[1]); 
     end; 
end; 
function TDrawingObject.HasPoint(Num,X,Y:integer): Boolean; 
begin 
 with Arr[Num] do 
    if(X >= Place.Left) and (X = Place.Top) and (Y  MatrixLength[j,i] ) 
                       then Lymbda[j]:=Lymbda[i] + MatrixLength[j,i]; 
           until Proverka ; 
           Path[1]:= EndPoint ; 
           j:=1; 
           PathPlace:=2; 
           repeat 
             TempPoint:=1; 
             Flag:=False; 
             repeat 
               if ( Matrix[ Path[ PathPlace-1 ],TempPoint] =1  )and ( 
                  Lymbda[ Path[ PathPlace-1] ] = 
                   ( Lymbda[TempPoint] + MatrixLength[ Path[PathPlace-1 ], 
TempPoint] ) ) 
                   then Flag:=True 
                   else Inc( TempPoint ); 
             until Flag; 
             Path[ PathPlace ]:=TempPoint; 
             inc( PathPlace ); 
             MyIO.DrawPath(Path[ PathPlace-2 ],Path[ PathPlace -1],true); 
 //            ShowMessage('f'); 
           until(Path[ PathPlace - 1 ] = StartPoint); 
//           MyIO.DrawPath(Path[ PathPlace-1 ],Path[ PathPlace ],true); 
           end; 
         end; 
function TMinLength.Proverka:Boolean; 
         var i,j:integer; 
             Flag:boolean; 
         begin 
           i:=1; 
           Flag:=False; 
           With MyData do begin 
           repeat 
             j:=1; 
             repeat 
               if Matrix[i,j]=1 then 
               if ( Lymbda[j]-Lymbda[i] )>MatrixLength[j,i]then Flag:=True; 
               inc(j); 
             until(j>Dimension)or(Flag); 
             inc(i); 
           until(i>Dimension)or(Flag); 
           Result:=not Flag; 
           end; 
         end; 
end. 
----------------------- 
[pic] 
[pic] 
[pic] 
[pic] 
Страницы: 1, 2 
	
	
					
							 |