Работа со строками Delphi

[gabach]

Из первых и последних букв слов сформировать массив букв и отсортировать по алфавиту. Вывести исходную строку, преобразованную, массив букв и отсортированный массив букв.
Подскажите, где ошибка в сортировке

Program Stroki;
{$APPTYPE CONSOLE}

uses
  SysUtils;
const
alph='АаБбВвГгДдЕеЁёЖжЗзИиЙйКкЛлМмНнОоПпРрСсТтУуФфХхЦцЧчШшЩщЪъЫыЬьЭэЮюЯя';

function Rus(S:String) :String;
var i:byte;
begin
  Result:='';
  For i:=1 to Length(S) do
    case S[i] of
 'А'..'п': Result:=Result+Chr(Ord(S[i])-64);
 'р'..'я': Result:=Result+Chr(Ord(S[i])-16);
 'Ё': Result:=Result+Chr(240);
 'ё': Result:=Result+Chr(241);
  else
    Result:=Result+S[i];
  end;
end;

Type MShStr=array[1..100] of ShortString;
     TMBukv=array[1..200] of String[1];
var st:ShortString;
    n,k:byte;
    MSlov:MShStr;
    MBukv:TMBukv;

//Ввод и вывод(Процедура)
procedure VvodVivod(var Str:ShortString);
begin
writeln(rus('Введите строку:')); readln(str);
writeln;
writeln(rus('Введёная строка:'));writeln(str);
writeln;
end;

//удаление лишних пробелов(Процедура)
procedure DelProb(var Str:ShortString);
var k:byte;
begin
if str[Length(str)]<>' ' then
str:=str+' ';
k:=pos('  ',str);
while k<>0 do
  begin
    delete(str,k,1);
    k:=pos('  ',str);
  end;
if str[1]=' ' then delete(str,1,1);//удалить пробел в начале строки
writeln(rus('Результат:'));
if length(str)<>0 then writeln(str)
else writeln(rus('Строка содержала только пробелы'));
end;

//Выделение слов и вывод массива(Процедура)
procedure VidSlov(var Str:ShortString; out MSlov1:MShStr;var n:byte);
Var i:byte;
begin
n:=0;
while pos(' ',str)>0 do
  begin
    n:=n+1;
    MSlov1[n]:=copy(str,1,pos(' ',str)-1);
    delete(str,1,pos(' ',str));
  end;
writeln;
if n<>0 then begin
Writeln(rus('Массив слов:'));
for i:=1 to n do
writeln(MSlov1[i]);
end;
writeln;
end;

//Выделение букв в массив
procedure VidBukv(var MSlov1:MShStr; out MBukv1:TMBukv; var n:byte;out k:byte);
var strx:ShortString; i:byte;
begin
  Writeln(Rus('Массив букв:'));
  strx:='';
  for i:= 1 to n do
    begin
     if length(MSlov[i])>1
     then
        strx:=strx+Copy(MSlov1[i],1,1)+Copy(MSlov1[i],length(MSlov[i]),1)
     else
        strx:=strx+Copy(MSlov1[i],1,1);
    end;
  k:=0;
  for i:=1 to length(strx) do
  begin
    MBukv1[i]:=copy(strx,i,1);
    k:=k+1;
  end;
  for i:=1 to k do write(MBukv1[i],' ');
end;

//Процедура для сортировки массива букв
procedure Sort(var MBukv1:TMBukv; k:byte);
var a:String[1];i,j:byte;
Begin
    for i:=1 to k-1 do
    for j:=1 to k-1 do
    if pos(MBukv1[j],alph)>pos(MBukv1[j+1],alph) then
    begin
      a:=MBukv1[j];
      MBukv1[j]:=MBukv1[j+1];
      MBukv1[j+1]:=a;
    end;
  writeln;
  writeln(Rus('Отсортированный массив букв: '));
  for i:=1 to k do write(MBukv1[i],' ');
  writeln;
End;

//Основная программа
begin
VvodVivod(St);
DelProb(St);
VidSlov(St,MSlov,n);
VidBukv(MSlov,MBukv,n,k);
Sort(MBukv,k);
readln;
end.

[NetSpace]

вот, всё работает!

Program Stroki;
{$APPTYPE CONSOLE}

uses
  SysUtils;
const
alph='ÀàÁáÂâÃãÄäÅ娸ÆæÇçÈèÉéÊêËëÌìÍíÎîÏïÐðÑñÒòÓóÔôÕõÖö×÷ØøÙùÚúÛûÜüÝýÞþßÿ';

