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

  • Просмотров 2386
  • Скачиваний 478
  • Размер файла 576
    Кб

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