program DeleteSpaces;
uses crt; {блябляблядальшехзчёписать}
var
str : string; {рабочая строка}
{параметры цикла и количество пробелов в группе}
index, i, spacenum : integer;

begin
{назначение программы}
{ввод исходной строки}
write('Введите исходную строку: ');
readln(str);
{защита от дурака}
while length(str)=0 do begin
writeln('Работа с пустой строкой невозможна. Повторите ввод: ');
readln(str);
end;
{вывод исходных данных}
writeln('Вы ввели строку: ', str);
{сам расчет}
index:=1;
while index< length(str) do begin
if str[index]=' ' then begin
spacenum := 1;
i:=index+1;
while str[i]=' ' do begin
spacenum:=spacenum+1;
i:=i+1;
end;
delete(str,index+1,spacenum-1);
end;
index:=index+1;
end;
{вывод результата}
writeln('Строка-результат: ', str);
{для просмотра результатов}
writeln('Нажмите любую клавишу'); ReadKey;
end.

var p: integer;
...
repeat
  p := pos('  ', str);
  if p > 0 then delete(str, p, 1);
until p = 0;
...

var res: array[1 .. 3] of string;
...
i := 1;
repeat
  p := pos(' ', str);
  if p > 0 then begin
    res[i] := copy(str, 1, p - 1);
    delete(str, 1, p);
    i := i + 1;
  end;
until p = 0;
res[i] := str;

{ Проверяем, что получилось }
for p := 1 to i do writeln(res[p]);

Цитата(volvo @ 20.12.2006 22:39)

var res: array[1 .. 3] of string;
...
i := 1;
repeat
  p := pos(' ', str);
  if p > 0 then begin
    res
 := copy(str, 1, p - 1);
    delete(str, 1, p);
    i := i + 1;
  end;
until p = 0;
res[i] := str;

{ Проверяем, что получилось }
for p := 1 to i do writeln(res[p]);



writeln('Вот что у нас получилось: ');
for p:=1 to i do
    begin
     writeln(res[p]);
     writeln;
     end;
     readln;