A ver si ésta (recorre una sóla vez la cadena):
Código Delphi
[-]
function ComprimeEspacios(S: String): String;
var
I: Integer;
begin
I := 1;
while I <= Length(S) do
begin
while (I <= Length(S)) and (S[i] <> ' ') do
Inc(I);
Inc(I);
while (I <= Length(S)) and (S[i] = ' ') do
Delete(S, I, 1);
Inc(I);
end;
Result := S;
end;
// Saludos