TSPST_1 / TSPMET

unit tspmet;

{$F+,O+,V-,X+}
interface
USES Dos, Objects, Drivers, Memory, Views, Menus, Dialogs, StdDlg1,
Mesag2, App,tsphl,Crt,Printer,tiptsp;

procedure newtsp(FileName,FileNameOpen:PathStr; var g:boolean);
procedure oldtsp(FileName,FileNameOpen:PathStr;var g:boolean);

implementation
const
maxwozd=5;
type
kolxar=record
grup:string[5];
fam:string[15];
mm:string[2];
mn:string[2];
myg:string[10];
myb:string[10];
ma:string[6];
mhk1:string[10];
mmb:string[10];
mmh:string[10];
end;
var
ff9:text;
hh:array[1..22] of boolean;
DanFile:TDosStream;
DanParamStream:TDosStream;
FileName,FileNameOpen: PathStr;
dann:kolxar;
m,n: integer;
GG:array[1..4] of real;
yg,yb,a,hk1,mb,mh,h1,h2:real;
hhh,VH,VB,HB:PCollection;
function RTrim(s: String): String;
var
I: integer;
begin
while S[Length(s)] = ' ' do Dec(S[0]);
RTrim:= s;
end;

function LTrim(S: String): String;
var
I: Integer;
begin
I := 1;
while (I < Length(S)) and (S[I] = ' ') do Inc(I);
LTrim := Copy(S, I, 255);
end;

