procedure TData.Rebro(First,Second:integer);

begin

Matrix[First,Second]:=1;

Matrix[Second,First]:=1;

end;

procedure TData.Save(FileName:string);

var stream: TWriter;

st:TFileStream;

i,j:integer;

begin

try

st:=TFileStream.Create(FileName,fmCreate);

stream := TWriter.Create(st,256);

stream.WriteInteger(Dimension);

stream.WriteBoolean(LengthActive);

stream.WriteBoolean(Oriented);

for i:=1 to Dimension do

for j:=1 to Dimension do

stream.WriteInteger(Matrix[i,j]);

for i:=1 to Dimension do

for j:=1 to Dimension do

stream.WriteInteger(MatrixLength[i,j]);

finally

stream.Free;

st.Free;

end;

end;

procedure TData.Load(FileName:string);

var stream: TReader;

i,j:integer;

st:TFileStream;

begin

try

st:=TFileStream.Create(FileName,fmOpenRead);

stream := TReader.Create(st,256);

Dimension:=stream.ReadInteger;

SetLength(Matrix,Dimension+1,Dimension+1);

SetLength(MatrixLength,Dimension+1,Dimension+1);

LengthActive:=stream.ReadBoolean;

Oriented:=stream.ReadBoolean;

for i:=1 to Dimension do

for j:=1 to Dimension do

Matrix[i,j]:=stream.ReadInteger;

for i:=1 to Dimension do

for j:=1 to Dimension do

MatrixLength[i,j]:=stream.ReadInteger;

finally

stream.Free;

st.Free;

end;

end;

procedure TData.Remove(Num:integer);

var i,j:integer;

begin

for i:=Num to Dimension-1 do

for j:=1 to Dimension do

begin

Matrix[j,i]:=Matrix[j,i+1];

MatrixLength[j,i]:=MatrixLength[j,i+1];

end;

for i:=Num to Dimension-1 do

for j:=1 to Dimension-1 do

begin

Matrix[i,j]:=Matrix[i+1,j];

MatrixLength[i,j]:=MatrixLength[i+1,j];

end;

Dec(Dimension);

SetLength(Matrix,Dimension+1,Dimension+1);

SetLength(MatrixLength,Dimension+1,Dimension+1);

end;

procedure TData.SetRebroLength(First,Second,Length:integer);

begin

MatrixLength[First,Second]:=Length ;

MatrixLength[Second,First]:=Length ;

end;

end.

Модуль определения кратчайшего пути в графе:

unit MinLength;

interface

uses

Windows, Messages, SysUtils, Classes, Graphics, Controls, Dialogs,

StdCtrls,IO,Data,AbstractAlgorithUnit;

type

TMinLength = class(TAbstractAlgorith)

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.