В тексте убрать лишние пробелы между словами, оставив по одному

unit Unit1;
 
interface
 
uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls;
 
type
  TForm1 = class(TForm)
    Label1: TLabel;
    Button1: TButton;
    Button2: TButton;
  private
    { Private declarations }
  public
    { Public declarations }
  end;
 
var
  Form1: TForm1;
 
implementation
 
{$R *.dfm}
 
function proc_with_str(const astr : string) : string;
var sp,i,k:integer;
s: string;
 
 
begin
 
result := astr;
 
sp :=0;
 
for k := 1 to length(result) do
for i := 1 to length(result) do
begin
if ((result[i] = ' ') and (result[i+1] = ' ')) then
begin
inc(sp);
end;
delete(result,i,sp);
sp := 0;
end;
 
end;
 
 
end.

function ProbelTerminator(Text: String): String;
var
b: String; //выходной текст
i: integer; //счетчик для цыкла
begin
if Text='' then exit; //проверяемся
for i:=1 To Length(Text) Do 
begin
if Text[i]=' ' then  //если пробел то 
continue //продолжаем цыкл
else
b:=b + Text[i]; //иначе пишим переменую
end;
Result:=b;
ShowMessage('Готово! Пробелов нет');
end;

StringReplace(Text,' ' ,'',[rfReplaceAll, rfIgnoreCase]);

procedure TForm1.Button1Click(Sender: TObject);
begin
   repeat
      Memo1.Text := StringReplace(Memo1.Text, '  ' ,' ',[rfReplaceAll]);
   until Pos('  ', Memo1.Text) = 0;
end;

//Удаление лишних пробелов и табуляций.
procedure TForm1.Button1Click(Sender: TObject);
const
  D = [' ', #9, #10, #13];
var
  S : String;
  i, Len : Integer;
begin
  //Исходный текст.
  S := Memo1.Text;
 
  Len := Length(S);
  i := Len;
  while i >= 1 do begin
    if S[i] in [' ', #9] then
      if ( (i = Len) or (S[i + 1] in D) ) or ( (i = 1) or (S[i - 1] in D) ) then begin
        Delete(S, i, 1);
        Dec(Len);
      end;
    Dec(i);
  end;
  
  //Ответ.
  Memo2.Text := S;
end;