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

procedure TForm1.Button1Click(Sender: TObject);
var s, p, w: string; //выходная строка, входная строка, буфер слова
    i: byte; c: char; //счётчики
    b: array [chr(0)..chr(255)] of byte; //счётчик повторов
begin
  p := Edit1.Text; //копируем из Edit1
  p := p + ' '; //пробел для упрощения алгоритма
  while pos('  ', p) > 0 do delete(p, pos('  ', p), 1); //убираем лишние пробелы
  if p[1] = ' ' then delete(p, 1, 1); //и первый пробел, если он есть
  while length(p) > 0 do //потрошим входную строку
    begin
      for c := char(0) to char(255) do b[c] := 0; //сбрасываем счётчик букв
      w := copy(p, 1, pos(' ', p)); //копируем текущее слово в буфер слова
      delete(p, 1, pos(' ', p)); //и удаляем его из входной строки
      for i := 1 to length(w) do b[w[i]] := b[w[i]] +1; //считаем буквы
      //буквы, количество которых которых больше 1, удаляем, чтобы осталась только одна
      for c := char(0) to char(255) do while b[c] > 1 do begin delete(w, pos(c, w), 1); b[c] := b[c] - 1 end;
      s := s + w //слово копируем в выходную строку
    end;
  delete(s, length(s), 1); //удаляем лишний пробел в выходной строке
  Edit2.Text := s //копируем выходную строку в Edit2
end;

 S := Edit1.Text;
 i := Length(S);
 while i > 1
 do begin
    if AnsiLowerCase(S[i]) = AnsiLowerCase(S[i-1])
    then Delete(S, i, 1);
    Dec(i);
    end;
 Edit2.Text := S;