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

Загрузить архив:
Файл: 047-0007.zip (563kb [zip], Скачиваний: 103) скачать

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

                          fori:=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;

                             fori:=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

              elseshowmessage('Недопустимый путь!');

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=falsethen

              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_useldo

     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.