ПолучИте.
Несколько замечаний.
1. Прописные буквы недопустимы: строка должна состоять из русских слов, написанных строчными буквами и разделенных запятыми.
2. Буква "й" в качестве звонкой согласной не включена в список. Если надо - добавьте и увеличьте длину массива Codes на 1.
3. Сам по себе массив Codes возник исключительного из-за идиотского требования расположить буквы в результирующем списке по алфавиту. Если бы не этот преподский дебилизм, то программа была бы куда компактнее, и никакой надобности в массиве не возникло бы. А так... Дело в том, что элементы множества всегда располагаются "навалом", и упорядочить их внутри множества никакой возможности нет, вот и пришлось извращаться с массивом.
Код:
Const
Sonants:Set of Char=['б','в','г','д','ж','з','л','м','н','р'];
Var
S:String;
C:Char;
i,j,k,N:Byte;
Found:Set of Char;
Codes:Array[1..10] of Byte;
Begin
Writeln('Enter the string:');
Readln(S);
Writeln;
Found:=[];
N:=0;
i:=0;
Repeat
Inc(i);
If (S[i] in Sonants) and not (S[i] in Found) then
begin
C:=S[i];
k:=i;
repeat
Inc(k);
until (S[k]=',') or (k=Length(S));
if S[k]=',' then
begin
repeat
Inc(k);
until (S[k]=C) or (k=Length(S));
if S[k]=C then
begin
Found:=Found+[C];
Inc(N);
Codes[N]:=Ord(C);
end;
end;
end;
Until i=Length(S)-1;
for i:=1 to N-1 do
for j:=1 to N-i do
if Codes[j]>Codes[j+1] then
begin
k:=Codes[j];
Codes[j]:=Codes[j+1];
Codes[j+1]:=k;
end;
writeln('Result:');
for i:=1 to N do write(Chr(Codes[i]),' ');
Readln
End.