Скачайте в формате документа WORD

Работ с графами

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;

ar

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; {Лексический разбор}

ar

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; {Синтаксический разбор}

ar

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;

ar

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;

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

ar

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

ar {Главный модуль}

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

ar {Восстановить граф из файла}

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

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

ar

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

ar

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

ar {Нажатие на кнопку ОК}

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

ar 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.