home *** CD-ROM | disk | FTP | other *** search
/ Chip 1999 September / Chip_1999-09_cd.bin / internet / Jeremy / tp / ulohy / 09.pr < prev    next >
Encoding:
Text File  |  1999-08-03  |  1.4 KB  |  59 lines
  1. Reseni ulohy c. 9 (27.07.98)
  2. ============================
  3.  
  4. Program Cetnost_znaku;
  5.  
  6. var soubor: string; {cteny soubor}
  7.     a: char;        {znak, jehoz vyskyt se bude pocitat}
  8.     abs_c: LongInt; {pocet vyskytu znaku v souboru}
  9.     rel_c: real;    {procentualni zastoupeni znaku v souboru}
  10.  
  11. function Cetnost(soubor: string; znak: char; var abs_cetnost: LongInt; 
  12.                  var rel_cetnost: real): boolean;
  13.  
  14.  {funkce vezme soubor, ten otevre, provede spocitani vyskytu znak a vysledky
  15.  vypoctu vrati do promennych abs_cetnost a rel_cetnost a funkce nakonec vraci
  16.  TRUE - probehlo-li vse OK, jinak vrati FALSE}
  17.  
  18.  var t: text;
  19.     p: char;
  20.     celkem: LongInt;
  21.  
  22.  begin {zacatek funkce}
  23.     celkem:=0;
  24.     abs_cetnost:=0;
  25.     assign(t,soubor);
  26.     {$I-}
  27.     reset(t);
  28.     {$I+}
  29.     if IOResult<>0 then Cetnost:=FALSE else
  30.      begin
  31.         while not eof(t) do
  32.          begin
  33.             while not eoln(t) do
  34.              begin
  35.                 read(t,p);
  36.                 inc(celkem);
  37.                 if p=znak then inc(abs_cetnost);
  38.              end;
  39.             readln(t);
  40.          end;            
  41.         rel_cetnost:=(abs_cetnost/celkem)*100;
  42.         Cetnost:=TRUE;
  43.         Close(t);
  44.      end;
  45.  end; {konec funkce Cetnost}
  46.     
  47.  
  48. BEGIN {zacatek programu}
  49.  
  50.     write(' Zadejte nazev textoveho souboru: '); readln(soubor);
  51.     write(' Zadejte znak: '); readln(a);
  52.  
  53.     if Cetnost(soubor,a,abs_c,rel_c) then
  54.      writeln(' Pismeno: ',a,' pocet vyskytu: ',abs_c,
  55.                  ' procentualne: ',rel_c:5:2)
  56.     else writeln(' Chyba pri cteni souboru! ');
  57.  
  58. END.
  59.