Приложение А: листинг программы

unit Unit1;

interface

uses

Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,

Dialogs, Buttons, Grids, StdCtrls, ExtCtrls, ComCtrls, XPMan, Menus;

type

TForm1 = class(TForm)

sg: TStringGrid;

SpeedButton3: TSpeedButton;

sr: TStringGrid;

SpeedButton4: TSpeedButton;

SpeedButton5: TSpeedButton;

Edit1: TEdit;

Label1: TLabel;

SpeedButton7: TSpeedButton;

Image1: TImage;

Image2: TImage;

Label2: TLabel;

Label3: TLabel;

Timer1: TTimer;

SpeedButton8: TSpeedButton;

CheckBox1: TCheckBox;

Bevel1: TBevel;

Bevel2: TBevel;

Bevel3: TBevel;

Bevel4: TBevel;

Bevel5: TBevel;

Bevel6: TBevel;

Bevel7: TBevel;

Bevel8: TBevel;

Bevel9: TBevel;

Bevel10: TBevel;

BitBtn1: TBitBtn;

BitBtn2: TBitBtn;

Vremya: TTimer;

XPManifest1: TXPManifest;

Label4: TLabel;

BitBtn3: TBitBtn;

BitBtn4: TBitBtn;

Label5: TLabel;

Label6: TLabel;

procedure FormCreate(Sender: TObject);

procedure SpeedButton3Click(Sender: TObject);

procedure SpeedButton4Click(Sender: TObject);

procedure SpeedButton5Click(Sender: TObject);

procedure SpeedButton7Click(Sender: TObject);

procedure Image2DblClick(Sender: TObject);

procedure SpeedButton8Click(Sender: TObject);

procedure Image1MouseDown(Sender: TObject; Button: TMouseButton;

Shift: TShiftState; X, Y: Integer);

procedure Image2Click(Sender: TObject);

procedure BitBtn1Click(Sender: TObject);

procedure BitBtn2Click(Sender: TObject);

procedure VremyaTimer(Sender: TObject);

procedure FormShow(Sender: TObject);

procedure BitBtn4Click(Sender: TObject);

procedure sgClick(Sender: TObject);

procedure srClick(Sender: TObject);

private

{ Private declarations }

 public

{ Public declarations }

end;

var

Form1: TForm1;

f:file of integer;

idown,n,wrt,i,j:integer;

a,ar:array[1..10,1..10] of integer; 

m:array[1..10] of integer;

vx:array[1..10] of integer;

vy:array[1..10] of integer;

implementation

uses Unit2;

{$R *.dfm}

procedure TForm1.FormCreate(Sender: TObject);

var

t,i:integer;

begin

n:=8; {изначально число вершин=8}

SpeedButton3.Enabled:=True;

idown:=1;

speedbutton7.click;                

image1.Canvas.brush.color:= clwhite;

image1.Canvas.pen.Color:=clwhite;   

image2.Canvas.brush.color:= clwhite;

image2.Canvas.pen.Color:=clwhite;   

image1.Canvas.Rectangle(0,0,image1.Width,image1.Height);

image2.Canvas.Rectangle(0,0,image1.Width,image1.Height);

for i:=1 to sr.ColCount do

for j:=1 to sr.Rowcount do begin     

sr.Cells[i,j]:='';

end;                             

for i:=1 to sg.ColCount do

for j:=1 to sg.Rowcount do begin

sg.Cells[i,j]:='';

edit1.Text:= inttostr(t);

for t:=1 to n do begin

sg.Cells[t,t]:='-';

sr.Cells[t,t]:='-';

end; end;

edit1.Text:= inttostr(n);

end;

procedure TForm1.SpeedButton3Click(Sender: TObject);

var

o,min,imin,jmin:integer;

begin

SpeedButton3.Enabled:=false;

assignfile(f,extractfilepath(application.ExeName)+'\in.krs');

rewrite(f);

for i:= 1 to n do             

for j:= 1 to n do

begin

if sg.cells[i,j]='-' then

wrt:=999

else

wrt:=strtoint(sg.cells[i,j]);

write(f,wrt);

end;

closefile(f);

assignfile(f,extractfilepath(application.exename)+'\in.krs');

reset(f);

for i:= 1 to n do

for j:= 1 to n do

begin

read(f,wrt);           

if wrt=999 then

sg.cells[i,j]:='-'

else

sg.cells[i,j]:= inttostr(wrt);

a[i,j]:=wrt;

end;

closefile(f);

for i:=1 to n do

m[i]:=0;            

m[1]:=1;            

repeat

o:=0;                       

min:=100; imin:=1; jmin:=1;

for i:= 1 to n do

if m[i]=1 then

for j:= 1 to n do

if (a[i,j]<>0) and (a[i,j]<900) and (m[j]<>1) then

begin

if a[i,j]<min then   

             begin

min:= a[i,j];

imin:=i;

jmin:=j;            

o:=1;

end; end;

if o=1 then        

begin

ar[imin,jmin]:=min;

ar[jmin,imin]:=min;

m[jmin]:=1;        

end;

until o=0;                 

speedbutton4.Click;        

end;

procedure TForm1.SpeedButton4Click(Sender: TObject);

begin

for i:= 1 to n do

for j:= 1 to n do

begin

if ar[i,j]=0 then   

sr.cells[i,j]:='-'            

else

