[ecfisa]

Hola.

Otra opción:

Código Delphi [-]
function DeleteExtraSpaces(str: string): string;
var
  i: integer;
begin
  for i := 1 to Length(str)-1 do
    while (str[i] = ' ') and (str[i+1] = ' ') do
      Delete(str, i+1, 1);
  Result := str;
end;

Saludos