Найдите хотя бы одно слово, которое встречается в каждом из трёх предложений.

if Pos(Cлово, Строка) > 0 then ... // слово в строке есть

Слово:= Copy(Предложение, 1, Pos(Разделитель, Предложение)-1);

program Project1;
 
{$APPTYPE CONSOLE}
 
uses
  SysUtils,
  Windows;
 
const
  //Максимальное количество различающихся слов во всех строках.
  M = 15;
  //Количество строк.
  N = 3;
 
type
  //Тип, описывающий структуру для хранения множества слов.
  TVault = record
    //Количество слов.
    Len : Integer;
    //Массив слов.
    Arr : array[1..M] of String;
  end;
 
//Добавление слова в хранилище.
//В хранилище записываются только уникальные слова.
//Т. е., если слово уже присутствует в хранилище - такое слово не добавляется.
procedure AddToVault(var aVault : TVault; aSWord : String);
var
  i : Integer;
  IsFound : Boolean;
begin
  //Проверка - есть ли слово в хранилище.
  IsFound := False;
  for i := 1 to aVault.Len do begin
    if aVault.Arr[i] = AnsiUpperCase(aSWord) then begin
      IsFound := True;
      Break;
    end;
  end;
  //Если слова нет - добавляем его.
  if not IsFound then begin
    Inc(aVault.Len);
    aVault.Arr[aVault.Len] := aSWord;
  end;
end;
 
//Выделение слов из строки и запись их в хранилище.
//Т. е., формирование множества слов, присутствующих в тексте aStr.
procedure FillVault(const aStr : String; var aVault : TVault);
const
  //Множество разделителей слов.
  D = [' ', '.', ',', ':', ';', '!', '?', '-', #9, #10, #13];
var
  sWord : String;
  i, Len, Pos1 : Integer;
begin
  aVault.Len := 0;
  Len := Length(aStr);
  Pos1 := 0;
  for i := 1 to Len do begin
    //Пропускаем разделители.
    if aStr[i] in D then Continue;
    //Отслеживаем начало слова.
    if (i = 1) or (aStr[i - 1] in D) then Pos1 := i;
    //Отслеживаем конец слова.
    if (i = Len) or (aStr[i + 1] in D) then begin
      sWord := Copy(aStr, Pos1, i - Pos1 + 1);
      AddToVault(aVault, sWord);
    end;
  end;
end;
 
//Обнаружение слов, которые присутствуют в обоих хранилищах.
//Здесь определяется пересечение двух множеств aVault1 и aVaultRes.
//Результирующее множество слов перезаписывает содержимое aVaultRes.
procedure IntersectVault(const aVault1 : TVault; var aVaultRes : TVault);
var
  i, j, k : Integer;
begin
  k := 0;
  for i := 1 to aVaultRes.Len do
  for j := 1 to aVault1.Len do begin
    if aVaultRes.Arr[i] = aVault1.Arr[j] then begin
      Inc(k);
      aVaultRes.Arr[k] := aVaultRes.Arr[i];
      Break;
    end;
  end;
  aVaultRes.Len := k;
end;
 
var
  ArrS : array[1..N] of String;
  S : String;
  Vault1, VaultRes : TVault;
  i : Integer;
  Res : Boolean;
begin
  //Переключение окна консоли на кодовую страницу CP1251 (Win-1251).
  //Если после переключения русские буквы показываются неверно,
  //следует открыть системное меню консольного окна - щелчком мыши в левом
  //верхнем углу окна консоли и выбрать:
  //Свойства - закладка "Шрифт" - выбрать шрифт: "Lucida Console".
  SetConsoleCP(1251);
  SetConsoleOutputCP(1251);
 
  repeat
    Writeln('Задайте ', N, ' строк:');
    i := 0;
    repeat
      Inc(i);
      Writeln('Строка № ', i, ':');
      Readln(ArrS[i]);
    until i = N;
 
    //Проверяем, есть ли слова, которые присутствуют во всех строках.
    Res := True;
    //Составляем множество слов из первой строки.
    FillVault(ArrS[1], VaultRes);
    for i := 2 to N do begin
      //Составляем множество слов из очередной строки.
      FillVault(ArrS[i], Vault1);
      //Определяем пересечение множеств.
      IntersectVault(Vault1, VaultRes);
      //Если пересечением множеств является пустое множество, значит
      //нет ни одного слова, которое бы присутствовало во всех строках.
      if VaultRes.Len = 0 then begin
        Res := False;
        Break;
      end;
    end;
 
    //Ответ.
    if Res then begin
      Writeln('Есть слова, которые присутствуют во всех строках.');
      Writeln('Перечень таких слов:');
      for i := 1 to VaultRes.Len do begin
        if i > 1 then Write(', ');
        Write(VaultRes.Arr[i]);
      end;
      Writeln;
    end else begin
      Writeln('Нет ни одного слова, которое присутствовало бы во всех строках.');
    end;
 
    Writeln('Повторить - Enter. Выход - любой символ + Enter.');
    Readln(S);
  until S <> '';
end.

procedure TForm1.Button1Click(Sender: TObject);
var
  i,j,k,N:Integer;
  str:string;
  Word:array of string;
  StrList:TStringList;
const
  D:array [0..7] of Char =(' ', '.', ',', ':', ';', '!', '?', '-');
 
 // процедура удаления в полученном столбце слов знаков, совпадающих с содержимым массива D
procedure Delimiter_D(StrList:TStringList);
var
  i:Integer;
begin
 for i:=0 to High(D) do
 begin
 StrList.Delimiter:=D[i];
 StrList.DelimitedText:= StrList.Text;
 end;
end;
 
begin
StrList:=TStringList.Create;
//берем первое предложение и разбиваем его на слова (в столбец)
StrList.DelimitedText:=Memo1.Lines.Strings[0];
Delimiter_D(StrList);
 //создаем массив  искомых слов и заполняем его
 SetLength(Word,StrList.Count);
for i:=0 to  StrList.Count-1 do Word[i]:=StrList.Strings[i];
 
// Теперь проверяем, есть ли такие слова(из первого предложения) в других предложениях
 for i:=0 to High(Word)-1 do // перебираем искомые слова
  begin
    N:=1;
    for j:=1 to Memo1.Lines.Count-1 do // выбираем предложения, начиная со второго
    Begin
     StrList.DelimitedText:=Memo1.Lines.Strings[j];
     Delimiter_D(StrList);
      for k:=0 to StrList.Count-1 do
       if StrList.Strings[k]=Word[i] then
       begin
        Inc(N);
        Break;
       end;
 
     if Memo1.Lines.Count=N then
     begin
      if Pos(Word[i],Str)=0 then Str:=Str+'  '+Word[i];// Pos(Word[i],Str)=0 на случай повторов слов в 1-м предложении
      N:=1;
     end;
    end;
  end;
 // выводим результат
 Label1.Caption:='Совпадают слова:  '+str;
 StrList.Free;
end;