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.Right)

and (Y >= Place.Top) and (Y <= Place.Bottom)then

Result := True

else

Result := False;

end;

procedure TDrawingObject.DrawAll;

var

i: Integer;

begin

for i :=1 to Dim do

DrawSelf(i);

end;

function TDrawingObject.FindByNumber(Num:integer): TPoint;

begin

Result.x := Arr[Num].PlaceX;

Result.y := Arr[Num].PlaceY;

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;