Работа с графами
unit UMain;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
Menus, ExtCtrls, StdCtrls, Buttons;
type
TFormMain = class(TForm)
Pole: TPanel;
MainMenu1: TMainMenu;
MenuFirst: TMenuItem;
N1: TMenuItem;
MenuSecond: TMenuItem;
MenuThree: TMenuItem;
N3: TMenuItem;
N4: TMenuItem;
edLine: TEdit;
btStart: TButton;
lbAnswer2: TLabel;
N7: TMenuItem;
N8: TMenuItem;
N9: TMenuItem;
OpenDialog: TOpenDialog;
SaveDialog: TSaveDialog;
N13: TMenuItem;
N12: TMenuItem;
N11: TMenuItem;
pnGraf: TPanel;
lbNd: TLabel;
lbKd: TLabel;
lbCaption: TLabel;
edNd: TEdit;
edKd: TEdit;
btOk: TButton;
btExit: TButton;
mmGraf: TMemo;
lbFirst: TLabel;
Button1: TButton;
lbAnswer: TLabel;
procedure N3Click(Sender: TObject);
procedure N1Click(Sender: TObject);
procedure FormActivate(Sender: TObject);
procedure N4Click(Sender: TObject);
procedure btStartClick(Sender: TObject);
procedure N12Click(Sender: TObject);
procedure N9Click(Sender: TObject);
procedure btExitClick(Sender: TObject);
procedure N11Click(Sender: TObject);
procedure N7Click(Sender: TObject);
procedure N8Click(Sender: TObject);
procedure N10Click(Sender: TObject);
procedure btOkClick(Sender: TObject);
procedure N13Click(Sender: TObject);
procedure rename1Click(Sender: TObject);
procedure Button1Click(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
TypeVector =array[1..20] of integer;
TypeParametr =array[1..20] of string[10];
TTabl =array[1..20,1..5] of integer;
TUsel=Record
Num:integer;
Ts:string[5];
Nts:string[6];
days:integer;
Graf_Num:integer;
end;
TDuga=Record
ND:integer;
KD:integer;
end;
TFileUsel=file of TUsel;
TFileDuga=file of TDuga;
var
OpenFile,FromAdd,FromDel,OpenLibUsel,Pusto :Boolean;
FormMain :TFormMain;
stroka,sezon :string;
long_stroka,ksl,kvozv,kts,KolD :integer;
UV :TypeVector;
Tabl :TTabl;
price1,Q :integer;
FileUsel: TFileUsel;
Usel:TUsel;
Duga:Tduga;
FileDuga:TfileDuga;
D:array[1..30] of TDuga;
Us:array[1..30] of integer;
LibUs:array[1..30] of TUsel;
Kol_duga,Kol_usel,Kol_lib_usel:integer;
Umol:array[1..5] of integer;
UmolGraf:array[1..5] of integer;
implementation
uses UHelp, USprav, Uaddus;
{$R *.DFM}
Procedure LAN; {Лексический разбор}
var
slov :array[1..30] of string;
usel: tusel;
sost,i,j,l,nom,ls,ln,k :integer;
Ts,par,st :string;
stroka1 :string[13];
MakeZona,isyet:boolean;
begin
AssignFile(fileusel,'usel.dat');
Reset(fileusel);
kvozv:=0;
ksl:=0;
kts:=1;
sost:=0;
i:=1;
st:=' ';
While not eof(fileusel) do
begin
read(fileusel,usel);
isyet:=false;
for j:=1 to i-1 do
if usel.Ts=slov[j] then
isyet:=true;
if Not(isyet) then
begin
slov[i]:=usel.Ts;
i:=i+1;
end;
end;
kts:=i-1;
j:=1;
i:=1;
MakeZona:=false;
While (j<=long_stroka)and(kvozv=0) do
begin
stroka1:=copy(stroka,j,11);
if copy(stroka1,1,1)=' ' then j:=j+1
else
begin
case sost of
0: begin
ls:=0;
for l:=1 to kts do
begin
nom:=Pos(slov[l],stroka1);
st:=st+' '+slov[l];
if nom=1 then
begin
Ts:=Slov[l];
if l=1 then MakeZona:=false else MakeZona:=false;
ls:=length(slov[l]);
j:=j+ls;
sost:=1;
end;
end;
if ls=0 then
begin
j:=j+1;
kvozv:=4;
end;
end;
1: begin
nom:=pos('=',stroka1);
if nom=1 then sost:=2;
if nom<>1 then kvozv:=5;
j:=j+1;
end;
2: begin
nom:=pos(';',stroka1);
if nom=1 then
begin
kvozv:=6;
j:=j+1;
end;
if (nom<>1) and (nom<>0) then
begin
par:=copy(stroka1,1,nom-1);
kvozv:=7;
if MakeZona=false then
begin
for i:=1 to Kol_lib_Usel do
begin
if (LibUs[i].Ts=Ts) and (libUs[i].Nts=par) then
begin
kvozv:=0;
ksl:=ksl+1;
Uv[ksl]:=LibUs[i].Num;
end;
end;
end
else
begin
if kvozv=0 then
begin
kvozv:=7;
for i:=1 to Kol_lib_Usel do
begin
if (LibUs[i].Ts=Ts) then
begin
kvozv:=0;
ksl:=ksl+1;
Uv[ksl]:=LibUs[i].Num;
end;
end;
end;
end;
sost:=0;
j:=j+nom;
end;
if nom=0 then
begin
j:=j+11; kvozv:=6;
end;
end;
end;
end;
end;
if (sost<>0) and(kvozv=0) then kvozv:=8;
closefile(fileusel);
end;
Procedure SAN; {Синтаксический разбор}
var
way_OK,Find :boolean;
i,j,par,level,k, PlaceDel :integer;
begin
assignfile(fileusel,'usel.dat');
Reset(fileusel);
kvozv:=0;
{ksl:=ksl+1;
uv[ksl]:=filesize(fileusel);
ksl:=ksl+1;
uv[ksl]:=1;}
for j:=1 to ksl do
for i:=1 to ksl-1 do
if uv[i]>uv[i+1] then
begin
par:=Uv[i];
Uv[i]:=uv[i+1];
uv[i+1]:=par;
end;
for i:=1 to ksl do {Проверка на совпадение}
begin {вершин в управляющем векторе}
Find:=false;
for j:=1 to ksl do
if (j<>i) and (Uv[i]=Uv[j]) then
begin
PlaceDel:=j;
Find:=true;
end;
if Find then
begin
for j:=PlaceDel to ksl-1 do
Uv[j]:=Uv[j+1];
ksl:=ksl-1;
end;
end;
j:=1;
While (j<=ksl-1) and (Kvozv=0) do {проверка на существование пути}
begin
way_OK:=false;
for i:=1 to Kol_duga do
if (D[i].Nd=uv[j]) and (D[i].Kd=uv[j+1]) then
way_Ok:=true;
if way_OK=false then Kvozv:=8;
j:=j+1;
end;
{ if way_Ok=false then
begin
for i:=1 to Q do
begin
level:=UmolGraf[i] div 10;
Find:=false;
for j:=1 to ksl do
if (level=(uv[j]div 10)) then Find:=true;
if Find=false then
begin
ksl:=ksl+1;
uv[ksl]:=UmolGraf[i];
end;
end;
for j:=1 to ksl do
for i:=1 to ksl-1 do
if uv[i]>uv[i+1] then
begin
par:=Uv[i];
Uv[i]:=uv[i+1];
uv[i+1]:=par;
end;
j:=1;
Kvozv:=0;
While (j<=ksl-1) and (Kvozv=0) do {проверка на существование пути}
{ begin
way_OK:=false;
for i:=1 to Kol_duga do
if (D[i].Nd=uv[j]) and (D[i].Kd=uv[j+1]) then
way_Ok:=true;
if way_OK=false then Kvozv:=8;
j:=j+1;
end;
if way_ok=false then
kvozv:=8;
end;}
close(fileusel);
end;
Procedure Uprava;
var
i:integer;
usel1: tusel;
begin
price1:=0;
assignfile(fileusel,'usel.dat');
reset(fileusel);
while not(eof(fileusel)) do
begin
read(fileusel,usel1);
for i:=1 to ksl do
if uv[i]=usel1.num then
price1:=price1+usel1.days;
end;
closefile(fileusel);
end;
procedure TFormMain.N3Click(Sender: TObject);
begin
FormProgram.ShowModal;{О программе}
end;
procedure TFormMain.N1Click(Sender: TObject);
begin
if OpenFile then CloseFile(FileDuga); {Выход}
FormMain.Close;
end;
function isversh(nom:integer):boolean;
var i: integer;
begin
isversh:= false;
for i:=1 to Kol_lib_usel do
if LibUs[i].num=nom then
begin
isversh:= true;
exit;
end;
end;
procedure TFormMain.FormActivate(Sender: TObject);
begin
edLine.Setfocus;
btStart.Enabled:=false;
mmGraf.Visible:=false;
OpenFile:=false;
edNd.Visible:=false;
edKd.Visible:=false;
lbNd.Visible:=false;
lbKd.Visible:=false;
lbCaption.Visible:=false;
btOk.Visible:=false;
btExit.Visible:=false;
pnGraf.Visible:=false;
N7.Enabled:=true;
N8.Enabled:=true;
N9.Enabled:=true;
N11.Enabled:=true; {Загрузка файла usel.dat}
OpenLibUsel:=true;
AssignFile(FileUsel,'usel.dat');
Try
Reset(FileUsel);
except
OpenLibUsel:=false;
ShowMessage('Не найден файл usel.dat!');
close;
end;
if OpenLibUsel=true then
begin
Kol_lib_Usel:=0;
While not eof(FileUsel) do
begin
Read(FileUsel,Usel);
Kol_lib_Usel:=Kol_lib_Usel+1;
LibUs[Kol_lib_Usel].num:=Usel.num;
LibUs[Kol_lib_Usel].Ts:=Usel.Ts;
LibUs[Kol_lib_Usel].Nts:=Usel.Nts;
LibUs[Kol_lib_Usel].days:=Usel.days;
end;
CloseFile(FileUsel);
end;
AssignFile(FileDuga,'default.dat');
Reset(FileDuga);
btStart.Enabled:=true;
Kol_duga:=0;
While not eof(FileDuga) do
begin
Read(FileDuga,Duga);
If (isversh(Duga.Nd))And(isversh(Duga.Kd)) then
begin
Kol_duga:=Kol_duga+1;
D[Kol_duga].Nd:=Duga.Nd;
D[Kol_duga].Kd:=Duga.Kd;
end;
end;
formmain.edLine.Text:='тара=короб;склад=холод;товар=скороп;транс=фура;';
showmessage('Восстановлен граф по умолчанию');
Umol[1]:=1;
Umol[2]:=2;
Umol[3]:=3;
Umol[4]:=4;
Umol[5]:=5;
end;
procedure TFormMain.N4Click(Sender: TObject);
begin
fmHelp.ShowModal; {Справка}
end;
Procedure MakeGraf;
var
i,k,j,PlaceDel,par:integer;
Already,FindDuga:boolean;
Duga_Um:TDuga;
begin
assign(fileusel,'usel.dat');
reset(fileusel);
Q:=1;
UmolGraf[Q]:=1;
Q:=Q+1;
UmolGraf[Q]:=filesize(fileusel);
closefile(fileusel);
for i:=1 to 5 do {Определение вершин, которые}
begin {нужно добавить по умолчанию}
for j:=1 to Kol_duga do
begin
if Umol[i]=D[j].Nd then
begin
Already:=false;
for k:=1 to Q do
if UmolGraf[k]=D[j].Nd then
Already:=true;
if Already=false then
begin
Q:=Q+1;
UmolGraf[Q]:=D[j].Nd;
end;
end;
if Umol[i]=D[j].Kd then
begin
Already:=false;
for k:=1 to Q do
if UmolGraf[k]=D[j].Kd then
Already:=true;
if Already=false then
begin
Q:=Q+1;
UmolGraf[Q]:=D[j].Kd;
end;
end;
end;
end;
for i:=1 to Q do
for j:=1 to Q-1 do
if UmolGraf[j]>UmolGraf[j+1] then
begin
par:=UmolGraf[j];
UmolGraf[j]:=UmolGraf[j+1];
UmolGraf[j+1]:=par;
end;
For i:=1 to Q-1 do
begin {Добавление дуг по умолчанию}
Duga_Um.Nd:=UmolGraf[i];
Duga_Um.Kd:=UmolGraf[i+1];
FindDuga:=false;
for j:=1 to Kol_duga do
if (D[j].Nd=Duga_Um.Nd) and (D[j].Kd=Duga_Um.Kd) then
FindDuga:=true;
if FindDuga=false then
begin
Kol_duga:=Kol_duga+1;
D[Kol_duga]:=Duga_Um;
end;
end;
for k:=1 to 2 do {ПРоверка на повторяющиеся дуги и их удаление}
for i:=1 to Kol_duga do
begin
FindDuga:=false;
for j:=1 to Kol_duga do
if (D[i].Nd=D[j].Nd)and (D[i].Kd=D[j].Kd)and (i<>j) then
begin
FindDuga:= true;
PlaceDel:=j;
end;
if FindDuga then
begin
for j:=PlaceDel to Kol_duga-1 do
begin
D[j].Nd:=D[j+1].Nd;
D[j].Kd:=D[j+1].Kd;
end;
Kol_duga:=Kol_duga-1;
end;
end;
end;
procedure TFormMain.btStartClick(Sender: TObject);
var {Главный модуль}
j,i :integer;
str_price :string;
begin
{ MakeGraf;}
j:=0; Pusto:=false;
if edLine.Text='' then edLine.Text:='тара=короб;склад=холод;товар=скороп;транс=фура;';
stroka:=edLine.Text;
long_stroka:=Length(stroka);
begin
LAN;
if kvozv=0 then
begin
San;
if kvozv=0 then
begin
Uprava;
Str_price:=FloatToStrF(price1,ffGeneral,5,2);
lbAnswer.Caption:='Количество дней хранения: '+ str_price;
end
else showmessage('Недопустимый путь!');
end
else
showmessage('Недопустимый запрос!');
end;
end;
procedure TFormMain.N12Click(Sender: TObject);
var {Восстановить граф из файла}
SovpalN,SovpalK:boolean;
i,j:integer;
begin
if OpenFile=false then
begin
if OpenDialog.Execute and FileExists(OpenDialog.FileName) then
begin
AssignFile(FileDuga,OpenDialog.FileName);
Reset(FileDuga);
btStart.Enabled:=true;
OpenFile:=true;
end;
end
else
begin
OpenFile:=false;
if OpenDialog.Execute and FileExists(OpenDialog.FileName) then
begin
closeFile(FileDuga);
AssignFile(FileDuga,OpenDialog.FileName);
Reset(FileDuga);
OpenFile:=true;
btStart.Enabled:=true;
end;
end;
if OpenFile then
begin
Kol_duga:=0;
While not eof(FileDuga) do
begin
Read(FileDuga,Duga);
If (isversh(Duga.Nd))And(isversh(Duga.Kd)) then
begin
Kol_duga:=Kol_duga+1;
D[Kol_duga].Nd:=Duga.Nd;
D[Kol_duga].Kd:=Duga.Kd;
end;
end;
if Kol_duga<>0 then
begin
Kol_usel:=1;
Us[1]:=D[1].Nd;
for i:=1 to Kol_duga do
begin
SovpalN:=false;
SovpalK:=false;
for j:=1 to Kol_usel do
if (Us[j]=D[i].Nd) then SovpalN:=true;
if SovpalN=false then
begin
Kol_usel:=Kol_Usel+1;
Us[Kol_usel]:=D[i].Nd;
end;
for j:=1 to Kol_Usel do
if (Us[j]=D[i].Kd) then SovpalK:=true;
if SovpalK=false then
begin
Kol_usel:=Kol_Usel+1;
Us[Kol_usel]:=D[i].Kd;
end;
end;
end;
N7.Enabled:=true;
N8.Enabled:=true;
N9.Enabled:=true;
N11.Enabled:=true;
end;
end;
procedure TFormMain.N9Click(Sender: TObject);
var i:integer; {Просмотр графа}
stroka:string;
begin
button1.visible:=false;
pnGraf.Visible:=true;
btExit.Visible:=true;
mmGraf.Visible:=true;
mmGraf.Lines.Clear;
mmGraf.Lines.Add('Просмотр графа');
for i:=1 to Kol_duga do
begin
Stroka:='Из вершины № '+IntToStr(D[i].Nd)+' В вершину № '+ IntToStr(D[i].Kd);
mmGraf.Lines.Add(Stroka);
end;
end;
procedure TFormMain.btExitClick(Sender: TObject);
begin {Нажатие на кнопку Выход}
if mmGraf.Visible=true then
begin
mmGraf.Visible:=false;
btExit.Visible:=false;
pnGraf.Visible:=false;
end;
end;
procedure TFormMain.N11Click(Sender: TObject);
var
i:integer; {Сохранить граф в файле}
Name:string;
begin
if SaveDialog.Execute then
begin
closeFile(FileDuga);
Name:=SaveDialog.FileName+'.dat';
AssignFile(FileDuga,Name);
Rewrite(FileDuga);
for i:=1 to Kol_duga do
begin
Duga.Nd:=D[i].Nd;
Duga.Kd:=D[i].Kd;
Write(FileDuga,Duga);
end;
end;
end;
procedure TFormMain.N7Click(Sender: TObject);
begin {Добавить дугу}
pnGraf.Visible:=true;
edNd.Visible:=true;
edNd.Clear;
edNd.SetFocus;
edKd.Visible:=true;
edKd.Clear;
lbNd.Visible:=true;
lbKd.Visible:=true;
lbCaption.Visible:=true;
lbCaption.Caption:='Провести дугу';
btOk.Visible:=true;
FromAdd:=true;
end;
procedure TFormMain.N8Click(Sender: TObject);
begin {Удалить дугу}
FromDel:=true;
pnGraf.Visible:=true;
edNd.Visible:=true;
edNd.Clear;
edNd.Setfocus;
edKd.Visible:=true;
edKd.Clear;
lbNd.Visible:=true;
lbKd.Visible:=true;
lbCaption.Visible:=true;
lbCaption.Caption:='Удалить дугу';
btOk.Visible:=true;
end;
procedure TFormMain.N10Click(Sender: TObject);
var
i:integer;
stroka:string;
begin
MenuSecond.Enabled:=false; {ПРосмотр библиотеки вершин}
pnGraf.Visible:=true;
btExit.Visible:=true;
mmGraf.Visible:=true;
mmGraf.Lines.Clear;
mmGraf.Lines.Add(' Условный Значение');
mmGraf.Lines.Add(' номер вершины ');
mmGraf.Lines.Add(' вершины ');
for i:=1 to Kol_lib_usel do
begin
stroka:=' '+IntToStr(LibUs[i].Num)+' '+LibUs[i].Nts;
mmGraf.Lines.Add(stroka);
end;
end;
procedure TFormMain.btOkClick(Sender: TObject);
var {Нажатие на кнопку ОК}
Nd,Kd,i,PlaceDel:integer;
NoInt,SovpalK,SovpalN:boolean;
begin
if FromAdd=true then
begin
FromAdd:=false;
NoInt:=false;
Try
Nd:=StrToInt(edNd.Text);
Except
NoInt:=true;
end;
Try
Kd:=StrToInt(edKd.Text);
Except
NoInt:=true;
end;
If NoInt=true then
Showmessage('Недопустимый номер вершины!')
else
begin
SovpalK:=false;
SovpalN:=false;
for i:=1 to Kol_lib_usel do
begin
if LibUs[i].Num=Kd then SovpalK:=true;
if LibUs[i].Num=Nd then SovpalN:=true;
end;
if (SovpalK=false) or (SovpalN=false) or ((Kd<=Nd)) then
Showmessage('Неправильно задана дуга!')
else
begin
Kol_duga:=Kol_duga+1;
D[Kol_duga].Nd:=Nd;
D[Kol_duga].Kd:=Kd;
end;
end;
end;
if FromDel=true then
begin
FromDel:=false;
NoInt:=false;
Try
Nd:=StrToInt(edNd.Text);
Except
NoInt:=true;
end;
Try
Kd:=StrToInt(edKd.Text);
Except
NoInt:=true;
end;
If NoInt=true then
Showmessage('Недопустимый номер вершины!')
else
begin
SovpalN:=false;
for i:=1 to Kol_duga do
if (D[i].Nd=Nd)and (D[i].Kd=Kd) then
begin
PlaceDel:=i;
SovpalN:=true;
end;
if SovpalN=false then
Showmessage('Недопустимая дуга!')
else
begin
for i:=PlaceDel to Kol_duga-1 do
begin
D[i].Nd:=D[i+1].Nd;
D[i].Kd:=D[i+1].Kd;
end;
Kol_duga:=Kol_duga-1;
end;
end;
end;
edNd.Visible:=false;
edKd.Visible:=false;
lbNd.Visible:=false;
lbKd.Visible:=false;
lbCaption.Visible:=false;
btOk.Visible:=false;
pnGraf.Visible:=false;
end;
procedure TFormMain.N13Click(Sender: TObject);
begin
fmAddus.show;
end;
procedure TFormMain.rename1Click(Sender: TObject);
var usel,us : tusel;
usf: tfileusel;
usels: integer;
begin
AssignFile(FileUsel,'usel.dat');
reset(FileUsel);
AssignFile(Usf,'Usel.dat');
rewrite(Usf);
usels:=0;
While not eof(FileUsel) do
begin
Read(FileUsel,Usel);
Usels:=Usels+1;
us.num:=Usels;
us.Ts:=Usel.Ts;
us.Nts:=Usel.Nts;
us.graf_num:=Usel.graf_num;
us.days:=Usel.days;
write(usf,us);
end;
CloseFile(FileUsel);
CloseFile(Usf);
end;
procedure TFormMain.Button1Click(Sender: TObject);
begin
pnGraf.Visible:=false;
pole.Visible:=true;
edline.SetFocus;
end;
end.