Помогите найти ошибку (самое длинное слово...), требуется найти самое длинное слово... Опции

[inc(alex)]

Пожалуйста, помогите найти ошибку... Ну никак не могу довести программу до ума. Она работает, но все же не на 100% верно.

Задание:
Задать строку символов и найти в ней самое длинное слово, вывести его на экран. (исходную строку можно не сохранять, главное слово найти).

Я хочу проходиться циклом for по строке и наткнувшись на пробел (пробел указывает на конец слова) проверять, больше ли позиция предыдущего символа чем длинна строки в которую я буду уносить слова, если да то копировать слово туда.

Но что-то не так... К примеру, если ввести строку '1 22 55555 333', то до 333 все идет нормально, а НЕ нормально то, что программа уносит '333', в то время как '55555' больше

Помогите пожалуйста разобраться или может быть кто-то может предложить лучшую реализацию?
Заранее ОГРОМНОЕ Спасибо.

Программа выглядит так:

program slovo;
uses
  crt;
var
  s, s1: string;
  i, x: Integer;

Begin
  clrscr;
  writeln('vvedite stroku');
  read(s);

  repeat
    x := pos('  ', s);
    if x <> 0 then
      delete(s, x, 1);
    if s[1] = ' ' then
      delete(s, 1, 1);
    if s[length(s)] <> ' ' then
      s := s + ' ';
  until x = 0;

  write(s);
  s1 := '';

  for i := 1 to length(s) do
    if s[i] = ' ' then
      if (i - 1) > length(s1) then
      begin
        s1 := copy(s, 1, i - 1);
        delete(s, 1, i);
      end;
  i := 1;

  writeln('samoe dlinnoe slovo v stroke = ', s1);
  readkey;
End.

[volvo]

var
  s_max: string;
  p: byte;
begin
  writeln('vvedite stroku');
  read(s);

  { здесь удали все повторяющиеся пробелы, а также
    первый и последний символы (если это пробелы) }

  s_max := '';
  repeat
    p := pos(' ', s);
    if p <> 0 then begin
      if pred(p) > length(s_max) then
        s_max := copy(s, 1, pred(p));
      delete(s, 1, p);
    end;
  until p = 0;

  if length(s) > length(s_max)
    then s_max := s;

  writeln(s_max);
end.