Ðåôåðàò: Íàõîæäåíèå êðàò÷àéøåãî ïóòè
if i<>-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<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
Ñòðàíèöû: 1, 2, 3, 4, 5, 6, 7, 8, 9, 10