function Rus(S:String) :String;
var i:byte;
begin
  Result:='';
  For i:=1 to Length(S) do
    case S[i] of
 'À'..'ï': Result:=Result+Chr(Ord(S[i])-64);
 'ð'..'ÿ': Result:=Result+Chr(Ord(S[i])-16);
 '¨': Result:=Result+Chr(240);
 '¸': Result:=Result+Chr(241);
  else
    Result:=Result+S[i];
  end;
end;

Type MShStr=array[1..100] of ShortString;
     TMBukv=array[1..200] of Char;
var st:ShortString;
    n,k:byte;
    MSlov:MShStr;
    MBukv:TMBukv;

//Ââîä è âûâîä(Ïðîöåäóðà)
procedure VvodVivod(var Str:ShortString);
begin
writeln(rus('Ââåäèòå ñòðîêó:')); readln(str);
writeln;
writeln(rus('Ââåä¸íàÿ ñòðîêà:'));writeln(str);
writeln;
end;

//óäàëåíèå ëèøíèõ ïðîáåëîâ(Ïðîöåäóðà)
procedure DelProb(var Str:ShortString);
var k:byte;
begin
if str[Length(str)]<>' ' then
str:=str+' ';
k:=pos('  ',str);
while k<>0 do
  begin
    delete(str,k,1);
    k:=pos('  ',str);
  end;
if str[1]=' ' then delete(str,1,1);//óäàëèòü ïðîáåë â íà÷àëå ñòðîêè
writeln(rus('Ðåçóëüòàò:'));
if length(str)<>0 then writeln(str)
else writeln(rus('Ñòðîêà ñîäåðæàëà òîëüêî ïðîáåëû'));
end;

//Âûäåëåíèå ñëîâ è âûâîä ìàññèâà(Ïðîöåäóðà)
procedure VidSlov(var Str:ShortString; out MSlov1:MShStr;var n:byte);
Var i:byte;
begin
n:=0;
while pos(' ',str)>0 do
  begin
    n:=n+1;
    MSlov1[n]:=copy(str,1,pos(' ',str)-1);
    delete(str,1,pos(' ',str));
  end;
writeln;
if n<>0 then begin
Writeln(rus('Ìàññèâ ñëîâ:'));
for i:=1 to n do
writeln(MSlov1[i]);
end;
writeln;
end;

//Âûäåëåíèå áóêâ â ìàññèâ
procedure VidBukv(var MSlov1:MShStr; out MBukv1:TMBukv; var n:byte;out k:byte);
var strx:ShortString; i:byte;
begin
  Writeln(Rus('Ìàññèâ áóêâ:'));
  strx:='';
  for i:= 1 to n do
    begin
     if length(MSlov[i])>1
     then
        strx:=strx+Copy(MSlov1[i],1,1)+Copy(MSlov1[i],length(MSlov[i]),1)
     else
        strx:=strx+Copy(MSlov1[i],1,1);
    end;
  k:=0;
  for i:=1 to length(strx) do
  begin
    MBukv1[i]:=copy(strx,i,1)[1];
    k:=k+1;
  end;
  for i:=1 to k do write(MBukv1[i],' ');
end;

//Ïðîöåäóðà äëÿ ñîðòèðîâêè ìàññèâà áóêâ
procedure Sort(var MBukv1:TMBukv; k:byte);
var a:String[1];i,j,m:byte;
Begin
    for m:=1 to k-1 do
    for i:=1 to k-1 do
    for j:=1 to k-1 do
    if ord(Char(MBukv1[j])) >ord(Char(MBukv1[j+1])) then
    begin
      a:=MBukv1[j];
      MBukv1[j]:=MBukv1[j+1];
      MBukv1[j+1]:=a[1];
    end;
  writeln;
  writeln(Rus('Îòñîðòèðîâàííûé ìàññèâ áóêâ: '));
  for i:=1 to k do write(MBukv1[i],' ');
  writeln;
End;

//Îñíîâíàÿ ïðîãðàììà
begin
VvodVivod(St);
DelProb(St);
VidSlov(St,MSlov,n);
VidBukv(MSlov,MBukv,n,k);
Sort(MBukv,k);
readln;
end.

[gabach]

я имел ввиду, что он не сортирует должным образом, буквы не в алфавитном порядке расположены после сортировки, не понимаю почему

[NetSpace]

вот второй, удачный скриншот

[NetSpace]

у тебя в сортировке сравнение было по позиции буквы. буква П была первой - так первой и оставалась. лучше всего было сделать не по буквам, а по цифрам. я перевёл символы в код и цифры сравнивал. тип символьный str сделал str[1] - чтоб он был похож на Char; просмотри весь код - кое-что изменено!
MBukv1[i]:=copy(strx,i,1)[1];
TMBukv=array[1..200] of Char;
если помог - жми на весы