Procedure Putr(tt:PCollection;i,j:integer; x:real);
var
k:integer;
PP:PDan;
kol:word;
begin
PP:=tt^.At(1);
kol:=round(PP^.xy);
k:=(i-1)*kol+j-1;
if k+2>tt^.Count then
begin
MessageBox(#13+^C'‚л室 §  ЇаҐ¤Ґ«л ¬ ббЁў !!!', nil, mfError+mfOkButton);
halt;
end;
PP:=tt^.At(k+2);
PP^.xy:=x;
end;

function GetR(tt:PCollection; i,j: integer): real;
var
k:integer;
PP:PDan;
kol:word;
begin
PP:=tt^.At(1);
kol:=round(PP^.xy);
k:=(i-1)*kol+j-1;
if k+2>tt^.Count then
begin
MessageBox(#13+^C'‚л室 §  ЇаҐ¤Ґ«л ¬ ббЁў !!!', nil, mfError+mfOkButton);
halt;
end;
PP:=tt^.At(k+2);
GetR:=PP^.xy;
end;


procedure NewDan(var t:boolean; pri:boolean);
var
cod,p,tt:integer;
Dialog: PDialog;
C: Word;
R: TRect;
B: PView;

procedure perewod(var p:integer);
var
s1,s2:string[6];
c,avt1,cc,cod:word;
label 1;
begin
p:=1;
val(dann.mm,m,cod);
if (cod<>0) or (m<=0) then
begin
p:=3;
MessageBox(#13^C'Љ®«ЁзҐбвў® ўҐаиЁ­ Єў ¤а в®ў ў бв®«ЎжҐ ¤®«¦­® Ўлвм Ў®«миҐ 0.', nil, mfError+mfOkButton);
goto 1;
end;
val(dann.mn,n,cod);
if (cod<>0) or (n<=0) then
begin
p:=4;
MessageBox(#13^C'Љ®«ЁзҐбвў® ўҐаиЁ­ Єў ¤а в®ў ў бва®ЄҐ ­Ґ ¤®«¦­® Ўлвм ¬Ґ­миҐ 1!', nil, mfError+mfOkButton);
goto 1;
end;
val(dann.myg,yg,cod);
if (cod<>0) then
begin
p:=5;
MessageBox(#13^C'ЋиЁЎЄ ! ‚ўҐ¤Ґ­® ­Ґ зЁб«®! ', nil, mfError+mfOkButton);
goto 1;
end;
if ABS(yg)>0.1 then
begin
P:=5;
MessageBox(#13^C' ‚ўҐ¤Ґ­® ­Ґ¤®ЇгбвЁ¬®Ґ §­ зҐ­ЁҐ “ѓ! ', nil, mfError+mfOkButton);
goto 1;
end;
val(dann.myb,yb,cod);
if (cod<>0) then
begin
p:=6;
MessageBox(#13^C'ЋиЁЎЄ ! ‚ўҐ¤Ґ­® ­Ґ зЁб«®! ',
nil, mfError+mfOkButton);
goto 1;
end;
if ABS(yb)>0.1 then
begin
P:=6;
MessageBox(#13^C' ‚ўҐ¤Ґ­® ­Ґ¤®ЇгбвЁ¬®Ґ §­ зҐ­ЁҐ “B! ', nil, mfError+mfOkButton);
goto 1;
end;
val(dann.ma,a,cod);
if (cod<>0) or (a<=0) then
begin
p:=7;
MessageBox(#13^C'‚Ґ«ЁзЁ­  бв®а®­л Єў ¤а в  ­Ґ ¬®¦Ґв Ўлвм ­г«Ґў®© Ё«Ё ®ваЁж вҐ«м­®©! ',
nil, mfError+mfOkButton);
goto 1;
end;
val(dann.mhk1,hk1,cod);
if (cod<>0) or (hk1<=0) then
begin
p:=8;
MessageBox(#13^C'ЋиЁЎЄ  ў ¤ ­­ле ЌЉ1! ',
nil, mfError+mfOkButton);
goto 1;
end;
val(dann.mmb,mb,cod);
if (cod<>0) or (mb<=0) or (mb>5) then
begin
p:=9;
MessageBox(#13^C'ЋиЁЎЄ  ў ¤ ­­ле MB! ',
nil, mfError+mfOkButton);
goto 1;
end;
val(dann.mmh,mh,cod);
if (cod<>0) or (mh<=0) or (mh>5) then
begin
p:=10;
MessageBox(#13^C'ЋиЁЎЄ  ў ¤ ­­ле MH! ',
nil, mfError+mfOkButton);
goto 1;
end;
p:=0;
1: end;

begin
p:=1;
if pri then
begin
dann.grup:='';
dann.fam:='';
dann.mm:='';
dann.mn:='';
dann.myg:='';
dann.myb:='';
dann.ma:='';
dann.mhk1:='';
dann.mmb:='';
dann.mmh:='';
end;
repeat
t:=false;
R.Assign(2,1,70,21);
Dialog:= New(PDialog, Init(R, '‚‚Ћ„ „ЂЌЌ›•'));
with Dialog^ do
begin
R.Assign(22,1,27,2);
B:=New(PInputLine, Init(R, 5));
B^.HelpCtx := hcmd1;
Insert(B);
R.Assign(4,1,21,2);
Insert(New(Plabel, Init(R, '‘в㤥­в ЈагЇЇл: ',B)));
R.Assign(43,1,60,2);
B:=New(PInputLine, Init(R, 15));
B^.HelpCtx := hcmd2;
Insert(B);
R.Assign(30,1,42,2);
Insert(New(Plabel, Init(R, '” ¬Ё«Ёп:',B)));

R.Assign(48,3,51,4);
B:=New(PInputLine, Init(R, 2));
B^.HelpCtx := hcmd7;
Insert(B);
R.Assign(2,3,47,4);
Insert(New(Plabel, Init(R, 'Љ®«ЁзҐбвў® ўҐаиЁ­ Єў ¤а в®ў ў бв®«ЎжҐ Њ ',B)));
R.Assign(48,4,51,5);
B:=New(PInputLine, Init(R, 2));
B^.HelpCtx := hcmd17;
Insert(B);
R.Assign(2,4,47,5);
Insert(New(Plabel, Init(R, 'Љ®«ЁзҐбвў® ўҐаиЁ­ Єў ¤а в®ў ў бва®ЄҐ N ',B)));
R.Assign(2,5,66,6);
B:=New(PStaticText, Init(R, ^C'--------------------------------------'));
Insert(B);
R.Assign(48,6,59,7);
B:=New(PInputLine, Init(R, 10));
B^.HelpCtx := hcmd3;
Insert(B);
R.Assign(2,6,47,7);
Insert(New(PLabel, Init(R, 'Џа®ҐЄв­л© гЄ«®­ Ї«®й ¤ЄЁ Ї® Ј®аЁ§®­в «Ё Yѓ ',B)));

R.Assign(48,7,59,8);
B:=New(PInputLine, Init(R,10));
B^.HelpCtx := hcmd9;
Insert(B);
R.Assign(2,7,47,8);
Insert(New(PLabel, Init(R, 'Џа®ҐЄв­л© гЄ«®­ Ї«®й ¤ЄЁ Ї® ўҐавЁЄ «Ё “‚ ',B)));
R.Assign(2,8,66,9);
B:=New(PStaticText, Init(R, ^C'--------------------------------------'));
Insert(B);
R.Assign(46,9,53,10);
B:=New(PInputLine, Init(R, 6));
B^.HelpCtx := hcmd99;
Insert(B);
R.Assign(12,9,45,10);
Insert(New(PLabel, Init(R, '‚Ґ«ЁзЁ­  бв®а®­л Єў ¤а в  (¬) Ђ ',B)));
R.Assign(2,10,66,11);
B:=New(PStaticText, Init(R, ^C'--------------------------------------'));
Insert(B);
R.Assign(59,11,67,12);
B:=New(PInputLine, Init(R, 10));
B^.HelpCtx := hcmd999;
Insert(B);
R.Assign(2,11,58,12);
Insert(New(PLabel, Init(R, 'Џа®ҐЄв­ п ®в¬ҐвЄ  ў «Ґў®¬ ўҐае­Ґ¬ гЈ«г Ї«®й ¤ЄЁ (¬) ЌЉ1 ',B)));
R.Assign(2,12,66,13);
B:=New(PStaticText, Init(R, ^C'--------------------------------------'));
Insert(B);
R.Assign(35,13,46,14);
B:=New(PInputLine, Init(R, 10));
B^.HelpCtx := hcmd9999;
Insert(B);
R.Assign(2,13,34,14);
Insert(New(PLabel, Init(R, 'Џ®Є § вҐ«м ®вЄ®б  Ї«®й ¤ЄЁ Њ‚ ',B)));
R.Assign(35,14,46,15);
B:=New(PInputLine, Init(R, 10));
B^.HelpCtx := hcmd199;
Insert(B);
R.Assign(2,14,34,15);
Insert(New(PLabel, Init(R, 'Џ®Є § вҐ«м ®вЄ®б  Ї«®й ¤ЄЁ ЊЌ ',B)));

R.Assign(12,16,29,18);
B:=New(PButton, Init(R, ' ~1~ Џа®¤®«¦Ёвм', cmOK, bfDefault));
B^.HelpCtx := hcmd101;
Insert(B);
R.Assign(38, 16,49,18);
B:=New(PButton, Init(R, ' ЋвЄ §', cmCancel, bfNormal));
B^.HelpCtx := hcmd102;
Insert(B);
for tt:=1 to p do
SelectNext(False);
end;
Dialog^.SetData(Dann);
C := DeskTop^.ExecView(Dialog);
if C<> cmCancel then
begin
Dialog^.GetData(Dann);
t:=true; cod:=1; perewod(p);
if p>0 then cod:=0;
end
else cod:=1;
until cod=1;
if Dialog <> nil then Dispose(Dialog,Done);
end;

procedure newdanmas1(var t,t1,t2:boolean;rr:word;st1:string;var dd:PCollection);
Type
Name=record
NPG:array[1..90] of string[10];
end;

procedure Sox(Nam: Name; var l:integer);
var
cc:word;
s1:string[2];
ss:string[3];
k,k1,jj,kol,j,i,cod,j1,ll:integer;
r,r1,r2:real;
PP:PDan;
label 1;
begin
l:=0;
i:=0;
kol:=0;
j1:=0;
for i:=1 to m do
for j:=1 to n do
begin
k:=(i-1)*n+j;
val(Nam.npg[k], r, cod);
if (cod <> 0) then begin L:=k; goto 1 end;
if r=0.0 then begin kol:=kol+1; if kol=1 then ll:=k; end;
end;
if l=0 then
begin
if kol<>0 then
begin
str(kol,ss);
CC:=MessageBox(#13^C'“ ‚ б ¤Ґ©б⢨⥫쭮 '+ss+' ­г«Ґўле §­ зҐ­Ё© ¬ ваЁжл Ќ! ',
nil, mfWarning+mfOkButton+mfNoButton);
if CC=cmNo then begin l:=ll;goto 1 end;
end;
for i:=1 to m do
for j:=1 to n do
begin
val(Nam.npg[(i-1)*n+j], r, cod);
jj:=J1+(i-1)*n+j;
PP:=dd^.At(jj-1+2); PP^.xy:=r;
end;
end;
1: end;

var
Dialog: PDia;
R: TRect;
C: Word;
B: PView;
Nam:Name;
PP:Pdan;
i,j,jjj,k,ij,jj,ll,kl:integer;
str1,ii: string[3];
label 1;
begin
t:=true; t1:=false; t2:=false;
for i:=1 to m do
for j:=1 to n do
begin
k:=((i-1)*n)+j;
PP:=dd^.At(k-1+2);
Str(PP^.xy:8:3,Nam.npg[(i-1)*n+j]);
end;
if n<3 then jj:= 36 else jj:=n*12; jjj:=(74-jj) div 2;
kl:=n*12;
ll:=0;
repeat
R.Assign(jjj,1,jjj+6+jj,m+8);
Dialog:= New(PDia, Init(R, '‡ЌЂ—…Ќ€џ ќ‹…Њ…Ќ’Ћ‚ ЊЂ’ђ€–› H'));
with Dialog^ do
begin
R.Assign(2,1,jj+5,2);
B:=New(PStaticText, Init(R, ^C'‚‚Ћ„€’… '+St1));
Insert(B);
R.Assign(1,2,5+kl,3);
B:=New(PLabel, Init(R, 'N ‘в®«ЎҐж ‘в®«ЎҐж ‘в®«ЎҐж ‘в®«ЎҐж ‘в®«ЎҐж ‘в®«ЎҐж ',B));
Insert(B);
R.Assign(1,3,5+kl,4);
B:=New(PLabel, Init(R, ' 1 2 3 4 5 6 ',B));
Insert(B);
for j:=1 to m do
begin
Str(j:2,ii);
R.Assign(1,j+3,4,j+4);
Insert(New(PLabel, Init(R, ii, B)));
for i:=1 to n do
begin
R.Assign(5+(i-1)*12,j+3,15+(i-1)*12,j+4);
B:=New(PInputLine, Init(R, 10));
B^.HelpCtx := hcmf32;
{ if mm=2 then B^.HelpCtx := hcmf33;}
Insert(B);
end;
end;
if kl>=36 then ij:=(kl-30) div 2 else ij:=3;
R.Assign(ij,m+5,ij+15,m+7);
B:=New(PButton, Init(R, '~2~ ‘®еа ­Ёвм', cmSox, bfDefault));
B^.HelpCtx := hcmf110;
Insert(B);
{ if ((ttt-rr)>0) then
begin
if jj=36 then R.Assign(24,rr+7,40,rr+9)
else R.Assign(30,rr+7,45,rr+9);
B:=New(PButton, Init(R, '~1~ ‚Ґа­гвмбп', cmVer, bfNormal));
B^.HelpCtx := hcmf111;
Insert(B);
end; }
R.Assign(ij+18,m+5,ij+37,m+7);
{ if jj=36 then R.Assign(ij+18,m+5,ij+34,m+7) else
if jj>59 then R.Assign(46,m+5,65,m+7) else R.Assign(41,m+5,59,m+7);}
B:=New(PButton, Init(R, 'Ќ  ­ з «® ўў®¤ ', cmYes, bfNormal));
B^.HelpCtx := hcmf112;
Insert(B);
SelectNext(False);

for j:=1 to ll-1 do
SelectNext(False);
end;
Dialog^.SetData(Nam);
C := DeskTop^.ExecView(Dialog);
if C<> cmCancel then
begin
Dialog^.GetData(Nam);
Sox(Nam,ll);
end;
if Dialog<>nil then Dispose(Dialog, Done);
until (ll = 0) or (C=cmCancel);
{ if C=cmVer then
begin
t2:=true;
t:=true; t1:=false; goto 1;
end;}
if C=cmSox then
begin
t:=true; t2:=false; t1:=false;goto 1;
end;
if C=cmYes then
begin
t:=true; t1:=true; t2:=false; goto 1;
end;
if C=CmCancel then
t := false;

1: end;



procedure newdanmas(pr,tip,us,mm:word;var t,t1:boolean;kolnst,por:word;st1:string;var AList:PCollection);
label 1;
Type
Name=record
NPG:array[1..50] of string[10];
end;
procedure Sox(nst,K:integer; Nam: Name; var l:integer;prr:boolean);
label 1;
var
i,jj,j,kol,ll,cod,j1:integer;
CC:word;
r:real;
PP:PDan;
ss:string[3];
begin
I:=0;
l:=0;
j1:=(nst-1)*por+2;
J:=k mod 48;
if j=0 then j:=48;j1:=j1+k-J;
Kol:=0;
repeat
i:=i+1;
val(Nam.npg[i], r, cod);
if (cod<>0) then l:=i;
if prr and (r=0.0) then begin kol:=kol+1; if kol=1 then ll:=i; end;
until ((i=j) or (l<>0));
if l=0 then
begin
if kol<>0 then
begin
str(kol,ss);
CC:=MessageBox(#13^C'“ ‚ б ¤Ґ©б⢨⥫쭮 '+ss+' ­г«Ґўле §­ зҐ­Ё© ў бва®ЄҐ ¬ ваЁжл Ќ! ',
nil, mfWarning+mfOkButton+mfNoButton);
if CC=cmNo then begin l:=ll;goto 1 end;
end;
for i:=1 to j do
begin
jj:=J1+(i-1);
val(Nam.npg[i], r, cod);
PP:=Alist^.At(jj); PP^.xy:=r;
end;
end;
1: end;
label 2;
var
Dialog: PDia;
R: TRect;
C: Word;
B: PView;
Nam:Name;
PP:PDan;
nst,i,j,n,kk,k,jj,ll,ko,li,kl,dob:integer;
ii,sd,ss1,ss2: string[3];
str1:string[25];
str2:string[10];
prr:boolean;
begin
t1:=false;
t:=false;
nst:=1;
repeat

k:=0;
I:=por div 4;
kl:=0;
dob:=(nst-1)*por;
str(nst:3,ss1);

repeat
Ll:=0;
if I>=12 then begin N:=12; li:=48; end
else begin if (por mod 4)<>0 then N:=I+1 else N:=i; li:=I*4+por-(por div 4)*4; end;
for j:=1 to N*4 do
begin
if kl<por then
begin
kl:=kl+1;
if Alist^.Count>=(kl-1)+2+dob then
begin

PP:=Alist^.At((kl-1)+2+dob);
Str(PP^.xy:8:2,Nam.npg[j]);

end
else Nam.npg[j]:='0';
end;
end;
repeat
R.Assign(3,1,78,N+10);
Dialog:= New(PDia, Init(R, '‡ЌЂ—…Ќ€џ ќ‹…Њ…Ќ’Ћ‚ ЊЂ’ђ€–›'));
with Dialog^ do
begin
R.Assign(2,2,73,3);
B:=New(PStaticText, Init(R, ^C'‚‚Ћ„€’… '+St1));
Insert(B);
str2:='‘ва®Є  '+LTRim(ss1);
if k>=48 then str1:=str2+' Їа®¤®«¦Ґ­ЁҐ' else str1:=str2;
begin
ko:=31;
R.Assign(ko,3,73,4);
B:=New(PStaticText, Init(R, Str1));
Insert(B);
end;
R.Assign(3,4,74,5);
B:=New(PLabel, Init(R, ' N ‡­ зҐ­ЁҐ N ‡­ зҐ­ЁҐ N ‡­ зҐ­ЁҐ N ‡­ зҐ­ЁҐ',B));
Insert(B);
for j:=1 to N do
begin
for jj:=1 to 4 do
begin
if k < por then
begin
k:=k+1;
Str(k:2,ii);
R.Assign(8+(jj-1)*18,j+4,18+(jj-1)*18,j+5);
B:=New(PInputLine, Init(R, 10));
B^.HelpCtx := hcmf32;
Insert(B);
R.Assign(3+(jj-1)*18,j+4,7+(jj-1)*18,j+5);
Insert(New(PLabel, Init(R, ii, B)));
end;
end;
end;
if (k<por) then
begin
R.Assign(7,N+6,24,N+8);
B:=New(PButton, Init(R, '~1~ Џа®¤®«¦Ёвм', cmProd, bfDefault));
B^.HelpCtx := hcmf106;
Insert(B);
end
else
begin
R.Assign(7,N+6,24,N+8);
B:=New(PButton, Init(R, '~1~ ‘®еа ­Ёвм ', cmSox, bfDefault));
B^.HelpCtx := hcmf107;
Insert(B);
end;
if (k>48) or (nst>1) then
begin
R.Assign(30,N+6,45,N+8);
B:=New(PButton, Init(R, '~2~ ‚Ґа­гвмбп', cmVer, bfNormal));
B^.HelpCtx := hcmf109;
Insert(B);
end;
R.Assign(52,N+6,71,N+8);
B:=New(PButton, Init(R, 'Ќ  ­ з «® ўў®¤ ', cmYes, bfNormal));
B^.HelpCtx := hcmf108;
Insert(B);
SelectNext(False);
for jj:=1 to ll-1 do
SelectNext(False);
end;
Dialog^.SetData(Nam);
C := DeskTop^.ExecView(Dialog);
if C<> cmCancel then
begin
Dialog^.GetData(Nam);
if c=cmVer then Sox(nst,k,Nam,ll,false) else Sox(nst,k,Nam,ll,true);
if (c<>cmVer) and (ll<>0) then k:=k-li;
end;
if Dialog<>nil then Dispose(Dialog, Done);
until (ll = 0) or (C=cmCancel) or (C=cmVer);
if C=cmVer then
begin
kk:=k-li-48;
if kk>=0 then begin k:=kk; kl:=kk; N:=12;i:=i+N end
else
if nst>1 then nst:=nst-1
else
MessageBox(#13^C'—в®-в® ­Ґ Їа ўЁ«м­® ў Їа®Ја ¬¬Ґ!', nil, mfError+mfOkButton);;
end;

if C=cmYes then
begin
t:=true; t1:=true; goto 1;
end;
if C<>cmVer then I:=I-N;
until ((k=por) or (C=cmCancel));
if C=cmSox then
begin
t:=true; nst:=nst+1;
end;

until ((nst-1=kolnst) or (C=cmCancel));
if C=cmCancel then t:=false;
1: end;

function B(y,r:real):real;
begin
B:=y*y*r*sqr(r)/3;
end;
function D(y,r:real):real;
begin
D:=y*A/6*r*sqr(r)/(ABS(H1)+ABS(H2));
end;
function F(y,zz,r,s:real):real;
begin
F:=A*A*(y+2*zz+2*r+s)/6;
end;
function Z(y,q,r:real):real;
begin
Z:=A*A/6*Q*sqr(Q)/((ABS(y)+Abs(Q))*(ABS(Q)+ABS(r)));
end;
function ZL(y,ZZ,r:real):real;
begin
ZL:=A*A/6*(y+zz+r);
end;
function GGG(y:real):real;
begin
ggg:=y*A*H1/ABS(H1)*(H1*H1+H2*H2)/4;
end;
procedure Sjet(var t1:boolean;FileNameOpen:PathStr);
var
i,j,ir,k,ip,is,m1,n1,mm,nn,iv,k1,ix:integer;
x,h3,h4,v,t,dl1,dl2,dl3,dl4,VBB,VHH:real;
ff9:text;
ss,ss1:string[3];
label 6,7,8,9,10,11,12,13,14,15,16,17,18,19,
20,22,23,25,26,27,24,29,31,32,30,33,34,35,37,995,990;
begin
t1:=false;
Assign(ff9,FileNameOpen);
Rewrite(ff9);
WRITEln(ff9,' ‘—€’Ђ‹ бв㤥­в ',Dann.fam,' ѓђ“ЏЏЂ ',Dann.grup );
WRITEln(ff9,' ');
Writeln(FF9,' €‘•Ћ„Ќ›… „ЂЌЌ›…: ');
writeln(FF9,' ');
writeln(FF9,' Љ®«ЁзҐбвў® ўҐаиЁ­ Єў ¤а в®ў ў бв®«ЎжҐ Њ=',M:2);
writeln(FF9,' Љ®«ЁзҐбвў® ўҐаиЁ­ Єў ¤а в®ў ў бва®ЄҐ N=',N:2);
writeln(FF9,' Џа®ҐЄв­л© гЄ«®­ Ї«®й ¤ЄЁ “ѓ=',YG:7:4,' “‚=',YB:7:4);
writeln(FF9,' ‚Ґ«ЁзЁ­  бв®а®­л Єў ¤а в  A=',A:7:2);
writeln(FF9,' Џа®ҐЄв­ п ®в¬ҐвЄ  ў «Ґў®¬ ўҐае­Ґ¬ гЈ«г Ї«®й ¤ЄЁ ЌЉ1=',HK1:7:4);
writeln(FF9,' Џ®Є § вҐ«Ё ®вЄ®б  Ї«®й ¤ЄЁ Њ‚=',MB:7:4,' MH=',MH:7:4);
writeln(FF9,' ');
WRITEln(ff9,' ');
WRITEln(ff9,' ‡Ђ„ЂЌЌ›‰ ЊЂ‘‘€‚ Ќ');
for I:=1 to m do
begin
WRITELN(ff9,' ');
for J:=1 to N do
if (J mod 5)=0 then WRITEln(ff9,Getr(HHH,I,J):12:5) else WRITE(ff9,Getr(HHH,I,J):12:5);
end;
WRITEln(ff9,' ');
for I:=1 to M do
for J:=1 to N do
begin
PutR(HB,I,J,(HK1+A*(J-1)*YG+A*(I-1)*YB));
Putr(HHH,I,J,(HK1+A*(J-1)*YG+A*(I-1)*YB-Getr(HHH,I,J)));
end;

WRITEln(ff9,' ');
WRITEln(ff9,' ђ…‡“‹њ’Ђ’› ЏђЋ‘—…’Ђ ');
WRITEln(ff9,' ');
WRITEln(ff9,' ‡ЌЂ—…Ќ€… ЏђЋ…Љ’Ќ›• Ћ’Њ…’ЋЉ');
for I:=1 to m do
begin
WRITELN(ff9,' ');
for J:=1 to N do
if (J mod 5)=0 then WRITEln(ff9,Getr(HB,I,J):12:5) else WRITE(ff9,Getr(HB,I,J):12:5);
end;
WRITEln(ff9,' ');
WRITEln(ff9,' ');
WRITEln(ff9,' ‡ЌЂ—…Ќ€… ђЂЃЋ—€• Ћ’Њ…’ЋЉ.');
for I:=1 to m do
begin
WRITELN(ff9,' ');
for J:=1 to N do
if (J mod 5)=0 then WRITEln(ff9,Getr(HHH,I,J):12:5) else WRITE(ff9,Getr(HHH,I,J):12:5);
end;
WRITEln(ff9,' ');
IR:=(N-1)*(M-1);
WRITEln(ff9,' ');
WRITEln(ff9,' ');
WRITEln(ff9,' ’ЂЃ‹€–Ђ 1');

WRITEln(ff9,' ЙННННННННЛННННННННННННЛННННННННННННЛННННННННЛННННННННННННЛНННННННННННН»');
WRITEln(ff9,' є ЌЋЊ…ђ є ЋЃљ…Њ є ЋЃљ…Њ є ЌЋЊ…ђ є ЋЃљ…Њ є ЋЃљ…Њ є');
WRITEln(ff9,' єЉ‚Ђ„ђЂ’Ђє ‚›…ЊЉ€ є ЌЂ‘›Џ€ єЉ‚Ђ„ђЂ’Ђє ‚›…ЊЉ€ є ЌЂ‘›Џ€ є');
WRITEln(ff9,' МННННННННОННННННННННННОННННННННННННОННННННННОННННННННННННОНННННННННННН№');

for K:=1 to IR do
begin
Putr(VB,K,1,0.0);
Putr(VH,K,1,0.0);
end;
I:=0;
6: J:=0;
I:=I+1;
7: J:=J+1;
IF(I=M+2) then GOTO 8;
IF(J=N+2) then GOTO 6;
IF(I<>M+1) then GOTO 9;
IF(J=N+1) then H2:=Getr(HHH,I-1,J-1) else H2:=Getr(HHH,I-1,J);
IP:=I-2;
IF(J=1) then GOTO 10;
H1:=getr(HHH,I-1,J-1);
GOTO 11;
9: IF(I=1) then GOTO 12;
GOTO 13;
12: IF(J=N+1) then GOTO 14;
H2:=Getr(HHH,I,J);
IP:=I;
IF(J=1) then GOTO 10;
GOTO 14;
10: K:=(IP-1)*(N-1)+J;
X:=H2;
GOTO 15;
14: H1:=Getr(HHH,I,J-1);
IP:=I;
11: IF(J=N+1) then K:=(IP-1)*(N-1)+J-2;
IF(J=N+1) then X:=H1;
IF(J<>N+1) then K:=(IP-1)*(N-1)+J-1;
IF(J<>N+1) then GOTO 16;
15: IF(X<0.0) then Putr(VB,K,1,(Getr(VB,K,1)+B(MB,X)));
IF(X>=0.0) then Putr(VH,K,1,(Getr(VH,K,1)+B(MH,X)));
GOTO 7;
13: IF(J=1) then GOTO 17;
IF(J=N+1) then GOTO 18;
GOTO 19;
17: H1:=Getr(HHH,I-1,J);
H2:=Getr(HHH,I,J);
K:=(I-2)*(N-1)+J;
GOTO 16;
18: H1:=Getr(HHH,I-1,J-1);
H2:=Getr(HHH,I,J-1);
K:=(I-2)*(N-1)+J-2;
16: IF(H1*H2>0.0) then GOTO 20;
IF(H1>0.0) then Putr(VH,K,1,(Getr(VH,K,1)+D(MH,H1)));
IF(H1>0.0) then Putr(VB,K,1,(Getr(VB,K,1)+D(MB,H2)));
IF(H1<=0.0) then Putr(VH,K,1,(Getr(VH,K,1)+D(MH,H2)));
IF(H1<=0.0) then Putr(VB,K,1,(Getr(VB,K,1)+D(MB,H1)));
GOTO 7;
20: IF(H2>0.0) then Putr(VH,K,1,(Getr(VH,K,1)+GGG(MH)));
IF(H2<=0.0) then Putr(VB,K,1,(Getr(VB,K,1)+GGG(MB)));
GOTO 7;
19: H1:=Getr(HHH,I-1,J-1);
H2:=Getr(HHH,I-1,J);
H3:=Getr(HHH,I,J-1);
H4:=Getr(HHH,I,J);
IS:=0;
K:=(I-2)*(N-1)+J-1;
M1:=I-1;
N1:=J-1;
for MM:=M1 to I do
for NN:=N1 to J do
begin
IF(Getr(HHH,MM,NN)>0.0) then IS:=IS+1;
IF(Getr(HHH,MM,NN)<=0.0) then IS:=IS-1;
end;
IF(ABS(IS)=4) then GOTO 22;
DL1:=H1;
DL2:=H2;
DL3:=H3;
DL4:=H4;
IF(IS=0) then GOTO 23;
GOTO 24;
22: IF(ABS(H1-H4)>ABS(H2-H3)) then V:=F(H1,H2,H3,H4);
IF(ABS(H1-H4)<=ABS(H2-H3)) then V:=F(H2,H1,H4,H3);
IF(V<0.0) then Putr(VB,K,1,(Getr(VB,K,1)+V));
IF(V>=0.0) then Putr(VH,K,1,(Getr(VH,K,1)+V));
GOTO 7;
23: IF(H1*H2<=0.0) then GOTO 25;
DL1:=H2;
DL2:=H4;
DL3:=H1;
DL4:=H3;
25: IF(ABS(DL1-DL4)>ABS(DL2-DL3)) then GOTO 26;
GG[1]:=Z(DL2,DL1,DL4);
GG[2]:=Z(DL1,DL4,DL3);
GG[3]:=ZL(DL2,DL1,DL4)-GG[1];
GG[4]:=ZL(DL1,DL4,DL3)-GG[2];
GOTO 27;
26: GG[1]:=Z(DL1,DL2,DL3);
GG[2]:=Z(DL2,DL3,DL4);
GG[3]:=ZL(DL3,DL1,DL2)-GG[1];
GG[4]:=ZL(DL2,DL3,DL4)-GG[2];
27: for IV:=1 to 4 do
begin
IF(GG[IV]<0.0) then Putr(VB,K,1,(Getr(VB,K,1)+GG[IV]));
IF(GG[IV]>=0.0) then Putr(VH,K,1,(Getr(VH,K,1)+GG[IV]));
end;
GOTO 7;
24: IF(IS<=0) then GOTO 29;
H1:=-H1;
H2:=-H2;
H3:=-H3;
H4:=-H4;
29: IF(H1>0.0) then GOTO 30;
IF(H2<=0.0) then GOTO 31;
DL1:=H2;
DL2:=H4;
DL3:=H1;
DL4:=H3;
GOTO 30;
31: IF(H3>0.0) then GOTO 32;
DL1:=H4;
DL2:=H3;
DL3:=H2;
DL4:=H1;
GOTO 30;
32: DL1:=H3;
DL2:=H1;
DL3:=H4;
DL4:=H2;
30: X:=ZL(DL2,DL3,DL4);
V:=ZL(DL1,DL2,DL3);
T:=DL1*sqr(DL1)*A*A/(6*(ABS(DL1)+ABS(DL2))*(ABS(DL1)+ABS(DL3)));
IF(IS<0) then GOTO 33;
Putr(VH,K,1,(Getr(VH,K,1)-X-V+T));
Putr(VB,K,1,(Getr(VB,K,1)-T));
GOTO 34;
33: Putr(VH,K,1,(Getr(VH,K,1)+T));
Putr(VB,K,1,(Getr(VB,K,1)+X+V-T));
34: Putr(VH,K,1,ABS(Getr(VH,K,1)));
Putr(VB,K,1,(-ABS(Getr(VB,K,1))));
GOTO 7;
8: K:=1; VBB:=0;VHH:=0;
35: K1:=K+1;
WRITEln(ff9,' є ',K:2,' є',
Getr(VB,K,1):11:3,' є',
Getr(VH,K,1):11:3,' є ',K1:2,' є',
Getr(VB,K1,1):11:3,' є',Getr(VH,K1,1):11:3,' є');
VBB:=VBB+Getr(VB,K,1)+Getr(VB,K1,1);
VHH:=VHH+Getr(VH,K,1)+Getr(VH,K1,1);
K:=K+2;
IF(K+1<=INT(IR/2.0)*2) then GOTO 35;
IF(K-1=IR) then GOTO 37;
IX:=IR-TRUNC(INT(IR/2)*2);
IF(IX=1) then
begin
WRITEln(ff9,' є ',IR:2,' є',
Getr(VB,IR,1):11:3,' є',
Getr(VH,IR,1):11:3,' є ');
VBB:=VBB+Getr(VB,IR,1);
VHH:=VHH+Getr(VH,IR,1);
end;
37: WRITEln(ff9,' ИННННННННКННННННННННННКННННННННННННКННННННННКННННННННННННКННННННННННННј');
WRITEln(ff9,' ');
WRITEln(ff9,' ');
WRITEln(ff9,' €’ЋѓЋ: ЋЃљ…Њ ‚›…ЊЉ€ ',VBB:13:3);
WRITEln(ff9,' ЋЃљ…Њ ЌЂ‘›Џ€ ',VHH:13:3);
WRITEln(ff9,' ');
WRITEln(ff9,' ђЂ‘—…’ ЋЉЋЌ—…Ќ');
WRITEln(ff9,' ');
WRITEln(ff9,' ');
close(ff9);
T1:=true;
end;
procedure initcol(var hh:boolean;var dd:PCollection;mmm,kkk:integer; nnn:word);
var
i:integer;
s:string[4];
label 1;
begin
if not hh then
begin
MessageBox(#13^C'—в®-в® ­Ґ ўҐа­® ў Їа®Ја ¬¬Ґ! Љ®««ҐЄжЁп 㦥 Ё­ЁжЁ «Ё§Ёа®ў ­ !', nil, mfError+mfOkButton);
DD^.Done; hh:=true
end;
hh:=false;
dd:=New(PCollection, Init(mmm*kkk+2,nnn));
dd^.Insert(New(PDan, init(mmm+0.0)));
dd^.Insert(New(PDan, init(kkk+0.0)));

for i:=1 to mmm*kkk do
begin
if LowMemory then
begin
MessageBox(#13^C'„«п аҐиҐ­Ёп § ¤ зЁ ­Ґ еў в Ґв Ї ¬пвЁ!', nil, mfError+mfOkButton);
hh:=true; goto 1;
end;
dd^.Insert(New(PDan, init(0.0)));
end;
1:
end;

procedure inital1(var gg:boolean);
label 1,2;
begin
gg:=false;
if hh[2] then initcol(hh[2],VH,(m-1)*(n-1),1,10);
if hh[2] then goto 1;
if hh[3] then initcol(hh[3],VB,(m-1)*(n-1),1,10);
if hh[3] then goto 1;
if hh[4] then initcol(hh[4],HB,m,n,10);
if hh[4] then goto 1;
gg:=true;
goto 2;
1:gg:=false;
2: end;

procedure SaveDan(Fnd: PathStr;var g:boolean);
var
dan1:string[4];
begin
Dan1:='TSP ';
DanParamStream.Init(FNd, stCreate);
DanParamStream.write(Dan1,SizeOf(Dan1));
DanParamStream.write(Dann,SizeOf(Dann));
DanParamStream.Put(HHH);
g:=true;
end;

procedure coldone;
begin
if not hh[1] then hhh^.Done;
if not hh[2] then VH^.Done;
if not hh[3] then VB^.Done;
if not hh[4] then HB^.Done;
end;



procedure newtsp(FileName,FileNameOpen:PathStr;var g:boolean);
var
ss,sss:string[3];
st1,SSSS:string;
CC,i,rr,m1:Word;
ttt:integer;
t,t1,t2,pri:boolean;
label 1,2,3,4,5;
begin
g:=true;
t1:=false;
for i:=1 to 4 do
hh[i]:=true;

3: NewDan(g,not t1);
if not g then goto 1;
if hh[1] then initcol(hh[1],HHH,m,n,10);
if hh[1] then goto 1;
if n<=6 then
begin
str(m:2,ss);
st1:='ЊЂ‘‘€‚ ЌЂ’“ђЌ›• Ћ’Њ…’ЋЉ Ќ('+LTrim(ss)+'x';
str(n:2,ss);
st1:=st1+LTrim(ss)+')';
newdanmas1(g,t1,t2,m,st1,hhh);
if not g then goto 1;
if t1 then goto 3;
end
else
begin
str(n:2,ss);
st1:='ЊЂ‘‘€‚ ЌЂ’“ђЌ›• Ћ’Њ…’ЋЉ Ќ - '+LTrim(ss)+' зЁбҐ« ў бва®ЄҐ';
newdanmas(1,1,1,1,t,t1,m,n,st1,HHH);
if not t then goto 1;
if t1 then goto 3;
end;
SaveDan(FileName,g);
if not g then
MessageBox('” ©« ¤ ­­ле ­Ґ г¤ «®бм б®еа ­Ёвм', nil, mfError+mfOkButton);
inital1(g);
if g then
Sjet(g,FileNameOpen);
goto 2;

1:g:=false;
2: coldone;
end;
procedure initcol1(var hh:boolean; var dd:PCollection;mmm,nnn:integer);
begin
hh:=false;
dd:=New(PCollection, Init(mmm+2,nnn));
end;

procedure ReadDan(FNd:PathStr; var g:boolean);
var
m1:word;
dan1:string[4];
s:string[5];
t:boolean;
cod:word;
begin
with DanParamStream do
begin
Init(FNd, stOpen);
read(Dan1,SizeOf(Dan1));
if dan1='TSP ' then
begin
read(Dann,SizeOf(Dann));
val(Dann.mm,m,cod);
val(Dann.mn,n,cod);

initcol1(hh[1],hhh,m*n,10);
hhh:=PCollection(Get);
end
else
begin
MessageBox(#13+^C'” ©« ¤ ­­ле ­Ґ ¤«п Їа®Ја ¬¬л "TSP-а бзҐв ®ЎкҐ¬  ўл­Ё¬ Ґ¬®© §Ґ¬«Ё"!!!',
nil, mfError+mfOkButton);
g:=false;
end;
Done;
end;
end;


procedure oldtsp(FileName,FileNameOpen:PathStr;var g:boolean);
label 1,3,2;
var
t1,t2:boolean;
pp:PDan;
FileToView: Text;
FileName1:PathStr;
s1:dirstr;
s2:namestr;
s3:extstr;
j,i:word;
ss:string[3];
SSS:string[8];
st1:string;
begin
g:=true;
for i:=1 to 4 do hh[i]:=true;
ReadDan(FileName, g);
if not g then goto 1;
J:=MessageBox(#13#13^C'’ђ…Ѓ“…’‘џ €‘ЏђЂ‚‹џ’њ „ЂЌЌ›…?', nil, mfError+mfYesButton+mfNoButton);
if (J=cmYes) then
begin
3: NewDan(g,false);
if not g then goto 1;
if HHH^.Count<>m*n+2 then
begin
HHH^.done; hh[1]:=true
end;
if hh[1] then initcol(hh[1],HHH,m,n,10);
if hh[1] then goto 1;
if n<=6 then
begin
str(m:2,ss);
st1:='ЊЂ‘‘€‚ ЌЂ’“ђЌ›• Ћ’Њ…’ЋЉ Ќ('+LTrim(ss)+'x';
str(n:2,ss);
st1:=st1+LTrim(ss)+')';
newdanmas1(g,t1,t2,m,st1,hhh);
if not g then goto 1;
if t1 then goto 3;
end
else
begin
str(n:2,ss);
st1:='ЊЂ‘‘€‚ ЌЂ’“ђЌ›• Ћ’Њ…’ЋЉ Ќ - '+LTrim(ss)+' зЁбҐ« ў бва®ЄҐ';
newdanmas(1,1,1,1,g,t1,m,n,st1,HHH);
if not g then goto 1;
if t1 then goto 3;
end;
inital1(g);
if not g then goto 1;
Fsplit(FileName,s1,s2,s3);
FileName1:=Rtrim(S2)+'.bak';
if FSearch(FileName1,'')<>'' then
begin
Assign(FileToView,FileName1);
Erase(FileToView);
end;
Assign(FileToView,FileName);
Rename(FileToView,FileName1);
SaveDan(FileName,g);
if not g then
MessageBox('” ©« Ё§¬Ґ­Ґ­­ле ¤ ­­ле ­Ґ г¤ «®бм б®еа ­Ёвм', nil, mfError+mfOkButton);
sjet(g,FileNameOpen);
goto 2;
end;
1:g:=false;
2: coldone;

end;
end.