Определить в строке количество слов, начинающихся с заданной буквы

(*Подсчитывает количество слов в тексте aStr.*)
function GetWordCount(const aStr : String) : Integer;
const
  (*Множество разделителей слов.*)
  D = [' ', '.', ',', ':', ';', '!', '?', '-', Char(9), Char(10), Char(13)];
var
  (*i - индекс символов в строке.
  Pos2 = 0 - конец слова не найден, Pos2 > 0 - найден конец слова.
  Cnt - счётчик слов.*)
  i, Pos2, Cnt : Integer;
begin
  (*Перебор всех символов строки.*)
  Pos2 := 0;
  Cnt := 0;
  for i := 1 to Length(aStr) do begin
    (*Пропускаем разделители.*)
    if aStr[i] in D then Continue;
    (*Отслеживаем конец слова.*)
    if i = Length(aStr) then
      Pos2 := i
    else if aStr[i + 1] in D then
      Pos2 := i
    ;
    (*Если конец слова найден, производим подсчёт.*)
    if Pos2 > 0 then begin
      Inc(Cnt);
      Pos2 := 0;
    end;
  end;
 
  GetWordCount := Cnt;
end;

(*Выделение слов из текста aStr и подсчёт слов по результатам их анализа.*)
function GetWordCountA(const aStr : String) : Integer;
const
  (*Множество разделителей слов.*)
  D = [' ', '.', ',', ':', ';', '!', '?', '-', Char(9), Char(10), Char(13)];
var
  (*i - индекс символов в строке.
  Pos1, Pos2 - координаты отдельного слова.
  Cnt - счётчик слов.*)
  i, Pos1, Pos2, Cnt : Integer;
  (*Отдельное слово, выделенное из текста.*)
  StrWord : String;
begin
  (*Перебор всех символов строки.*)
  Pos1 := 0;
  Pos2 := 0;
  Cnt := 0;
  for i := 1 to Length(aStr) do begin
    (*Пропускаем разделители.*)
    if aStr[i] in D then Continue;
    (*Отслеживаем начало слова.*)
    if i = 1 then
      Pos1 := i
    else if aStr[i - 1] in D then
      Pos1 := i
    ;
    (*Отслеживаем конец слова.*)
    if i = Length(aStr) then
      Pos2 := i
    else if aStr[i + 1] in D then
      Pos2 := i
    ;
    (*Если конец слова найден, производим анализ и подсчёт.*)
    if Pos2 > 0 then begin
      StrWord := Copy(aStr, Pos1, Pos2 - Pos1 + 1);
 
      (*В данный момент в переменной StrWord записано очередное слово, выделенное
      из текста. Теперь это слово можно проанализировать и произвести с ним
      какие-то действия - например, подсчитать его или отказаться от подсчёта.*)
 
      (*Анализ и подсчёт. Начало.*)
 
      (*...*)
 
      (*
      Inc(Cnt);
      *)
 
      (*...*)
 
      (*Анализ и подсчёт. Конец.*)
 
      Pos2 := 0;
    end;
  end;
 
  GetWordCountA := Cnt;
end;

program Project1;
 
(*Функция возвращает заглавный вариант буквы. Если символ не является буквой,
то вернёт этот же символ без изменений.
Эта функция правильно обрабатывает буквы кириллицы и латиницы согласно
кодовой странице CP866.*)
function UpperRu(const aCh : Char) : Char;
begin
  case aCh of
    (*Буквы кириллицы:*)
 
    (*Буквы: "а".."п" -> "А".."П". Кроме буквы "ё".*)
    #$A0..#$AF : UpperRu := Char( Ord(aCh) - $20 );
    (*Буквы: "р".."я" -> "Р".."Я".*)
    #$E0..#$EF : UpperRu := Char( Ord(aCh) - $50 );
    (*Буква: "ё" -> "Ё".*)
    #$F1 : UpperRu := #$F0;
 
    (*Буквы латиницы:*)
 
    (*Буквы: "a".."z" -> "A".."Z".*)
    #$61..#$7A : UpperRu := Char( Ord(aCh) - $20 );
 
    (*Символы, которые не являются буквами не изменяем.*)
    else UpperRu := aCh;
  end;
end;
 
