lab1.2

uses
  Windows,
  Unit2 in 'Unit2.pas';

Var
S, S1, S2: ANSIString;
Nom: Byte;
Begin

// сменим кодовые страницы для консольного ввода и вывода
setConsoleCP(1251); // для ввода
setConsoleOutputCP(1251); // для вывода

Writeln('Введите строку (смените шрифт на Lucida Console)');
readln(S); // ввод

S1:=Copy(S, 1, Length(S)); S2:=Copy(S, 1, Length(S)); // создание копий дин.строки

// без своей таблицы символов (со сложным условием обмена)
Writeln(#13#10, 'Строка до сортировки'#13#10, '"', S1, '"');
Nom:= Prov1(s1); // проверка
Case Nom of
1: writeln('Пустая строка');
2: writeln('Некорректные символы');
else
begin // сортировка
Sort1(s1);
Writeln('Отсортированная строка 1'#13#10, '"', S1, '"'); // вывод строки S1
end; {else}
End; {case}

// со своей таблицей символов
Writeln(#13#10'Строка до сортировки'#13#10, '"', S2, '"');
Nom:= Prov2(s2); // проверка
Case Nom of
1: writeln('Пустая строка');
2: writeln('Некорректные символы');
else
begin // сортировка
Sort2(s2);
Writeln('Отсортированная строка 2'#13#10, '"', S2, '"'); // вывод строки S2
end; {else}
End; {case}

writeln(#13#10'Press ENTER to exit');
readln
End.


Unit Unit2; // имя модуля – меняется при сохранении File ? Save As…
Interface // раздел описания межмодульного интерфейса

Uses
SysUtils;

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

Const
BukvLat: set of char = ['A'.. 'Z', 'a'..'z'];
BukvKirPr: set of char = ['а' .. 'я', 'ё'];
BukvKirZag: set of char = ['А' .. 'Я', 'Ё'];
BukvDoEPr: set of char = ['а'..'е'];
BukvPosleEPr: set of char = ['ж'..'я'];
BukvDoEZag: set of char = ['А'..'Е'];
BukvPosleEZag: set of char = ['Ж'..'Я'];

Function Prov1(const s: ANSIString): Byte; // проверка без SymbTable
Function Prov2(const s: ANSIString): Byte; // проверка с SymbTable
Procedure Sort1(var s: ANSIString); // сортировка без SymbTable
Procedure Sort2(var s: ANSIString); // сортировка с SymbTable

Implementation // раздел реализации и описания закрытых процедур

Function Prov1; // проверка без SymbTable
Var
Nom: byte; // номер аномалии
i,Len: word; // текущий символ и длина строки
Begin
Nom:=0; len:= Length(S);
If Len=0 then Nom:=1
Else
Begin
i:=1;
while (i<=Len) and (Nom=0) do
begin
if Not ((S[i] in BukvLat) or (S[i] in BukvKirPr) or (S[i] in BukvKirZag) or (s[i]=' ')) then Nom:=2;
i:=i+1;
end;
End;
Prov1:=Nom;
End;

Function Prov2; // проверка с SymbTable
Var
Nom: byte; // номер аномалии
i,Len: word; // текущий символ и длина строки
Begin
Nom:=0; len:= Length(S);
If Len=0 then Nom:=1
Else
Begin
i:=1;
while (i<=Len) and (Nom=0) do
begin
if Not (Pos(S[i], SymbTable)>0) then Nom:=2;
i:=i+1;
end;
End;
Prov2:=Nom;
End;

Procedure Sort1; // сортировка без SymbTable
Var
i, z, len: Word; // номер текущего символа, номер итерации (шага), длина строки {(s[i] in BukvLatZag) and (s[i+1]in BukvLatPr) and}
flag: Boolean; // упорядочено? (нет обменов?)
ch: char; // для обмена
Begin
Z:=1; len:=length(s);
Repeat // пузырёк
flag:=true;
for i:=1 to len-z do
if (s[i]=' ') and ((s[i+1] in BukvLat) or (s[i+1] in BukvKirPr)  or (s[i+1] in BukvKirZag)) or
(s[i] in BukvLat) and ((s[i+1] in BukvKirZag) or (s[i+1] in BukvKirPr)) or
(s[i] in BukvDoEZag) and (s[i+1] in BukvDoEZag) and (s[i]>s[i+1]) or
(s[i] in BukvPosleEZag) and (s[i+1] in BukvPosleEZag) and (s[i]>s[i+1]) or
(s[i] in BukvDoEPr) and (s[i+1] in BukvDoEPr) and (s[i]>s[i+1]) or
(s[i] in BukvPosleEPr) and (s[i+1] in BukvPosleEPr) and (s[i]>s[i+1]) or
(s[i] in BukvPosleEPr) and (s[i+1]='ё') or
(s[i] in BukvPosleEZag) and (s[i+1]='Ё') or
(s[i] in BukvKirZag) and (s[i+1] in BukvKirPr) and ((ord(s[i])+32)>=ord(s[i+1]))or
(s[i] in BukvKirPr) and (s[i+1] in BukvKirZag) and (ord(s[i])>=(ord(s[i+1])+32))
then

begin // обмен
ch:=s[i]; s[i]:=s[i+1]; s[i+1]:=ch; flag:= false;
end;
z:=z+1;
Until flag or (z=len);
End;

Procedure Sort2; // сортировка с SymbTable
Var
i, z, len: Word; // номер текущего символа, номер итерации (шага), длина строки
flag: Boolean; // упорядочено? (нет обменов?)
ch: char; // для обмена
Begin
z:=1; len:=length(s);
Repeat // пузырёк
flag:=true;
for i:=1 to len-z do
if (Pos(s[i], SymbTable) > Pos(s[i+1], SymbTable)) // неправильный порядок по своей «таблице»
and not ( (s[i] in BukvLat) and (s[i+1] in BukvLat)) // но латинницу не упорядочивать
then
begin // обмен
ch:=s[i]; s[i]:=s[i+1]; s[i+1]:=ch; flag:= false;
end;
z:=z+1;
Until flag or (z=len);
End;

end.