home *** CD-ROM | disk | FTP | other *** search
/ Chip 1999 September / Chip_1999-09_cd.bin / internet / Jeremy / tp / downloads / sorting.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1999-08-03  |  3.4 KB  |  153 lines
  1. Unit Sorting;
  2. interface
  3.  
  4. function JeMensi(param1,param2: string): boolean;
  5.  
  6. {(-13,50,-12,50,50,50,-12,-12,-13,-13,50,50,-13,-12,-12,50,}
  7.  
  8. implementation
  9. uses outstr;
  10. var ret1,ret2: string;
  11. const z: array [32..169] of integer =
  12.                (-11,50,50,50,50,50,50,50,50,50,50,50,50,50,50,50,
  13.                -10,-9,-8,-7,-6,-5,-4,-3,-2,-1,50,50,50,50,50,50,14,1,3,4,6,
  14.                 8,11,12,13,15,17,18,19,20,21,23,25,26,27,29,31,33,36,37,38,
  15.                 39,41,50,50,50,50,-12,50,50,50,50,50,50,50,50,50,50,50,50,50,
  16.                 50,50,50,50,50,50,50,50,50,50,50,50,50,50,50,50,50,50,50,5,
  17.                 50,50,50,50,7,50,50,50,10,50,16,50,50,50,2,9,50,42,50,50,24,
  18.                 50,33,33,50,50,30,50,40,28,32,50,50,50,50,50,22,33,50,50,0);
  19.  
  20. function FilterCh(S: string): string;
  21. var p: integer;
  22.     W: string;
  23. begin
  24.      W:='';
  25.      W:=UpString(s);
  26.      W[0]:=s[0];
  27.      if DetectString('CH',W) then
  28.      begin
  29.           p:=0;
  30.      repeat
  31.      p:=FindString('CH',W,p);
  32.      if p>0 then
  33.       begin
  34.            delete(W,p,2);
  35.            insert('@',W,p);
  36.       end;
  37.       until DetectString('CH',W)=false;
  38.       end;
  39.       FilterCh:=W;
  40. end;
  41.  
  42. procedure Apostrof(Var S: string);
  43. var I: integer;
  44.     w: string;
  45. begin
  46.      w:='';
  47.      for I:=1 to Length(s) do
  48.       begin
  49.            if (s[i]='''') or (s[i]=' ') or (s[i]='.') or (s[i]=',')
  50.               or (s[i]='-') or (s[i]='"') or (s[i]='!') or (s[i]='?')
  51.                 then else w:=w+s[i];
  52.  
  53.            if (s[i]='.') or (s[i]=',')
  54.             or (s[i]='-') or (s[i]='"') or (s[i]='!') or (s[i]='?')
  55.              then
  56.               begin
  57.                  delete(w,length(w),1);
  58.                  w:=w+#169;
  59.               end
  60.              else
  61.                  if s[i]=' ' then begin delete(w,length(w),1); w:=w+#168; end;
  62.  
  63.       end;
  64.       w[0]:=s[0];
  65.       S:=W;
  66. end;
  67.  
  68. function orl(znak: char): integer;
  69. begin
  70.      orl:=z[ord(znak)];
  71. end;
  72.  
  73. function JeMensi(Param1,Param2: string): boolean;
  74. var w1, w2: string;
  75.     p,I: integer;
  76.     q: integer;
  77.     b: boolean;
  78.  
  79. procedure DoplnMez(Var S: String; pocet: integer);
  80. var I: Integer;
  81. begin
  82.      for I:=Length(S) to pocet-1 do
  83.       begin
  84.            s:=s+' ';
  85.       end;
  86. end;
  87.  
  88. begin
  89.  
  90.      w1:=FilterCh(Param1);
  91.      w2:=FilterCh(Param2);
  92. {     Apostrof(w1);
  93.      Apostrof(w2); }
  94.  
  95.      if Length(param1)>Length(param2) then P:=Length(param2)
  96.          else p:=Length(param1);
  97.  
  98.      i:=1;
  99.  
  100.      repeat
  101.            if orl(w1[i])<>orl(w2[i]) then
  102.             begin
  103.                  if orl(w1[i])<orl(w2[i]) then
  104.                  begin
  105.                       JeMensi:=true;
  106.                       exit;
  107.                  end
  108.                  else begin JeMensi:=false; exit; end;
  109.                  inc(i);
  110.             end
  111.             else inc(i);
  112.  
  113.      until (orl(w1[i-1])<>orl(w2[i-1])) or (i=p);
  114.  
  115.  
  116.      b:=true;
  117.  
  118.      for Q:=1 to p do
  119.       begin
  120.            b:=b and (orl(w1[q])=orl(w2[q]));
  121.       end;
  122.  
  123.      if b then
  124.       begin
  125.            if length(param1)<length(param2) then JeMensi:=true else
  126.             JeMensi:=false;
  127.       end;
  128. end;
  129.  
  130. begin
  131.      ret1:='';
  132.      ret2:='';
  133. end.
  134.  
  135. (*
  136.  
  137. BEGIN
  138.      repeat
  139.  
  140.      writeln(' Zadej retezec 1: ');
  141.      readln(ret1);
  142.  
  143.      writeln(' Zadej retezec 2: ');
  144.      readln(ret2);
  145.  
  146.      writeln(FilterCh(ret1));
  147.      writeln(FilterCh(ret2));
  148.  
  149.      Writeln(JeMensi(ret1,ret2));
  150.  
  151.      until ret2='konec';
  152. END.
  153. *)