type Myset=set of char;
var
  Form1: TForm1;

implementation

{$R *.dfm}
function srav(str1,str2:string) :bool;
var
  n,i:word;
begin
  result:=false;
  if length(str1)<length(str2) then
    n:=length(str1)
  else
    n:=length(str2);
  for i:=1 to n do
    if ord(str1[i])<ord(str2[i]) then
    begin
      result:=true;
      break;
    end
    else
    if ord(str1[i])>ord(str2[i]) then break;
end;


procedure TForm1.Button1Click(Sender: TObject);
var
  s,st,c: string;
  n,j,i:integer;
  Ruchar:Myset;
  arr:array of string;
begin
  Ruchar:=['a'..'ÿ','A'..'ß','¸','¨',' '];
  s:=Edit1.Text;
  i:=1;
  While (i<=length(s)) and (s[i] in Ruchar) do
  if s[i] in Ruchar then
  begin
    if s[i]<>' ' then st:=st+s[i]
    else
    begin
      if st<>'' then Memo1.Lines.Add(st);
      Memo1.Lines.Add('');
      st:='';
    end;
    i:=i+1;
  end else showmessage('not russian');
    if st<>'' then Memo1.Lines.Add(st);
    n:=memo1.Lines.Count;
  setlength(arr,n);
  for i:=0 to n-1 do
    arr[i]:=memo1.Lines.Strings[i];
    memo1.Clear;

  for i:=n-2 downto 0 do
    for j:=0 to i do
      if not srav(arr[j],arr[j+1]) then
      begin
        c:= arr[j];
        arr[j]:= arr[j+1];
        arr[j+1]:= c;
      end;
  for i:=0 to n-1 do
  Memo1.Lines.Add(arr[i]);
  for i := 0 to length(arr) - 1 do
  Edit2.Text:=arr[i];