{ 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 help;
begin

farba(1,15);
gotoxy(33,13);write('               ÃÄÄÄÄÄÄÄÄÄÄÄÄÅ');
gotoxy(3,14);write('    å - Dovolene napatie hriadela,naboja   ÚÄÁÄÄÄÄÄÄÄÄÄÄÄÄÁÄ¿');
gotoxy(3,15);write('   Ra - Drsnost povrchu  hriadela,naboja   ³                ³');
gotoxy(3,16);write(' Spoj - Zmrsteny     (nahrievame naboj )   ÃÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÅ');
gotoxy(3,17);write('        Roztiahnuty  (ochladime hriadel)  ÄÅÄùÄÄùÄÄùÄÄùÄÄùÄÄÅÄ');
gotoxy(3,18);write('        Lisovany  (bez tepelnej  upravy)   ÃÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ´');
gotoxy(3,19);write(' Posobisko - Obvodove (posobi moment Mk)   ³                ³');
gotoxy(3,20);write('             Pozdlzne   (posobi  sila F)   ÀÄÂÄÄÄÄÄÄÄÄÄÄÄÄÂÄÁ');
gotoxy(3,21);write('                                             ÀÄÄÄÄÄÄÄÄÄÄÄÄÙ');
farba(1,12);
gotoxy(33,11);write('               ÃÄÄÄÄ Lt ÄÄÄÄ´');
gotoxy(33,12);write('               ³            ³');
gotoxy(62,13);write('ÄÄÄÄÄÄÄÄÄÄÄÄÄÄÂ');
gotoxy(64,14);write('            ³');
gotoxy(64,15);write('         ³  ³');
gotoxy(64,16);write('ÄÄÄÄÄÂ   ³  ³');
gotoxy(64,17);write('     Db  Dt Da');
gotoxy(64,18);write('     ³   ³  ³');
gotoxy(64,19);write('         ³  ³');
gotoxy(64,20);write('ÄÄÄÄÄÄÄÄÄÁ  ³');
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 zaver;
begin
  gotoxy(2,2);write('     *min=                 æa=                     C2a=                      ');
  gotoxy(2,3);write('     *max=                 æb=                     C2b=                      ');
  gotoxy(2,4);write('       ks=                 Ea=                     åda=                      ');
  gotoxy(2,5);write(' Mp=ksùMk=                 Eb=                     ådb=                      ');
  gotoxy(2,6);write(' Fp=ksùk2=                  ç=                     àab=                      ');
  gotoxy(2,7);write('              1  Ú (Da/Dt)ý+1   ¿  1 Ú (Dt/Db)ý+1    ¿                      ');
  gotoxy(2,8);write('           C= ÄÄùÃÄÄÄÄÄÄÄÄÄÄÄ+æa³+ÄÄùÃÄÄÄÄÄÄÄÄÄÄÄ -æb³=                     ');
  gotoxy(2,9);write('              Ea À (Da/Dt)ý-1   Ù  EbÀ (Dt/Db)ý-1    Ù                      ');
 gotoxy(2,10);write('          pt`min=Fp/ãùDtùLtùç=                                               ');
 gotoxy(2,11);write('       pt`min=2ùMp/ãùDtýùLtùç=                                               ');
 gotoxy(2,12);write('                H=4ù(Raa+Rab)=                                               ');
 gotoxy(2,13);write('          *`min=pt`minùDtùC+H=                                               ');
 gotoxy(2,14);write('               pa max=C2aùåda=                                               ');
 gotoxy(2,15);write('               pb max=C2bùådb=                                               ');
 gotoxy(2,16);write('   pt`max=MIN {pa max,pb max}=                                               ');
 gotoxy(2,17);write('          *`max=pt`maxùDtùC+H=                                               ');
 gotoxy(2,18);write('                                                                             ');
 gotoxy(2,19);write('                                                                             ');
 gotoxy(2,20);write(' Zmrsteny    spoj:                                                           ');
 gotoxy(2,21);write('         tab=t+(*max+v)/àabùDt=                                              ');
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.