unit Unit1; interface uses Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, Dialogs, StdCtrls, Grids, ExtCtrls, ComCtrls, Menus, ExtDlgs; type TForm1 = class(TForm) Image1: TImage; Button3: TButton; StringGrid2: TStringGrid; PageControl1: TPageControl; TabSheet1: TTabSheet; TabSheet2: TTabSheet; Button2: TButton; Button1: TButton; StringGrid1: TStringGrid; Button4: TButton; Button5: TButton; StringGrid3: TStringGrid; Edit1: TEdit; Label1: TLabel; Button6: TButton; Label2: TLabel; Edit2: TEdit; Edit3: TEdit; Label3: TLabel; Button7: TButton; Button9: TButton; Button8: TButton; Button10: TButton; MainMenu1: TMainMenu; N1: TMenuItem; N2: TMenuItem; N3: TMenuItem; N5: TMenuItem; N6: TMenuItem; OpenDialog1: TOpenDialog; SaveDialog1: TSaveDialog; N4: TMenuItem; TrackBar1: TTrackBar; procedure FormCreate(Sender: TObject); procedure Button2Click(Sender: TObject); procedure Image1MouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer); procedure Image1MouseUp(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); procedure redrow; procedure Button1Click(Sender: TObject); procedure Button3Click(Sender: TObject); procedure Button6Click(Sender: TObject); procedure Button7Click(Sender: TObject); procedure Button9Click(Sender: TObject); procedure Button8Click(Sender: TObject); procedure Button5Click(Sender: TObject); procedure Button4Click(Sender: TObject); procedure Button10Click(Sender: TObject); procedure N5Click(Sender: TObject); procedure N2Click(Sender: TObject); procedure N3Click(Sender: TObject); procedure N6Click(Sender: TObject); procedure N4Click(Sender: TObject); procedure TrackBar1Change(Sender: TObject); private { Private declarations } public { Public declarations } end; vv = record x,y:Integer; num:Integer; end; gph= array[1..99,1..99] of byte; var Form1: TForm1; pos,pos2:Integer; xx,yy,xb,yb,ugol:Integer; ver,reb,reb2:Boolean; vers:array[1..100] of vv; implementation uses Math, Unit2; {$R *.dfm} function findver(x,y:integer):Integer; var i:Integer; begin findver:=0; for i:=1 to pos do begin if (x>vers[i].x-10) and (xvers[i].y-10) and (y1 then begin StringGrid3.ColCount:= StringGrid3.ColCount+1; StringGrid3.RowCount:=StringGrid3.ColCount; Edit1.Text := inttostr(pos); end; for i:=1 to strtoint(edit1.text)+1 do begin StringGrid3.Cells[i,0]:= inttostr(i); StringGrid3.Cells[0,i]:= inttostr(i); end; for i:=1 to strtoint(edit1.text) do begin for i2:=1 to strtoint(edit1.text) do begin if StringGrid3.Cells[i2,i]='' then StringGrid3.cells[i2,i]:='0'; end; end; end; if reb2 then begin reb:=false; reb2:=false; xx:=0; yy:=0; //form1.Caption:=inttostr(findver(x,y)); i:=findver(x,y); If i <>0 then begin StringGrid1.Cells[pos2,1]:=inttostr(i); xx:= StrToInt(StringGrid1.Cells[pos2,0]); yy:= StrToInt(StringGrid1.Cells[pos2,1]); StringGrid3.Cells[xx,yy]:='1'; StringGrid3.Cells[yy,xx]:='0'; StringGrid1.ColCount:= StringGrid1.ColCount+1; end; redrow; end; if reb then begin xb:=x; yb:=y; xx:=x; yy:=y; reb2:=True; Image1.Canvas.MoveTo(0,0); Image1.Canvas.LineTo(x,y); i:=findver(x,y); If i <>0 then begin inc(pos2); StringGrid1.Cells[pos2,0]:=inttostr(i); // Form1.Caption:= inttostr(pos2); end; end; end; procedure TForm1.Button1Click(Sender: TObject); begin xx:=0; yy:=0; Image1.Canvas.Pen.Mode := pmNotXor; reb:=true; end; procedure TForm1.Button3Click(Sender: TObject); var v_n,v_t:byte; mass1,mass2:array [1..100,1..2] of byte; stek1,stek2:array [1..100] of byte; num1,num2,i,i2,i_,j,k,m:integer; el:Boolean; begin el:=true; for i:=1 to pos do begin k:=0; for i2:=1 to pos2 do begin if (StringGrid1.Cells[i2,0] = inttostr(i)) or (StringGrid1.Cells[i2,1] = inttostr(i)) then inc(k); end; if (k mod 2 <>0) then el:=false; end; if not el then Application.MessageBox('Данный граф не является Элеровым', '', MB_OK); {---------vvod reber----------} k:=pos2; for i_:=1 to k do begin mass1[i_,1]:=strtoint(StringGrid1.Cells[i_,0]); mass1[i_,2]:=strtoint(StringGrid1.Cells[i_,1]); mass2[i_,1]:=mass1[i_,1]; mass2[i_,2]:=mass1[i_,2]; end; {----------------main-----------------} v_n:=mass1[1,1]; v_t:=mass1[1,2]; stek1[1]:=v_n; stek1[2]:=v_t; num1:=3; num2:=1; mass1[1,1]:=0; mass1[1,2]:=0; repeat m:=0; for i_:=2 to k do begin if mass1[i_,1]=v_t then begin if mass1[i_,2]=v_n then begin stek2[num2]:=v_n; inc(num2); v_n:=v_t; end else begin stek1[num1]:=mass1[i_,2]; inc(num1); v_t:=mass1[i_,2]; end; mass1[i_,1]:=0; mass1[i_,2]:=0; // i_:=k; // break; m:=1; end; if mass1[i_,2]=v_t then begin if mass1[i_,1]=v_n then begin stek2[num2]:=v_n; inc(num2); v_n:=v_t; end else begin stek1[num1]:=mass1[i_,1]; inc(num1); v_t:=mass1[i_,1]; end; mass1[i_,1]:=0; mass1[i_,2]:=0; // i_:=k; // break; m:=1; end; end; if m=0 then begin dec(num1); stek2[num2]:=stek1[num1]; stek1[num1]:=0; v_n:=stek1[num1-1]; v_t:=stek1[num1-1]; inc(num2); end; until num2>k+1; {---------vyvod spiska reber----------} // for i_:=1 to k do write (mass2[i,1],' '); // for i_:=1 to k do write (mass2[i,2],' '); {---------vyvod vershin grafa----------} StringGrid2.ColCount:=k; for i_:=1 to k+1 do StringGrid2.Cells[i_-1,0]:= IntToStr(stek2[i_]); // for i_:=1 to k+1 do write (stek2[i],' '); end; procedure TForm1.Button6Click(Sender: TObject); var i,i2:Integer; begin If (Edit1.Text='') or (Edit1.Text='0') then Edit1.Text:='1'; StringGrid3.ColCount:=strtoint(edit1.text)+1; StringGrid3.rowCount:=strtoint(edit1.text)+1; for i:=1 to strtoint(edit1.text)+1 do begin StringGrid3.Cells[i,0]:= inttostr(i); StringGrid3.Cells[0,i]:= inttostr(i); end; for i:=1 to strtoint(edit1.text)+1 do begin for i2:=1 to strtoint(edit1.text)+1 do begin //StringGrid3.Cells[i,i2]:='0'; end; end; Button9.Click; Button2.Caption:= 'Разместить вершину '+IntToStr(pos+1); end; procedure TForm1.Button7Click(Sender: TObject); begin StringGrid3.Cells[strtoint(Edit3.Text),strtoint(Edit2.Text)]:='1'; edit2.Text:=''; edit3.Text:=''; Edit2.SetFocus; Button9.Click; end; procedure TForm1.Button9Click(Sender: TObject); var i,i2:Integer; step:real; begin pos2:=0; for i:=1 to strtoint(edit1.text) do begin for i2:=1 to strtoint(edit1.text) do begin if StringGrid3.Cells[i2,i]='' then StringGrid3.cells[i2,i]:='0'; if StringGrid3.Cells[i2,i]='1' then begin Inc(pos2); StringGrid1.ColCount:=pos2+1; StringGrid1.Cells[pos2,0]:= inttostr(i); StringGrid1.Cells[pos2,1]:= inttostr(i2); StringGrid3.cells[i,i2]:='0'; end; end; end; step:= 2*3.14/ strtoint(edit1.text); for i:=1 to strtoint(edit1.text) do begin vers[i].x := 300+ trunc(cos(i*step +ugol/100)*100); vers[i].y := 150+ trunc(sin(i*step +ugol/100)*100); pos:=i; end; redrow; end; procedure TForm1.Button8Click(Sender: TObject); begin StringGrid3.Cells[strtoint(Edit3.Text),strtoint(Edit2.Text)]:='0'; Button9.Click; end; procedure TForm1.Button5Click(Sender: TObject); var x,y,pp:Integer; begin pos2:=pos2-1; pp:= pos2+1; x:= StrToInt(StringGrid1.Cells[pp,0]); y:= StrToInt(StringGrid1.Cells[pp,1]); StringGrid3.Cells[y,x]:='0'; StringGrid3.Cells[x,y]:='0'; if StringGrid1.ColCount<>1 then StringGrid1.ColCount:=StringGrid1.ColCount-1; redrow; //Image1.Canvas.Pen.Mode := pmCopy; ver:= false; reb := false; reb2:=false; end; procedure TForm1.Button4Click(Sender: TObject); begin pos:=pos-1; StringGrid3.ColCount:= StringGrid3.ColCount-1; StringGrid3.RowCount:= StringGrid3.ColCount; edit1.Text := IntToStr(pos); Button9.Click; redrow; Image1.Canvas.Pen.Mode := pmCopy; ver:= false; reb := false; reb2:=false; end; procedure TForm1.Button10Click(Sender: TObject); var i,i2:Integer; begin StringGrid1.ColCount:=2; StringGrid1.Cells[1,0]:=''; StringGrid1.Cells[1,1]:=''; for i:=1 to strtoint(edit1.text)+1 do begin for i2:=1 to strtoint(edit1.text)+1 do begin StringGrid3.Cells[i,i2]:='0'; end; end; //Button9.Click; end; procedure TForm1.N5Click(Sender: TObject); begin Halt(0); end; procedure TForm1.N2Click(Sender: TObject); var f:file; pp,x,y:Byte; mas:gph; begin If OpenDialog1.Execute then begin assignFile(f,OpenDialog1.FileName); Reset(f,1); Blockread(f,pp,SIZEOF(byte)); Blockread(f,mas,SIZEOF(gph)); edit1.Text := IntToStr(pp); CloseFile(f); for x:=1 to pp do begin for y:=1 to pp do begin StringGrid3.Cells[x,y]:= inttostr(mas[x,y]); end; end; Button6.Click end; end; procedure TForm1.N3Click(Sender: TObject); var f:file; pp,x,y:Byte; mas:gph; begin pp:=StrToInt(edit1.Text); for x:=1 to pp do begin for y:=1 to pp do begin mas[x,y]:= strtoint(StringGrid3.Cells[x,y]); end; end; If SaveDialog1.Execute then begin assignFile(f,SaveDialog1.FileName); Rewrite(f,1); BlockWrite(f,pp,SIZEOF(byte)); BlockWrite(f,mas,SIZEOF(Gph)); CloseFile(f); end; end; procedure TForm1.N6Click(Sender: TObject); begin form2.show; end; procedure TForm1.N4Click(Sender: TObject); begin edit1.Text:='1'; Button10.click; Button6.Click; Button9.click; end; procedure TForm1.TrackBar1Change(Sender: TObject); begin ugol:= TrackBar1.Position; Button9.Click; end; end.