Задача на строки Опции

[shizik]

Условие:Найти в тексте слова, содержащие не более одной буквы, не входящей ни в последующее, ни в предыдущее слово, записать их заглавными буквами и указать после каждого такого слова в скобках найденную букву.
по большому счету нужна вот эта часть: Найти в тексте слова, содержащие не более одной буквы, не входящей ни в последующее, ни в предыдущее слово, -

[Lapp]

Нарушая протокол и регламент этого раздела, публикую решение открыто. Считаю, что скрывать нет смысла, поскольку тема есть и в Задачах.
Shizik, пожалуйста, заплати на счет форума (см. Счета форума ) 3 WMZ или 80 WMR. Рассчитываю на твою порядочность. Если будут дальнейшие вопросы по решению - задавай их в той теме, которая в Задачах. Спасибо.

type
  Chars=set of char;

var
  s1,s2,s3,m:Chars;
  w2,w3:string;
  s:string;
  i:integer;

const
  Delimeters:Chars=[' '];
  Letters:Chars=['A'..'Z','a'..'z'];

function GetWord(s:string; var i:integer):string;
var
  j:integer;
begin
  while i<Length(s) do if s[i] in Delimeters then Inc(i) else break;
  j:=i;
  while j<=Length(s) do if not (s[j] in Delimeters) then Inc(j) else break;
  GetWord:=Copy(s,i,j-i);
  i:=j
end;

function GetChars(s:string):Chars;
var
  Se:Chars;
  i:integer;
begin
  Se:=[];
  for i:=1 to Length(s) do Include(Se,s[i]);
  GetChars:=Se
end;

function Quantity(s:Chars):integer;
var
  i:integer;
  c:char;
begin
  i:=0;
  for c:=#0 to #255 do if c in s then Inc(i);
  Quantity:=i
end;

function UpStr(s:string):string;
var
  i:integer;
begin
  for i:=1 to Length(s) do s[i]:=UpCase(s[i]);
  UpStr:=s
end;

function GetChar(s:Chars):char;
var
  c:char;
begin
  if s=[] then GetChar:=' '
  else for c:=#0 to #255 do if c in s then begin
    GetChar:=c;
    Break
  end
end;

begin
  Write('Type in a sting: ');
  ReadLn(s);
    i:=1;
  s1:=GetChars(GetWord(s,i));
  w2:=GetWord(s,i);
  s2:=GetChars(w2);
  w3:=GetWord(s,i);
  s3:=GetChars(w3);
  repeat
    m:=(Letters-s1-s3)*s2;
    if Quantity(m)<=1 then
      WriteLn(UpStr(w2),' (',GetChar(m),')');
    s1:=s2;
    s2:=s3;
    w2:=w3;
    w3:=GetWord(s,i);
    s3:=GetChars(w3)
  until w2='';
end.

Желаю успехов