const
  (*Имя входного файла.*)
  Fn = 'file.txt';
  (*Максимальная длина обрабатываемого текста.*)
  N = 10000;
  (*Разделители предложений.*)
  DmOffer = ['.', '!', '?'];
  (*Разделители слов.*)
  DmWord = DmOffer + [' ', ',', ':', ';', #9, #10, #13];
var
  (*Файловая переменная для связи с входным файлом.*)
  F : file;
  (*Массив, содержащий текст.*)
  Arr : array[1..N] of Char;
  (*i - индекс символов в тексте,
  Size - количество символов в тексте,
  CntW - количество слов в отдельном предложении,
  CntWMin - наименьшее количество слов в отдельных предложениях,
  CntWMax - наибольшее количество слов в отдельных предложениях,
  CntWL - количество слов по всему тексту, начинающихся на заданную букву.*)
  i, Size, CntW, CntWMin, CntWMax, CntWL : Integer;
  (*Координаты:
  Po2 - конец предложения;
  Pw1, Pw2 - начало и конец слова*)
  Po2, Pw1, Pw2 : Integer;
  (*Символ, заданный пользователем.*)
  Lett : Char;
  (*Флаг, показывающий является ли данное предложение первым в тексте.*)
  IsFirstOffer : Boolean;
begin
  (*Читаем из входного файла исходный текст. Для удобства чтения, входной
  файл объявлен, как нетипизированный файл.*)
 
  (*Связываем файловую переменную с именем файла.*)
  Assign(F, Fn);
  {$I-}
  (*Открываем файл в режиме чтения блоками кратными одному байту.*)
  Reset(F, 1);
  {$I-}
  (*Если на этапе открытия файла произошли ошибки, прерываем программу.*)
  if IOResult <> 0 then begin
    Writeln('Входной файл с именем "', Fn, '" не удалось открыть.');
    Writeln('Возможно этот файл не существует. Программа прервана.');
    Readln;
    Exit;
  end;
 
  Writeln('Задайте букву:');
  Readln(Lett);
  Lett := UpperRu(Lett);
  Writeln('При проверке первых букв в словах регистр не будет учитываться.');
 
  (*Читаем в массив Arr данные из файла. В переменную Size будет записано
  реальное количество прочитанных байт. Если файл окажется меньшим или равным
  размеру массива, то Size будет равен размеру файла. Если файл больше размера
  массива, тогда Size будет равен N - т. е. равен длине массива Arr.
  Для передачи длины массива применим функцию High(Arr), которая возвращает верхнее
  значение индекса. Т. к. индекс у нас отсчитывается от 1, то High(Arr) будет равен
  длине массива.*)
  BlockRead(F, Arr, High(Arr), Size);
  (*Закрываем входной файл.*)
  Close(F);
 
  (*Обрабатываем текст, прочитанный из файла.*)
 
  CntW := 0;
  CntWMin := 0;
  CntWMax := 0;
  CntWL := 0;
  IsFirstOffer := True;
  Pw1 := 0;
  Pw2 := 0;
  Po2 := 0;
  for i := 1 to Size do begin
    (*Отслеживаем конец предложения.*)
    if i = Length(Arr) then
      Po2 := i
    else if Arr[i] in DmOffer then
      Po2 := i
    ;
    (*Если текущий символ не является разделителем.*)
    if not ( Arr[i] in DmWord ) then begin
      (*Отслеживаем начало слова.*)
      if i = 1 then
        Pw1 := i
      else if Arr[i - 1] in DmWord then
        Pw1 := i
      ;
      (*Отслеживаем конец слова.*)
      if i = Length(Arr) then
        Pw2 := i
      else if Arr[i + 1] in DmWord then
        Pw2 := i
      ;
    end;
 
    (*Если найден конец слова.*)
    if Pw2 > 0 then begin
      (*Подсчёт количества слов, начинающихся с заданной буквы.*)
      if UpperRu( Arr[Pw1] ) = Lett then Inc(CntWL);
      (*Подсчёт количества слов в текущем предложении.*)
      Inc(CntW);
      (*Сброс координаты конца слова.*)
      Pw2 := 0;
    end;
 
    (*Если найден конец предложения.*)
    if Po2 > 0 then begin
      (*Уточняем сведения по мин. и макс. количеству слов в пределах отдельных
      предложений.*)
      if IsFirstOffer then begin
        CntWMin := CntW;
        IsFirstOffer := False;
      end;
      if CntW < CntWMin then CntWMin := CntW;
      if CntW > CntWMax then CntWMax := CntW;
      (*Сброс счётчика слов в пределах предложения.*)
      CntW := 0;
      (*Сброс координаты конца предложения.*)
      Po2 := 0;
    end;
  end;
 
  Writeln('Количество слов в тексте, которые начинаются на заданную букву:');
  Writeln(CntWL);
  Writeln('Наименьшее количество слов в пределах отдельных предложений:');
  Writeln(CntWMin);
  Writeln('Наибольшее количество слов в пределах отдельных предложений:');
  Writeln(CntWMax);
 
  Readln;
end.