end;
function TDrawingObject.FindNumberByXY(X,Y:integer):integer ;
var
i: Integer;
begin
Result:=-1;
for i :=1 to Dim do
if HasPoint(i,X,Y) then
begin
Result:=i;
Exit;
end;
end;
procedure TDrawingObject.SetUnActive(Num:integer);
begin
Arr[Num].Color:=Red;
DrawSelf(Num);
end;
destructor TDrawingObject.Destroy ;
var i:byte;
begin
for i:=1 to 6 do
Bitmaps[i].Free;
end;
procedure TDrawingObject.Save(FileName:string);
var stream: TWriter;
st:TFileStream;
i:integer;
begin
try
st:=TFileStream.Create(FileName,fmCreate);
stream := TWriter.Create(st,256);
stream.WriteInteger(Dim);
for i:=1 to Dim do
begin
stream.WriteBoolean(true);
stream.WriteInteger(Arr[i].Place.Left);
stream.WriteInteger(Arr[i].Place.Top);
stream.WriteInteger(Arr[i].Place.Right);
stream.WriteInteger(Arr[i].Place.Bottom);
stream.WriteInteger(Arr[i].PlaceX);
stream.WriteInteger(Arr[i].PlaceY);
end;
finally
stream.Free;
st.Free;
end;
end;
procedure TDrawingObject.Load(FileName:string);
var stream: TReader;
i:integer;
st:TFileStream;
s:boolean;
begin
try
st:=TFileStream.Create(FileName,fmOpenRead);
stream := TReader.Create(st,256);
Dim:=stream.ReadInteger;
SetLength(Arr,Dim+1);
for i:=1 to Dim do
begin
Arr[i].Color:=Red;
s:=stream.ReadBoolean;
Arr[i].Place.Left:=stream.ReadInteger;
Arr[i].Place.Top:=stream.ReadInteger;
Arr[i].Place.Right:=stream.ReadInteger;
Arr[i].Place.Bottom:=stream.ReadInteger;
Arr[i].PlaceX:=stream.ReadInteger;
Arr[i].PlaceY:=stream.ReadInteger;
end;
finally
stream.Free;
st.Free;
end;
end;
procedure TDrawingObject.Remove(Num:integer);
var i:integer;
begin
for i:=Num to Dim-1 do
Arr[i]:=Arr[i+1];
Dec(Dim);
SetLength(Arr,Dim+1);
DrawAll;
end;
procedure TDrawingObject.SetActive(Num:integer);
begin
Arr[Num].Color:=RedLight;
DrawSelf(Num);
end;
procedure TDrawingObject.SetAllUnActive;
var i:byte;
begin
for i:=1 to Dim do
Arr[i].Color:=Red;
end;
procedure TDrawingObject.SetColor(Num:integer;NewColor:Byte);
begin
case NewColor of
1: Arr[Num].Color:=Red;
2: Arr[Num].Color:=RedLight;
3: Arr[Num].Color:=Blue;
4: Arr[Num].Color:=Green;
5: Arr[Num].Color:=Yellow;
6: Arr[Num].Color:=Purple;
end;
DrawSelf(Num);
end;
{$R bitmaps\shar.res}
procedure TDrawingObject.Move(number, x, y:integer);
begin
with Arr[number] 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;
DrawSelf(number);
end;
end.
Модуль организации и управления данными о графе в память компьютера:
unit Data;
interface
uses Dialogs,Classes,SysUtils;
type TData=class
public
LengthActive:boolean;
Dimension: integer;
Oriented:boolean;
Matrix: array of array of Integer;
MatrixLength: array of array of Integer;
procedure Clear;
procedure NewPoint;
procedure Rebro(First,Second:integer);
procedure SetRebroLength(First,Second,Length:integer);
procedure Save(FileName:string);
procedure Load(FileName:string);
procedure Remove(Num:integer);
constructor Create;
end;
var MyData:TData;
implementation
constructor TData.Create;
begin Clear;
end;
procedure TData.Clear;
begin Oriented:=false;
LengthActive:=True;
Matrix:=nil;
MatrixLength:=nil;
Dimension:=0;
end;
procedure TData.NewPoint;
begin
inc(Dimension);
SetLength(Matrix,Dimension+1,Dimension+1);
if LengthActive then
SetLength(MatrixLength,Dimension+1,Dimension+1);
end;
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,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.