Строки

[Ester]

Вот такое задание:

Дана исходная текстовая строка произвольной длины, содержащая английские слова и пробелы между ними. Получить результирующую строку, в которой все слова отсортированы в порядке возрастания их длины, при этом сохраняется по одному пробелу между словами.
Исходный и полученный текст вывести на экран.

В программировании я чайник,так что пока получилось только удалить лишние пробелы А как отсортировать слова не знаю.

program Project1;

{$APPTYPE CONSOLE}

uses
  SysUtils;

var s1,s2: string;
slovo,w:string[30];
en,beg,i,k,j,m,n:integer;
b: boolean;
BEGIN
write('Vvedite text: ');
readln(s1);
writeln(s1);

begin
m:=255; n:=0;
  { TODO -oUser -cConsole Main : Insert code here }
 while s1[1]= ' ' do    {удаляем 1й,последний и лишние
                                                  пробелы}
   delete (s1,1,1);
 while s1 [length (s1)]= ' ' do
   delete (s1,length (s1),1);
 while pos('  ',s1)<>0  do
   delete(s1,pos('  ',s1),1);

 writeln(s1);
 s2:=s1;
 writeln(s2);


readln
end;
end.

________
Код нужно оформлять по правилам:
тегом [CODE]..[/СODE] (это кнопочка с решёточкой #)
Не забывайте об этом!
Модератор.

[whatever]

program Project1;

{$APPTYPE CONSOLE}

uses
  SysUtils;

type
  words=array[0..128]of string; //Если количество слов заранее известно, то можно поставить его -1 вместо 128

procedure BubbleSort(var a:words; k:integer);
 var
  i,n:Integer;
  p:string;
  b:boolean;
begin
 n:=k;
 if n=0 then exit;
 repeat
  b:=true;
  Dec(n);
  for i:=0 to n do
   if length(a[i])>length(a[i+1]) then
    begin
     p:='';
     p:=a[i];
     a[i]:='';
     a[i]:=a[i+1];
     a[i+1]:='';
     a[i+1]:=p;
     b:= false;
    end;
 until b;
end;

var s1,s2: string;
slovo,w:string[30];
en,beg,i,k,j,n:integer;
b: boolean;
M:words;
BEGIN
write('Vvedite text: ');
readln(s1);
//writeln(s1);

begin
//m:=255; n:=0;
  { TODO -oUser -cConsole Main : Insert code here }
 while s1[1]= ' ' do    {удаляем 1й,последний и лишние пробелы}
   delete (s1,1,1);
 while s1 [length (s1)]= ' ' do
   delete (s1,length (s1),1);
 while pos('  ',s1)<>0  do
   delete(s1,pos('  ',s1),1);
 writeln(s1);
// s2:=s1;
//riteln(s2);
  k:=0;
  m[0]:='';
  For i:=1 to length(s1) do
    if s1[i]<>' ' then
      M[k]:=m[k]+S1[i]
    else
      begin
        inc(k);
        m[k]:='';
      end;

  bubblesort(m,k);
    s2:='';
  for i:=0 to k do
    s2:=s2+m[i]+' ';
  writeln(s2);

readln
end;
end.

Писал на коленке, но вроде бы все работает.