Реферат: Нахождение кратчайшего пути
Repaint;
end;
end;
procedure TForm1.MyPopupHandler(Sender: TObject);
var s:string;
begin
with Sender as TMenuItem do begin
s:=Caption;
MyData.Load(s);
System.Delete(s,length(s)-4,5);
MyDraw.Load(s+'.pos');
end;
Repaint;
end;
procedure TForm1.ClearButtonClick(Sender: TObject);
begin
MyData.Clear;
MyDraw.Clear;
Repaint;
end;
procedure TForm1.KommiToolButtonClick(Sender: TObject);
begin
If MyData.Dimension<2 then Exit;
MyCommercial:=TCommercial.Create;
MyCommercial.Make;
MyCommercial.Free;
end;
procedure TForm1.EilerButtonClick(Sender: TObject);
begin
If MyData.Dimension<2 then Exit;
EilerC:=TEiler.Create;
EilerC.Make;
EilerC.Free;
MyIO.DrawAll;
RePaint;
end;
procedure TForm1.PaintingToolButtonClick(Sender: TObject);
begin
If MyData.Dimension<2 then Exit;
MyPaint:=TPaintingGraphClass.Create;
MyPaint.Make;
RePaint;
MyPaint.Free;
end;
procedure TForm1.SnapToGridButtonClick(Sender: TObject);
begin
MyIO.FSnapToGrid:=SnapToGridButton.Down;
end;
procedure TForm1.HelpButtonClick(Sender: TObject);
begin
Application.HelpContext(10);
end;
procedure TForm1.AutoLengthButtonClick(Sender: TObject);
begin
MyIo.AutoLength:=AutoLengthButton.Down;
end;
procedure TForm1.SettingButtonClick(Sender: TObject);
begin
SettingForm.Show;
end;
procedure TForm1.NotFarButtonClick(Sender: TObject);
begin
If MyData.Dimension<2 then Exit;
MyNotFar:=TNotFar.Create;
MyNotFar.Make;
MyNotFar.Free;
end;
procedure TForm1.MinLengthButtonClick(Sender: TObject);
begin
If MyData.Dimension<2 then Exit;
MyMinLength:=TMinLength.Create;
MyMinLength.Make;
MyMinLength.Free;
end;
procedure TForm1.MovePointButtonClick(Sender: TObject);
begin
if MovePointButton.Down then MyIO.State:=msMove else
MyIO.State:=msNewPoint;
if MovePointButton.Down=false then
Cursor := crDefault;
end;
procedure TForm1.RemovePointButtonClick(Sender: TObject);
begin
if ReMovePointButton.Down then MyIO.State:=msDelete else
MyIO.State:=msNewPoint;
Repaint;
end;
procedure TForm1.Timer1Timer(Sender: TObject);
begin
Clock.Caption:=TimeToStr(Time);
end;
procedure TForm1.ALoadExecute(Sender: TObject);
var s:string;
begin
if OpenDialog1.Execute then
try
s:=OpenDialog1.Filename;
MyData.Load(s);
Delete(s,length(s)-4,5);
MyDraw.Load(s+'.pos');
finally
end;
Repaint;
end;
procedure TForm1.AShowGrigExecute(Sender: TObject);
begin
MyIO.FDrawGrid:=ShowGridButton.Down ;
Repaint;
end;
procedure TForm1.ASaveExecute(Sender: TObject);
var s:string;
m:TMenuItem;
begin
if SaveDialog1.Execute then
try
s:=SaveDialog1.Filename;
MyData.Save(s);
Delete(s,length(s)-4,5);
MyDraw.Save(s+'.Pos')
finally
end;
m:=TMenuItem.Create(Self);
m.Caption:=SaveDialog1.Filename;
m.OnClick := MyPopUpHandler;
LoadMenu.Items.Add(m);
end;
procedure TForm1.PaintBox1Paint(Sender: TObject);
begin
MyIO.DrawCoordGrid(16,16,ClientWidth-30,ClientHeight-140);
MyIO.DrawAll;
end;
procedure TForm1.UpdateButtonClick(Sender: TObject);
begin
MyDraw.SetAllUnActive;
MyIO.DrawAll;
MyIO.FirstPointActive:=false;
end;
procedure TForm1.ClockClick(Sender: TObject);
begin
Splash.Show;
end;
end.
Модуль управления окном настроек:
unit Setting;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
Buttons, StdCtrls, Spin,IO,MainUnit, ExtCtrls;
type
TSettingForm = class(TForm)
GridGroupBox: TGroupBox;
Label1: TLabel;
Label2: TLabel;
ColorDialog1: TColorDialog;
Label3: TLabel;
OkBitBtn: TBitBtn;
CancelBitBtn: TBitBtn;
ColorButton: TPanel;
Label4: TLabel;
Label5: TLabel;
CoordCheckBox: TCheckBox;
GridCheckBox: TCheckBox;
StepSpinEdit: TSpinEdit;
MashtabSpinEdit: TSpinEdit;
Colors: TGroupBox;
Panel1: TPanel;
Panel2: TPanel;
Panel3: TPanel;
Label6: TLabel;
Label7: TLabel;
Label8: TLabel;
procedure ColorButtonClick(Sender: TObject);
procedure OkBitBtnClick(Sender: TObject);
procedure FormShow(Sender: TObject);
procedure FormClose(Sender: TObject; var Action: TCloseAction);
procedure CoordCheckBoxClick(Sender: TObject);
procedure GridCheckBoxClick(Sender: TObject);
procedure CancelBitBtnClick(Sender: TObject);
procedure Panel2Click(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
var
SettingForm: TSettingForm;
implementation
{$R *.DFM}
procedure TSettingForm.ColorButtonClick(Sender: TObject);
begin
if ColorDialog1.Execute then begin
ColorButton.Color:=ColorDialog1.Color;
MyIO.GridColor:=Color;
Form1.Repaint;
end;
end;
procedure TSettingForm.OkBitBtnClick(Sender: TObject);
begin
MyIO.GridColor:=ColorButton.Color;
MyIO.GrigStep:=StepSpinEdit.Value;
MyIO.Mashtab:=MashtabSpinEdit.Value;
Close;
end;
procedure TSettingForm.FormShow(Sender: TObject);
begin
with MyIO do begin
ColorButton.Color:=MyIO.GridColor;
StepSpinEdit.Value:=MyIO.GrigStep;
MashtabSpinEdit.Value:=MyIO.Mashtab;
CoordCheckBox.Checked:=MyIO.FDrawCoord;
GridCheckBox.Checked:=MyIO.FDrawGrid;
Panel2.Color:=RebroColor ;
Panel3.Color:=TextColor ;
Panel1.Color:=MovingColor ;
end;
end;
procedure TSettingForm.FormClose(Sender: TObject;
var Action: TCloseAction);
begin
with MyIO do begin
GridColor:=ColorButton.Color;
GrigStep:=StepSpinEdit.Value;
Mashtab:=MashtabSpinEdit.Value;
FDrawCoord:=CoordCheckBox.Checked;
FDrawGrid:=GridCheckBox.Checked;
Form1.ShowGridButton.Down:=GridCheckBox.Checked;
RebroColor:=Panel2.Color ;
TextColor:=Panel3.Color ;
MovingColor:=Panel1.Color ;
end;
Form1.Repaint;
end;
procedure TSettingForm.CoordCheckBoxClick(Sender: TObject);
begin
MyIO.FDrawCoord:=CoordCheckBox.Checked;
//Form1.Repaint;
end;
procedure TSettingForm.GridCheckBoxClick(Sender: TObject);
begin
MyIO.FDrawGrid:=GridCheckBox.Checked ;
//Form1.Repaint;
end;
procedure TSettingForm.CancelBitBtnClick(Sender: TObject);
begin
Close;
end;
procedure TSettingForm.Panel2Click(Sender: TObject);
begin
with Sender as TPanel do
if ColorDialog1.Execute then begin
Color:=ColorDialog1.Color;
end;
end;
end.
Вспомогательный модуль потроения графа в окне программы:
unit IO;
interface
uses Data,DrawingObject,Graphics,windows,Math,Controls,Dialogs,SysUtils;
type
MouseState=(msNewPoint,msLining,msMove,msDelete);
TIO=class
private
xt,yt,xs,ys: integer;
// FLining: boolean;
ActivePoint: integer;
MyCanvas: TCanvas;
public
GridColor: TColor;
RebroColor: TColor;
TextColor: TColor;
MovingColor: TColor;
State: MouseState;
FDrawGrid: boolean;
FDrawCoord: boolean;
FSnapToGrid: boolean;
GrigStep: integer;
FirstPoint: integer;
FirstPointActive: boolean;
LastPoint: integer;
AutoLength: boolean;
Mashtab: integer;
procedure MakeLine(X, Y: Integer);
procedure DrawPath(First,Last:integer;Light:boolean=false);
procedure IONewPoint(xPos,yPos:integer);
procedure DrawAll;
procedure FormMouseDown( X, Y: Integer);
procedure Select(FirstPoint,LastPoint:integer);
procedure DrawCoordGrid(x,y,x1,y1:integer);
procedure DrawLine(x1,y1:Integer);
procedure RemovePoint(Num:integer);
constructor Create(Canvas:TCanvas);
end;
var MyIO:TIO;
implementation
procedure TIO.MakeLine(X, Y: Integer);
var i:integer;
V1,V2:TPoint;
begin
i:=MyDraw.FindNumberByXY(X,Y);
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;