sr.cells[i,j]:=inttostr(ar[i,j]);

end;

end;

procedure TForm1.SpeedButton5Click(Sender: TObject);

var

i,x,y:integer;

begin

idown:=1;

form1.canvas.Refresh;                        

if checkbox1.Checked then speedbutton8.Click;

image1.Canvas.brush.color:= clwhite;         

image1.Canvas.pen.Color:=clwhite;            

image2.Canvas.brush.color:= clwhite;         

image2.Canvas.pen.Color:=clwhite;            

image1.Canvas.Rectangle(0,0,image1.Width,image1.Height);

image2.Canvas.Rectangle(0,0,image1.Width,image1.Height);

with image1.Canvas do

begin

brush.color:= cllime;      

pen.Color:=clblue;         

font.Name:='Courier';    

font.Size:=8;                   

for i:= 1 to n do

for j:=1 to n do

if (a[i,j]<>0) and (a[i,j]<900) then

begin

pen.Width:=1;              

moveto(vx[i]+7,vy[i]+7);   

lineto(vx[j]+7,vy[j]+7);   

brush.color:= clwhite;     

textout(round((vx[i]+vx[j]+4)/2),round((vy[i]+vy[j]+1)/2),inttostr(a[i,j]));

end;

brush.color:= cllime;                   

for i:= 1 to n do

begin

font.Size:=1;                           

rectangle(vx[i],vy[i],vx[i]+15,vy[i]+15);

textout(vx[i]+4,vy[i]+1,inttostr(i));    

end;

end;

with image2.Canvas do

begin

brush.color:= clLime; 

pen.Color:=clblue;       

font.Name:='Courier'; 

font.Size:=8;               

for i:= 1 to n do

for j:=1 to n do

if (ar[i,j]<>0) and (ar[i,j]<900) then

begin

pen.Width:=1;             

moveto(vx[i]+7,vy[i]+7);

lineto(vx[j]+7,vy[j]+7);

brush.color:= clwhite; 

textout(round((vx[i]+vx[j]+4)/2),round((vy[i]+vy[j]+1)/2),inttostr(ar[i,j]));

end;                                                                      

brush.color:= cllime; 

for i:= 1 to n do

begin

font.Size:=1;                          

rectangle(vx[i],vy[i],vx[i]+15,vy[i]+15);

textout(vx[i]+4,vy[i]+1,inttostr(i));   

end; end; end;

procedure TForm1.SpeedButton7Click(Sender: TObject);

var

i:integer;

begin

for i:= 1 to n do

begin

sg.ColCount:=n+1; 

sg.Rowcount:=n+1; 

sr.ColCount:=n+1; 

sr.Rowcount:=n+1; 

sg.Cells[0,i]:=inttostr(i);

sr.Cells[0,i]:=inttostr(i);

sg.Cells[i,0]:=inttostr(i);

sr.Cells[i,0]:=inttostr(i); end;

for i:= 1 to n do

for j:= 1 to n do

begin          

ar[i,j]:=0;           

end;

end;

procedure TForm1.Image2DblClick(Sender: TObject);

begin

timer1.Enabled:=true;      

end;

procedure TForm1.SpeedButton8Click(Sender: TObject);

begin

for i:= 1 to n do

begin

vx[i]:=random(470);   

vy[i]:=random(230);      

end; end;

procedure TForm1.Image1MouseDown(Sender: TObject; Button: TMouseBut­ton; Shift: TShiftState; X, Y: Integer);

begin

vx[idown]:=x;

vy[idown]:=y;

idown:=idown+1;

image1.Canvas.brush.color:= cllime;        

image1.Canvas.pen.Color:=clblue;           

image1.Canvas.Rectangle(x-1,y-1,x+1,y+1);  

end;

procedure TForm1.Image2Click(Sender: TObject);

begin

image1.Canvas.brush.color:= clwhite;   

image1.Canvas.pen.Color:=clwhite;      

image2.Canvas.brush.color:= clwhite;   

image2.Canvas.pen.Color:=clwhite;      

image1.Canvas.Rectangle(0,0,image1.Width,image1.Height);

image2.Canvas.Rectangle(0,0,image1.Width,image1.Height); timer1.Enabled:=false; 

end;

procedure TForm1.BitBtn1Click(Sender: TObject);

begin

n:= strtoint(edit1.text);

speedbutton7.Click;      

end;                                

procedure TForm1.BitBtn2Click(Sender: TObject);

var i:integer;

begin

if MessageDlg('Завершить работу',mtConfirmation,[mbyes,mbno],0) = mrYes then begin

AlphaBlend:=true;

i:=255;           

while i>0 do begin

AlphaBlendValue:=i;

Application.ProcessMessages;

dec(i,1);                        

end;close;end;end;

procedure TForm1.FormShow(Sender: TObject);

begin

Edit1.SetFocus; 

end;

procedure TForm1.BitBtn4Click(Sender: TObject);

begin

form2.show;

end;

procedure TForm1.sgClick(Sender: TObject);

var i,j:integer;

begin

for i:= 1 to n do

for j:= 1 to n do 

begin

sg.Cells[i,j]:=sg.Cells[j,i];

end;

end;

procedure TForm1.srClick(Sender: TObject);

var i,j:integer;

begin

for i:= 1 to n do

for j:= 1 to n do  

begin

sr.Cells[i,j]:=sr.Cells[j,i];

end; end; end.