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<Maxi) and

( Y>=(k*X+b-8) )and ( Y<=(k*X+b+8))

then begin

Flag:=true;

Select(i,j);

Exit;

end;

end;

inc(i);

until(Flag)or(i>Dimension);

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);