поиск слов в тексте

procedure TForm1.Button1Click(Sender: TObject);
const
  //Разделители слов.
  D = ['.', ',', ':', ';', '!', '?', '-', ' ', #9, #10, #13];
var
  S : String;
  i, Pos1, Len : Integer;
begin
  Memo2.Clear;
  S := Memo1.Text;
 
  Len := Length(S);
  Pos1 := 0;
  for i := 1 to Len do begin
    //Пропускаем разделители.
    if S[i] in D then Continue;
    //Отслеживаем начало слова.
    if (i = 1) or (S[i - 1] in D) then Pos1 := i;
    //Отслеживаем конец слова.
    if (i = Len) or (S[i + 1] in D) then begin
      //Добавляем слово в Мемо2.
      Memo2.Lines.Add( Copy(S, Pos1, i - Pos1 + 1) );
    end;
  end;
end;

unit Unit1;
 
interface
 
uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls;
 
type
  TForm1 = class(TForm)
    Memo1: TMemo;
    OpenDialog1: TOpenDialog;
    SaveDialog1: TSaveDialog;
    FontDialog1: TFontDialog;
    Button1: TButton;
    Button2: TButton;
    Button3: TButton;
    Button4: TButton;
    procedure Button1Click(Sender: TObject);
    procedure Button3Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    private
    { Private declarations }
     TotalStr, Res: string;
    List: TStringList;
  public
    { Public declarations }
  end;
 
var
  Form1: TForm1;
  f: textfile; s:string;
   M: Array [1..10000] of string;
 i,j,k1,k2,q1,q2: integer;
w,h:integer;
implementation
 
{$R *.dfm}
 
procedure TForm1.Button1Click(Sender: TObject);
begin
opendialog1.Execute;
AssignFile(f,Opendialog1.FileName);
Reset(f);
Memo1.Lines.Clear;
while not Eof(f) do
begin
  Readln(f,s);
  Memo1.Lines.add(s)
end;
closeFile(f);
end;
 
 
procedure TForm1.Button3Click(Sender: TObject);
begin
if fontdialog1.Execute then
memo1.font:=fontdialog1.Font;
end;
 
 
procedure TForm1.Button2Click(Sender: TObject);
begin
 Memo1.Lines.SaveToFile(OpenDialog1.FileName)
end;
 
end.

type
  //Сведения о слове.
  TWord = record
    //Само слово.
    SWord : String;
    //Количество обнаружений слова в тексте.
    Cnt : Integer;
  end;
  //Хранилище уникальных слов.
  TVault = record
    //Количество слов в хранилище. - Количество значимых элементов массива.
    Len : Integer;
    //Массив сведений о словах. Длина этого массива,
    //может быть большей или равной Len.
    Arr : array of TWord;
  end;
 
//Добавляет слово в массив хранилища Vault. При этом, если добавляемое
//слово уже присутствует в массиве, тогда счётчик этого слова увеличивается
//на единицу. Если добавляемое слово пока не присутствует в массиве, тогда
//это слово записывается в массив и его счётчик устанавливается равным единице.
procedure AddToVault(var aVault : TVault; const aWord : String);
const
  //Величина приращения длины массива.
  Capacity = 20;
var
  i : Integer;
begin
  with aVault do begin
    //Просматриваем массив - проверяем,
    //есть ли уже в нём такое слово.
    i := 0;
    while i < Len do begin
      //Если такое же слово найдено, то увеличиваем
      //его счётчик на единицу и выходим из цикла.
      if Arr[i].SWord = aWord then begin
        Inc( Arr[i].Cnt );
        Break;
      end;
      Inc(i);
    end;
    //Если в предыдущем цикле слово не найдено, то при выходе
    //из цикла будем иметь равенство i = Len. В этом случае
    //добавляем слово в массив и устанавливаем счётчик этого
    //слова равным единице. Индекс добавляемого слова,
    //равен i.
    if i = Len then begin
      //Если количество значимых элементов массива в настоящий момент
      //равно длине массива, это означает, что в массиве нет места
      //для добавления нового элемента. Поэтому, в этом случае,
      //наращиваем длину массива. Длину массива увеличиваем
      //на велечину Capacity.
      if Len = Length(Arr) then
        SetLength(Arr, Len + Capacity)
      ;
      //Так как мы добавляем в массив новое слово, то количество значимых
      //элементов массива становится на единицу больше.
      Inc(Len);
      //Записываем в массив данные нового элемента (слова).
      Arr[i].SWord := aWord;
      Arr[i].Cnt := 1;
    end;
  end;
end;
 
procedure TForm1.Button1Click(Sender: TObject);
const
  //Разделители слов.
  D = ['.', ',', ':', ';', '!', '?', '-', ' ', #9, #10, #13];
var
  S : String;
  i, Pos1, Len, CntMax : Integer;
  Vault : TVault;
begin
  Memo2.Clear;
  S := Memo1.Text;
  Vault.Len := 0;
 
  //Извлекаем слова и добавляем их в хранилище Vault.
  //Добавление слов в хранилище Vault производится через процедуру AddToVault().
  //Эта процедура спроектирована так, что при записи формируется массив
  //уникальных слов со сведениями о количестве обнаружений каждого слова.
  Len := Length(S);
  Pos1 := 0;
  for i := 1 to Len do begin
    //Пропускаем разделители.
    if S[i] in D then Continue;
    //Отслеживаем начало слова.
    if (i = 1) or (S[i - 1] in D) then Pos1 := i;
    //Отслеживаем конец слова.
    if (i = Len) or (S[i + 1] in D) then begin
      //Добавляем слово в массив.
      AddToVault( Vault, Copy(S, Pos1, i - Pos1 + 1) );
    end;
  end;
  //Определяем наибольшую частоту присутствий.
  CntMax := 0;
  for i := 0 to Vault.Len - 1 do
    if Vault.Arr[i].Cnt > CntMax then
      CntMax := Vault.Arr[i].Cnt
  ;
  Memo2.Lines.Add('Наибольшее число присутствий: ' + IntToStr(CntMax));
  //Перечень слов с наибольшим числом присутствий.
  Memo2.Lines.Add('Перечень слов с наибольшим числом присутствий:');
  for i := 0 to Vault.Len - 1 do
    if Vault.Arr[i].Cnt = CntMax then
      Memo2.Lines.Add(Vault.Arr[i].SWord)
  ;
  //Удаляем из памяти массив слов.
  Finalize(Vault.Arr);
  Vault.Len := 0;
end;