home *** CD-ROM | disk | FTP | other *** search
/ Chip 2000 February / Chip_2000-02_cd.bin / internet / BIBLECD / ODKAZY.ZIP / ODKAZ.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1998-10-11  |  6.6 KB  |  209 lines
  1. unit Odkaz;
  2.  
  3. interface
  4. const    max=32767;
  5. var    pole:array[1..max] of Char;
  6.     zkratky:array[0..2] of String;
  7.     od,i,index,kapitola,pocet,vers,uk1,uk2:Integer;
  8.     pom,ret,ret2,VstupniSoubor,VystupniSoubor:String;
  9.     f:File;
  10.     g:Text;
  11.     cesta,prvni:Boolean;
  12.  
  13. function DalsiPolozku:Boolean;
  14. procedure VypisPolozku;
  15. function ZjistiPolozku:String;
  16. function Najdi(co:String):Boolean;
  17. function JeToCislo(co:String):Boolean;
  18. function JeToZkratka(co:String):Boolean;
  19. function ZapisOdkaz:Byte;
  20. function ZapisOdkaz2:Byte;
  21. function Zapis2(do0:Integer;odkaz:Byte):Integer;
  22. function JeToNazev(co:String):String;
  23.  
  24. implementation
  25. uses    Fr_Sok,Pomocne;
  26.  
  27. function DalsiPolozku:Boolean;
  28. var    i:Integer;
  29. begin
  30.  if (uk2>=pocet) then
  31.  begin
  32.    DalsiPolozku:=False;
  33.  end else begin
  34.    for i:=uk2+2 to pocet do
  35.    begin
  36.     if (pole[i]=' ') or (pole[i]='<') or (pole[i]='(') or (pole[i]=')') or (pole[i]=';') then
  37.     begin
  38.       if (uk2<1) then begin uk1:=1;uk2:=i-1;break;end else begin uk1:=uk2+2;uk2:=i-1;break;end;
  39.     end;
  40.    end;
  41.    if (i=pocet) {cyklus do¿el nakonec souboru} then uk2:=pocet;
  42.    DalsiPolozku:=True;
  43.  end;
  44. end;
  45.  
  46. procedure VypisPolozku;
  47. var i:Integer;
  48. begin
  49.  Write('"');
  50.  for i:=uk1 to uk2 do Write(pole[i]);
  51.  Writeln('"');
  52. end;
  53.  
  54. function ZjistiPolozku:String;
  55. var    pom:String;
  56.     znak:Char;
  57.     i:Integer;
  58. begin
  59.  pom:='';
  60.  for i:=uk1 to uk2 do pom:=pom+pole[i];
  61.  ZjistiPolozku:=pom;
  62. end;
  63.  
  64. function Najdi(co:String):Boolean;
  65. var i:Integer;
  66. begin
  67.  for i:=0 to 2 do if Pos(Prevod(co,3,4),Zkratky[i])>0 then begin Najdi:=True;Exit;end;
  68.  Najdi:=False;
  69. end;
  70.  
  71. function JeToCislo(co:String):Boolean;
  72. var    p:Word;
  73.     i:Integer;
  74. begin
  75.   System.Val(co,p,i);JeToCislo:=(i=0);
  76. end;
  77.  
  78. function JeToZkratka(co:String):Boolean;
  79. begin
  80.   JeToZkratka:=Najdi(' '+OdstranZbytecneMezery(co)+' ');
  81. end;
  82.  
  83. function ZapisOdkaz:Byte;
  84. var    s,t:String;
  85. begin
  86.  s:='<A HREF="';
  87.  if cesta then s:=s+'http://www-troja.fjfi.cvut.cz/~sokolovs/BIBLE/';
  88.  s:=s+UpCaseString(Prevod(ret,3,4))+'.HTM';
  89.  if kapitola>0 then s:=s+'#'+Str(kapitola);
  90.  if vers>0 then s:=s+':'+Str(vers);
  91.  t:=ret;
  92.  if (kapitola>0) then t:=t+' '+Str(kapitola);
  93.  if (vers>0) then t:=t+','+Str(vers);
  94.  s:=s+'">'+t+'</A>';
  95.  Write(g,s);ZapisOdkaz:=Length(t);
  96. end;
  97.  
  98. function ZapisOdkaz2:Byte;
  99. var    s,t:String;
  100. begin
  101.  s:='<A HREF="';
  102.  if cesta then s:=s+'http://www-troja.fjfi.cvut.cz/~sokolovs/BIBLE/';
  103.  s:=s+UpCaseString(Prevod(ret,3,4))+'.HTM';
  104.  if kapitola>0 then s:=s+'#'+Str(kapitola);
  105.  if vers>0 then s:=s+':'+Str(vers);
  106.  t:=Str(vers);s:=s+'">'+t+'</A>';
  107.  Write(g,s);ZapisOdkaz2:=Length(t);
  108. end;
  109.  
  110. function Zapis2(do0:Integer;odkaz:Byte):Integer;
  111. var    i,od0:Integer;
  112. begin od0:=od;
  113.  if od0<=do0 then begin Zapis(g,pole[od0],do0-od0+1);Zapis2:=do0+1;end
  114.  else begin
  115.   for i:=do0-40 to od0+5 do Write(pole[i]);Cekej;
  116.   Hlaseni('Zapis2 volána s parametry '+Str(od0)+','+Str(do0));Zapis2:=-1;
  117.  end;
  118.  if odkaz=1 then Inc(od,do0-od0+1+ZapisOdkaz);
  119.  if odkaz=2 then Inc(od,do0-od0+1+ZapisOdkaz2);
  120. end;
  121.  
  122. function JeToNazev(co:String):String;
  123. begin
  124.   co:=Prevod(co,3,4);JeToNazev:='';
  125.   if (co='Genesis') or (co='1.Mojzisova') then JeToNazev:='Gn';
  126.   if (co='Exodus') or (co='2.Mojzisova') then JeToNazev:='Ex';
  127.   if (co='Levitikus') or (co='3.Mojzisova') then JeToNazev:='Lv';
  128.   if (co='Numeri') or (co='4.Mojzisova') then JeToNazev:='Nu';
  129.   if (co='Deuteromium') or (co='5.Mojzisova') then JeToNazev:='Dt';
  130.   if co='Jozue' then JeToNazev:='Joz';
  131.   if co='Soudci' then JeToNazev:='Sd';
  132.   if co='Rut' then JeToNazev:='Rt';
  133.   if co='1.Samuelova' then JeToNazev:='1Sa';
  134.   if co='2.Samuelova' then JeToNazev:='2Sa';
  135.   if co='1.Kralovska' then JeToNazev:='1Kr';
  136.   if co='2.Kralovska' then JeToNazev:='2Kr';
  137.   if co='1.Paralipomenon' then JeToNazev:='1Pa';
  138.   if co='2.Paralipomenon' then JeToNazev:='2Pa';
  139.   if co='Ezdras' then JeToNazev:='Ezd';
  140.   if co='Nehemias' then JeToNazev:='Neh';
  141.   if co='Ester' then JeToNazev:='Est';
  142.   if co='Job' then JeToNazev:='Jb';
  143.   if co='Zalm' then JeToNazev:='Z';
  144.   if co='Prislovi' then JeToNazev:='Pr';
  145.   if co='Kazatel' then JeToNazev:='Kaz';
  146.   if co='Pisen' then JeToNazev:='Pis';
  147.   if co='Izaias' then JeToNazev:='Iz';
  148.   if co='Jeremias' then JeToNazev:='Jr';
  149.   if co='Plac' then JeToNazev:='Pl';
  150.   if co='Ezechiel' then JeToNazev:='Ez';
  151.   if co='Daniel' then JeToNazev:='Da';
  152.   if co='Ozeas' then JeToNazev:='Oz';
  153.   if co='Joel' then JeToNazev:='Jl';
  154.   if co='Amos' then JeToNazev:='Am';
  155.   if co='Abdias' then JeToNazev:='Abd';
  156.   if co='Jonas' then JeToNazev:='Jon';
  157.   if co='Micheas' then JeToNazev:='Mi';
  158.   if co='Nahum' then JeToNazev:='Na';
  159.   if co='Abakuk' then JeToNazev:='Abk';
  160.   if co='Sofonias' then JeToNazev:='Sf';
  161.   if co='Aggeus' then JeToNazev:='Ag';
  162.   if co='Zacharias' then JeToNazev:='Za';
  163.   if co='Malachias' then JeToNazev:='Mal';
  164.   if co='Matous' then JeToNazev:='Mt';
  165.   if co='Marek' then JeToNazev:='Mk';
  166.   if co='Lukas' then JeToNazev:='Lk';
  167.   if co='Jan' then JeToNazev:='J';
  168.   if co='Skutky' then JeToNazev:='Sk';
  169.   if co='Rimanum' then JeToNazev:='R';
  170.   if co='1.Korintskym' then JeToNazev:='1K';
  171.   if co='2.Korinrskym' then JeToNazev:='2K';
  172.   if co='Galatskym' then JeToNazev:='Gal';
  173.   if co='Efezskym' then JeToNazev:='Ef';
  174.   if co='Filipenskym' then JeToNazev:='Fp';
  175.   if co='Kolossenskym' then JeToNazev:='Ko';
  176.   if co='1.Tesalonickym' then JeToNazev:='1Te';
  177.   if co='2.Tesalonickym' then JeToNazev:='2Te';
  178.   if co='1.Timoteovi' then JeToNazev:='1Tm';
  179.   if co='2.Timoteovi' then JeToNazev:='2Tm';
  180.   if co='Titovi' then JeToNazev:='Tt';
  181.   if co='Filemonovi' then JeToNazev:='Fm';
  182.   if co='Zidum' then JeToNazev:='Zd';
  183.   if co='Jakub' then JeToNazev:='Jk';
  184.   if co='1.Petra' then JeToNazev:='1Pt';
  185.   if co='2.Petra' then JeToNazev:='2Pt';
  186.   if co='1.Jan' then JeToNazev:='1J';
  187.   if co='2.Jan' then JeToNazev:='2J';
  188.   if co='3.Jan' then JeToNazev:='3J';
  189.   if co='Juda' then JeToNazev:='Jud';
  190.   if co='Zjeveni' then JeToNazev:='Zj';
  191.   if co='Tobias' then JeToNazev:='Tob';
  192.   if co='Judit' then JeToNazev:='Judit';
  193.   if co='Moudrosti' then JeToNazev:='Mdr';
  194.   if co='Sicharovec' then JeToNazev:='Si';
  195.   if co='Baruk' then JeToNazev:='Bar';
  196.   if co='1.Makabejska' then JeToNazev:='1Mak';
  197.   if co='2.Makabejska' then JeToNazev:='2Mak';
  198. end;
  199.  
  200.  
  201.  
  202. {Inicializaçní çást jednotky ODKAZ.PAS:}
  203. begin
  204.  zkratky[0]:=' Abd Abk Ag Am Bar Daniel Da Dt Ef Ester Est Ex Ezd Ez Fp Fm Gal Gn Iz Jk J Jb Jl Jon Joz Jr Judit Jud ';
  205.  zkratky[1]:=' Kaz Ko Lk Lv Mal Mk Mt Mdr Mi Na Neh Nu Oz Pis Pl Pr Rt R Sd Sf Si Sk Tt Tob Za Zd Zj Z ';
  206.  zkratky[2]:=' 1J 1K 1Kr 1Mak 1Pa 1Pt 1S 1Te 1Tm 2J 2K 2Kr 2Mak 2Pa 2Pt 2S 2Te 2Tm 3Jan ';
  207.  uk1:=1;uk2:=-1;od:=1;Vypni_Zvuk;stav:=Vypnuta;
  208. end.
  209.