Dze je subor www.TrSek.com/pas/tlakspoj.pas{ TLAKSPOJ.PAS Copyright (c) TrSek alias Zdeno Sekerak }
{ Program na vypocet tlakoveho spoja podla definovanych hodnot. }
{ Uzivatelske prostredie, vypocet s poskytovanim medzivysledkov. }
{ Vyzaduje TABULKY.PAS. Vypocet podla STK 2 a Strojnickych tabuliek.}
{ }
{ Datum:04.08.1992 http://www.trsek.com }
program tlakspoj;
uses crt,dos,trsek,tabulky;
type text1=text;
const
poz:array[1..2] of integer =(24,60);
vzpa:array[1..6] of integer =(6,8,10,14,16,19);
dtxt:array[1..11] of string =
('mm','mm','mm','mm','kN','Nm','MPa','MPa','øC','æm','æm');
txt:array[1..2,1..11] of string =
(('Dt=','Lt=','Da=','Db=','Fa=','Mk=',' å hriadel=',
' å naboj =','prevadzkova teplota=','Ra hriadel=','Ra naboj ='),
('Zatazenie:','Spoj:','Mazanie:','Montaz:','Posobisko:',
'Material hriadel:','Material naboj :','','','',''));
text:array[1..7,1..8] of string =
(('pokojne','miznuce','striedave','','','','',''),
('zmrsteny','roztiahnuty','lisovany','','','','',''),
('olejom','nemazane','','','','','',''),
('uvolnovany','sklz','lisovanie','','','','',''),
('obvodove','pozdlzne','','','','','',''),
('ocel','liatina tem.','med','mosadz','bronz','litina Al',
'liatina Mg','siva liatina'),
('ocel','liatina tem.','med','mosadz','bronz','litina Al',
'liatina Mg','siva liatina'));
dlz:array[1..2,1..11] of integer =
((6,6,6,6,6,6,6,6,5,4,4),(9,11,8,11,8,12,12,10,0,0,0));
var x,y,xp,yp,i,dld,zacp,vzp,Gd,Gm,dl,p,ha:integer;
Fp,Mp,Dt,Lt,Da,Db,ni,Ea,Eb,C2a,C2b,Sid,Aab,ptmin,na,nb,H,ks:real;
Fa,Mk,Rea,Reb,Raa,Rab,min,max,minc,maxc,pamax,pbmax,v,tab,t,C:real;
Sda,Sdb,ptmax:real;
czad:array[1..2,1..12] of real;
tzad:array[1..2,1..12] of string;
dnu,vyp,von,nav,hel,krok:boolean;
s:string;
Lst : text1;
function znak(x,y:integer):char;
var regs:registers;
begin
gotoxy(x,y);
with regs do
begin
bh:=0;
ah:=8;
intr($10,regs);
znak:=chr(al);
end;
end;
procedure tlac;
var s:string;
d:char;
begin
assign(lst,'prn');
rewrite(lst);
s:='';
for y:=2 to 23 do begin
for x:=2 to 78 do begin d:=znak(x,y);
s:=s+d;
end;
writeln(lst,s);s:='';
end;
writeln(lst,' Trsek & RiSOft');
close(lst);
end;
procedure konci;
begin
farba(0,15);
clrscr;
farba(1,15);
write(' Tlakovy spoj Copyright (c). software by TRSEK & riSOft Corporation. ');
end;
function tlacidlo:char;
var s:char;
d:integer;
begin
tlacidlo:=' ';
dnu:=false;
vyp:=false;
hel:=false;
von:=false;
krok:=false;
s:=readkey;
if(s in ['0'..'9']) then begin tlacidlo:=s; dnu:=true; end;
if s=#0 then s:=readkey;
case ord(s) of
72 : y:=y-1;
75 : x:=x-1;
80 : y:=y+1;
77 : x:=x+1;
13 : dnu:=true;
59 : help;
60 : vyp:=true;
61 : begin vyp:=true;krok:=true;end;
62 : nav:=true;
65 : begin tlac;s:=readkey;end;
68 : begin konci;Kurzorzap(true);halt(1);end;
end;
if x<1 then x:=2;
if x>2 then x:=1;
if y<1 then y:=11;
if y>11 then y:=1;
if (y>7) and (x=2) then y:=1;
end;
function treada(x,y,d:integer;ch:char):real;
var c1:integer;
c:real;
begin
KurzorZap(True);
s:=tread(x,y,d,'',ch,ch);
KurzorZap(False);
repeat
val(s,c,c1);
if not(c1=0) then begin if length(s)>=c1 then delete(s,c1,1)
else s:='';
end;
until (c1=0) or (s='');
treada:=c;
end;
procedure vymen(x,y:integer);
begin
i:=round(czad[x,y]);i:=i+1;
if (i=9) or (text[y,i]='') then begin czad[x,y]:=1;tzad[x,y]:=text[y,1];end
else begin czad[x,y]:=i;tzad[x,y]:=text[y,i];end;
gotoxy(poz[x],y+1);write(tzad[x,y]);
end;
procedure twrite(x,y:integer;s:string;d:integer);
begin
if length(s)<d then for i:=length(s) to d do s:=s+' ';
if length(s)>d then delete(s,d+1,length(s)-d);
gotoxy(poz[x],y+1);write(s);
end;
procedure disp;
begin
gotoxy(4,23);write(' F1 - Help F2 - Vypocet F3 - Krok F4 - Navrat F7 - Tlac F10 - Koniec');
end;
procedure adisp;
begin
gotoxy(2,23);write(' ');
end;
procedure uvod;
var a:integer;
begin
textbackground(9);textcolor(15);
kurzorzap(false);
window(1,1,80,25);clrscr;
for a:=2 to 79 do begin gotoxy(a,1);write(chr(205)); end;
for a:=2 to 79 do begin gotoxy(a,24);write(chr(205)); end;
for a:=1 to 23 do begin
gotoxy(1,a);write(chr(179));
gotoxy(79,a);write(chr(179));
end;
gotoxy(1,1);write(chr(213));
gotoxy(79,1);write(chr(184));
gotoxy(1,24);write(chr(212));
gotoxy(79,24);write(chr(190));
gotoxy(1,22);write(chr(195));
for a:=2 to 78 do write(chr(196));
gotoxy(79,22);write(chr(180));
disp;
gotoxy(63,25);write('Trsek & RiSOft');
end;
procedure obraz;
var ch:char;
begin
uvod;
farba(1,15);
for i:=1 to 20 do begin
gotoxy(2,1+i);write(' ');
end;
gotoxy(13,25);write(' Tlakovy spoj - vypocet podla CSN 01 4216-65 ');
for y:=1 to 11 do begin
gotoxy(poz[1]-length(txt[1,y])-1,y+1);write(txt[1,y]);twrite(1,y,tzad[1,y],dlz[1,y]);
gotoxy(poz[1]+dlz[1,y]+1,y+1);write(dtxt[y]);
end;
for y:=1 to 7 do begin
gotoxy(poz[2]-length(txt[2,y])-1,y+1);write(txt[2,y],' ',tzad[2,y]);
end;
x:=1;y:=1;xp:=1;yp:=1;
farba(13,15);
twrite(x,y,tzad[x,y],dlz[x,y]);
repeat
ch:=tlacidlo;
if (dnu=true) and (x=1) then begin
czad[x,y]:=treada(poz[x],y+1,dlz[x,y],ch);
if y in [10,11] then str(czad[x,y]:6:5,tzad[x,y])
else str(czad[x,y]:6:2,tzad[x,y]);
end;
if (dnu=true) and (x=2) then vymen(x,y);
farba(9,15);
twrite(xp,yp,tzad[xp,yp],dlz[xp,yp]);
farba(13,15);
twrite(x,y,tzad[x,y],dlz[x,y]);
xp:=x;yp:=y;
until vyp ;
end;
procedure Db_je_nula;
begin
gotoxy(2,7);write(' 1 Ú (Da/Dt)ý+1 ¿ 1 Ú ¿ ');
gotoxy(2,8);write(' C= ÄÄùÃÄÄÄÄÄÄÄÄÄÄÄ+æa³ + ÄÄÄ ù ³ 1 -æb ³= ');
gotoxy(2,9);write(' Ea À (Da/Dt)ý-1 Ù Eb À Ù ');
end;
procedure pwrite(h:real;ret:string);
begin
zacp:=zacp+1;
gotoxy(32,zacp);write(h:5:2,' ',ret);
end;
function vyhovuje(x,y:real;ret:string;c:real):boolean;
begin
vzp:=vzp+1;
if c=2 then begin
gotoxy(54,vzpa[vzp]);
if x<y then begin write('<');
gotoxy(45,vzpa[vzp]+1);write(x:5:2,' ',ret);
gotoxy(54,vzpa[vzp]+1);write('< ',y:5:2,' ',ret);
gotoxy(66,vzpa[vzp]+1);write(' Vyhovuje ');
vyhovuje:=true;
end
else begin write('>');
gotoxy(45,vzpa[vzp]+1);write(x:5:2,' ',ret);
gotoxy(54,vzpa[vzp]+1);write('> ',y:5:2,' ',ret);
gotoxy(66,vzpa[vzp]+1);write(' Nevyhovuje ');
vyhovuje:=false;
end;
if krok then begin
repeat
tlacidlo;
until krok or nav;
end;
end;
end;
function zovretie(tl,maz,up,zat:integer):real;
begin
if tl=2 then tl:=1;
if tl=3 then tl:=2;
if tl=1 then if maz=2 then begin
if up=1 then zovretie:=0.35;
if up=2 then zovretie:=0.15;
if up=3 then zovretie:=0.055;
end
else begin
if up=1 then if zat=1 then zovretie:=0.13
else zovretie:=0.14;
if up=2 then if zat=1 then zovretie:=0.08
else zovretie:=0.055;
if up=3 then zovretie:=0.055;
end;
if tl=2 then begin
if up=1 then zovretie:=0.09;
if up=2 then zovretie:=0.05;
if up=3 then zovretie:=0.055;
end;
end;
function modul(mat:integer):real;
begin
modul:=tab19[1,mat];
end;
function poiscislo(mat:integer):real;
begin
poiscislo:=tab19[2,mat];
end;
function Sd(kov:integer;Re:real):real;
begin
if kov in [1,2,3,4] then Sd:=Re*0.2
else Sd:=Re*0.5;
end;
function roztaznost(ts,mata,matb:real):real;
begin
if ts=1 then roztaznost:=tab19[3,round(matb)]
else roztaznost:=tab19[4,round(mata)];
end;
procedure priemer(d:real);
begin
while d>500 do d:=d/10;
for i:=1 to 13 do
if d>=rozmery[i] then p:=i+1;
end;
function zvol_h(min,max:real;p,zvolene:integer):integer;
begin
for ha:=zvolene to 5 do begin
if ulozeniah[ha,p]+min<max then begin zvol_h:=ha;exit;end;
end;
end;
function zvol_ulozenie(min,max:real;p,zvolene:integer):integer;
begin
for i:=zvolene to 14 do begin
if ulozenia[i,p*2]>= min then
if ulozenia[i,p*2-1]<=max then begin zvol_ulozenie:=i;exit;end;
end;
end;
begin
clrscr;
writeln('Tlakoveho spoja hriadel-naboj, R.Kriz a spol. STK I Sofrware Trsek & RiSOft');
delay(900);
uvod;
nav:=false;
for y:=1 to 11 do begin
tzad[1,y]:='';
czad[1,y]:=0;
end;
for y:=1 to 11 do begin
if(y < 8) then
tzad[2,y]:=text[y,1];
czad[2,y]:=1;
end;
obraz;
repeat
{$F-}
farba(1,15);
Zaver;
Dt:=czad[1,1];Lt:=czad[1,2];Da:=czad[1,3];Db:=czad[1,4];
Fa:=czad[1,5]*1000;Mk:=czad[1,6];Sdb:=czad[1,7];Sda:=czad[1,8];
t:=czad[1,9];Raa:=czad[1,10];Rab:=czad[1,11];
case round(czad[2,1]) of
1: ks:=1.5;
2: ks:=1.8;
3: ks:=2.2;
end;
gotoxy(12,4);write(ks:2:1);
ni:=zovretie(round(czad[2,2]),round(czad[2,3]),round(czad[2,4])
,round(czad[2,5]));
gotoxy(33,6);write(ni:3:3);
if Fa>0 then begin Fp:=ks*Fa;ptmin:=Fp/(3.1415*Dt*Lt*ni);
gotoxy(12,6);write(Fp/1000:6:2,' kN');
gotoxy(33,10);write(ptmin:6:2,' MPa');
v:=0.01*sqrt(Dt);
gotoxy(2,5);write(' v=',v:3:2,' mm');
gotoxy(2,11);write(' ');
end
else begin
Mp:=ks*Mk;ptmin:=2*Mp*1000/(3.1415*Dt*Dt*Lt*ni);
gotoxy(12,5);write(Mp:6:2,' Nm');
gotoxy(33,11);write(ptmin:6:2,' MPa');
v:=0.01*sqrt(Dt);
gotoxy(2,6);write(' v=',v:3:2,' mm');
gotoxy(2,10);write(' ');
end;
Ea:=modul(round(czad[2,7]));
gotoxy(33,4);write(Ea:5:0,' MPa');
Eb:=modul(round(czad[2,6]));
gotoxy(33,5);write(Eb:5:0,' MPa');
na:=poiscislo(round(czad[2,6]));
gotoxy(33,2);write(na:3:2);
nb:=poiscislo(round(czad[2,7]));
gotoxy(33,3);write(nb:3:2);
if Db=0 then begin
C:=(((((Da*Da)/(Dt*Dt))+1)/(((Da*Da)/(Dt*Dt))-1))+na)/Ea+
(1-nb)/Eb;
Db_je_nula;
end
else C:=(((((Da*Da)/(Dt*Dt))+1)/(((Da*Da)/(Dt*Dt))-1))+na)/Ea+
(((((Dt*Dt)/(Db*Db))+1)/(((Dt*Dt)/(Db*Db))-1))-nb)/Eb;
gotoxy(57,8);write(C:8:8,'/MPa');
H:=4*(Raa+Rab);
gotoxy(33,12);write(H:4:1,' æm');
minc:=int(ptmin*Dt*C*1000+H);
gotoxy(33,13);write(minc:4:1,' æm');
obr107(da,db,dt,c2a,c2b);
gotoxy(58,2);write(c2a:2:2);
gotoxy(58,3);write(c2b:2:2);
gotoxy(58,4);write(Sda:6:2,' MPa');
gotoxy(58,5);write(Sdb:6:2,' MPa');
pamax:=C2a*Sda;
gotoxy(33,14);write(pamax:6:2,' MPa');
pbmax:=C2b*Sdb;
gotoxy(33,15);write(pbmax:6:2,' MPa');
if pamax<pbmax then ptmax:=pamax
else ptmax:=pbmax;
gotoxy(33,16);write(ptmax:6:2,' MPa');
maxc:=int(ptmax*Dt*C*1000+H+0.5);
gotoxy(33,17);write(maxc:4:1,' æm');
Aab:=roztaznost(czad[2,2],czad[2,6],czad[2,7]);
gotoxy(58,6);write(Aab:3:1,'ù10~6 /K');
priemer(dt);i:=0;ha:=0;
repeat
i:=i+1; if i>14 then i:=14;
i:=zvol_ulozenie(minc,maxc,p,i);
max:=ulozenia[i,p*2-1];
min:=ulozenia[i,p*2];
if not((i<15) and (i>0)) then begin ha:=ha+1;
ha:=zvol_h(minc,maxc,p,ha);
max:=maxc;
min:=minc+ulozeniah[ha,p];
end;
gotoxy(12,2);write(min:3:0,' æm');
gotoxy(12,3);write(max:3:0,' æm');
if czad[2,2]=1 then begin tab:=t+((max/1000+v)/(Aab*1E-6*Dt));
gotoxy(3,20);write('Zmrsteny ');
end
else begin tab:=t+((max/1000+v)/(Aab*1E-6*Dt));
gotoxy(2,20);write('Roztiahnuty');
end;
gotoxy(34,21);write(tab:4:1,' øC');
adisp;
gotoxy(15,23);
if ptmin>ptmax then write(' POZOR ! pt`min je vascie ako pt`max -zvol lepsi material')
else begin
if (i<15) and (i>0) then write('Volim ulozenie í',Dt:6:1,' ',naz_ulozenia[i])
else
if (ha<6) and (ha>0) then write('Volim ulozenie í',Dt:6:1,' H',ha+4,' +',min:3:0,'+',max:3:0,'æm')
else write('Nemam dalej hodnoty potrebne pre vypocet');
if not(czad[2,2]=3) then write(' teplota ohrevu je: ',tab:4:1);
end;
gotoxy(79,23);write(chr(179));
tlacidlo;
until not(krok);
if nav then begin adisp;disp;obraz;nav:=false;end;
until von;
konci;
KurzorZap(true);
end.