Строки, Подсчитать.... Опции

[Rom1k]

Строка символов представляет собой предложение,написанное на русском языке.Предложение имеет длину не более 100 символов и заканчивается точкой.Подсчитать количество различных букв,которые входят в это предложение.

Вот есть подобная задача.только с повторением слов.Что там надо исправить,чтобы всё работало?

помогите.Со строками у меня проблемы(

program k_3;
var
 a:array [1..20] of string;{массив слов}
 b:array [1..20] of byte;{Массив счетчиков появления слов}
 r,i,j,k:byte;
 st,st1:string;
Begin
 WriteLn('Введите строку слов');
 ReadLn(st);
 k:=0;{индекс для перемещения по массиву слов и массиву счётчиков}
 r:=1;
 while r<= length(st) do
  begin
   while(st[r]='') and (i<=length(st)) do
    r:=r+1;
   j:=r; {Левая граница слова}
   while (st[r]<>'') and (r<=length(st)) do
    r:=r+1; {Правая граница слова}
    st1:=copy(st,j,r-j);

   {Поиск слова в массиве слов - а}
   i:=1;
   while (i<=20) and (a[i]<>st1) do
    i:=i+1;

   {Анализируем значение индекса i}
   if i>20 then
    begin
     k:=k+1;
     b[k]:=b[k]+1;
     a[k]:=st1;
    end
   else
    b[i]:=b[i]+1;
  end;
 WriteLn('В массиве (а) ',k,' различных слов ');
 writeln('Частота появления каждого слова  ');
 for i:=1 to k do
  writeln(a[i],'    ',b[i]);
END.

[Rom1k]

Вот код программы...Почему-то не учитывается большая или маленькая буква.Выводит всё также,хотя вроде бы и все правильно сделал!

Program kur_3;
uses crt;
var
 al:set of char;
 i: integer;
 st:string;
 c:char;
 b:array [char] of byte;

function UpCase(Ch:Char):Char;
begin
 case Ch of
  'а'..'п':UpCase:=Chr(ord('А')+ord(Ch)-ord('а'));
  'р'..'я':UpCase:=Chr(ord('Р')+ord(Ch)-ord('р'));
  'А'..'Я':UpCase:=Chr(ord('А')+ord(Ch)-ord('а'));
 else
  UpCase:=Ch;
 end;
end;

Begin
 fillchar (b,sizeof (b),0);
 WriteLn('Введите строку слов,признак окончания-точка.');
  ReadLn(st);
 i:=1;
 al:=['а' .. 'п', 'р' .. 'я', 'А' .. 'Я'];
 repeat
   if (st[i] in al) then
    inc(b[st[i]]);
    inc(i);
    st[i]:=UpCase(st[i]);
 until(i>length(st)) or (st[i]='.');
 for c:=#0 to #255 do
  if b[c]>0 then
   writeln (c,'-',b[c]);
End.