Строки в языке Object Pascal - Delphi - Ответ 388944

unit Unit1;
 
interface
 
uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls;
 
type
  TForm1 = class(TForm)
    Edit1: TEdit;
    Button1: TButton;
    Edit2: TEdit;
    procedure Button1Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;
 
 
var
  Form1: TForm1;
 
implementation
 
{$R *.dfm}
 
//Находит в тексте слово с максимальным количеством букв.
//Затем записывает его по буквам в обратном порядке и возвращает
//полученную строку в качестве результата.
function ProcStr(aStrSrc : String) : String;
type
  TWord = record
    StartPos  : Integer;
    LettCnt   : Integer;
  end;
 
  TArrWord = array of TWord;
const
  //Множество разделителей.
  Spl : set of Char = [' ', ',', '.'];
  //Величина приращения длины динамического массива.
  Capacity = 10;
var
  //Переменные, связанные с обработкой букв.
 
  //Индекс символов строки. LettInd := 1..Length(aStrSrc).
  LettInd         : Integer;
  //Последний обработанный символ - символ обработанный на предыдущей итерации цикла.
  LastChar        : Char;
 
  //Переменные, связанные с обработкой слов.
 
  //Массив, содержащий координаты найденных слов.
  ArrWord        : TArrWord;
  //Переменная, хранящая сведения о слове.
  WordTmp        : TWord;
  //Индекс слова в строке. WordInd := 0..X.
  WordInd        : Integer;
  //Индекс слова с максимальным количеством букв.
  WordIndMax     : Integer;
  //Флаг, оказывающий, что текущая буква является последней в слове.
  IsEndWord      : Boolean;
 
  //Индекс букв в строке результата.
  i              : Integer;
begin
  //Инициализируем строку результата.
  Result := '';
 
  //-------------------------
  //Обрабатываем строку и заполняем массив ArrWord сведениями о найденных словах.
  //-------------------------
 
  //Индекс очередного слова.
  WordInd := 0;
  //Индекс очередного символа.
  LettInd := 1;
  //Перебор всех символов в строке.
  while LettInd <= Length(aStrSrc) do begin
    //Если очередной символ является буквой.
    if not (aStrSrc[LettInd] in Spl) then begin
 
      //Отслеживаем начало слова.
      if (LettInd = 1) or ( (LettInd <> 1) and (LastChar in Spl) ) then begin
        //Обнаружено начало слова.
        //Инициализируем переменные.
 
        //Позиция первой буквы слова в строке.
        WordTmp.StartPos := LettInd;
        //Количество букв в слове.
        WordTmp.LettCnt := 0;
      end;
 
      //Подсчёт общего количества букв в слове.
      Inc(WordTmp.LettCnt);
 
      //Отслеживаем конец слова.
      IsEndWord := False;
      if LettInd = Length(aStrSrc) then begin
        //Текущая буква является последним символом в слове.
        IsEndWord := True;
      end else if aStrSrc[LettInd + 1] in Spl then begin
        //Справа от текущей буквы расположена небуква.
        IsEndWord := True;
      end;
 
      if IsEndWord then begin
        //Обнаружен конец слова.
        //Добавляем данные по текущему слову в массив ArrWord.
 
        //Если требуется, увеличиваем длину массива.
        if WordInd = Length(ArrWord) then begin
          SetLength(ArrWord, Length(ArrWord) + Capacity);
        end;
        //Добавляем сведения о слове в массив.
        ArrWord[WordInd] := WordTmp;
        //Готовим индекс слов к следующей итерации.
        Inc(WordInd);
      end;
    end;
 
    //Запоминаем символ, обработанный на этой итерации.
    LastChar := aStrSrc[LettInd];
    //Готовим индекс символа для следующей итерации.
    Inc(LettInd);
  end;
 
  //Если в строке нет ни одного слова - выходим.
  if WordInd = 0 then begin
    Exit;
  end;
 
  //Корректируем длину массива ArrWord в соответствии с количеством добавленных
  //в этот массив слов.
  SetLength(ArrWord, WordInd);
 
  //-------------------------
  //Ищем в массиве ArrWord слово с максимальным количеством букв.
  //-------------------------
 
  for WordInd := 0 to High(ArrWord) do begin
    if WordInd = 0 then begin
      WordIndMax := 0;
    end;
    if ArrWord[WordInd].LettCnt > ArrWord[WordIndMax].LettCnt then begin
      WordIndMax := WordInd;
    end;
  end;
 
  //-------------------------
  //Переписываем в результирующую строку найденное слово по буквам в обратном порядке.
  //-------------------------
 
  with ArrWord[WordIndMax] do begin
    //Выделяем память для результирующей строки. - Чтобы каждый раз при переписывании
    //очередного символа не происходило пересоздания строки.
    SetLength(Result, LettCnt);
    //Переписываем в результирующую строку найденное слово по буквам в обратном порядке.
    i := 0;
    for LettInd := StartPos + LettCnt - 1 downto StartPos do begin
      Inc(i);
      Result[i] := aStrSrc[LettInd];
    end;
  end;
 
  //Освобождаем память, выделенную ранее для массива.
  Finalize(ArrWord);
end;
 
procedure TForm1.Button1Click(Sender: TObject);
begin
  Edit2.Text := ProcStr(Edit1.Text);
end;
 
end.