Program Lin_Sort;
Uses Crt;
const Nmax=100;
Type Rec=Record
Name:String[15]; {Страна}
Area: Integer; {Площадь}
end;
Table=array [1..Nmax] of Rec;
var T: Table; {Основная таблица}
n: integer; {Количество записей}
ch: byte;
procedure InFileTab(var T: Table;
var n: integer);
{Чтение записей таблицы из файла}
var f: file of rec;
fname: string;
ch:char;
begin
ClrScr;
repeat
Writeln('Введите имя файла');
ReadLn(fname);
Assign(f,fname);
{$I-} {Отключение контроля ошибок ввода/вывода}
Reset(f);
{$I+}
if IOResult<>0 then {Файл не найден}
begin
WriteLn('Файл с указанным именем не найден');
Writeln('Будете вводить новое имя: y/n?');
ch:=ReadKey;
if ch in ['n','N'] then
Halt(0)
end;
until IOResult=0;
n:=0;
while not eof(f)do
begin
n:=n+1;
read(f,T[n]);
end;
close(f);
WriteLn('Таблица загружена из файла ', fname);
Write('Нажмите любую клавишу...');
ReadKey;
end;
procedure InTab(var T: Table;
var n: integer);
{Ввод записей таблицы с клавиатуры}
var ch: char;
fname: string;
i: integer;
f: file of rec;
begin
ClrScr;
n:=0;
repeat
n:=n+1;
WriteLn('Введите ',n,'-ую запись табицы');
Writeln('Страна');
ReadLn(t[n].name);
WriteLn('Площадь территории');
Readln(t[n].area);
WriteLn('Продолжить ввод: y/n?');
ch:=ReadKey;
until ch in ['n','N'];
Writeln('SOHRANIT VVEDENIE DANIE V FAILE? y/n');
ch:=ReadKey;
if ch in ['n','N'] then
exit;
Writeln('Введите имя файла');
ReadLn(fname);
Assign(f,fname);
{$I-} {Отключение контроля ошибок ввода/вывода}
Rewrite(f);
{$I+}
for i:=1 to n do
write(f, t[i]);
close(f);
end;
procedure ShowTab(var T: Table;n: integer);
{PECHAT VSEH ZAPISEY TABLICI}
var i: Integer;
begin
ClrScr;
WriteLn('ZAPISI TABLICI:');
WriteLn('+-------------+----------+');
WriteLn('| COUNTRY |TERRITORIA|');
WriteLn('|-------------+----------|');
for i:=1 to n do
WriteLn('|',T[i].Name:12,'|',T[i].Area:9,'|');
WriteLn('+-------------+----------+');
WriteLn('NAZHMITE LUBUUY KLAVISHUя...');
ReadKey;
end;
procedure PrintTab(var T:Table;
n,i,imin:integer);
{Промежуточная печать ключей для демонстрации алгоритма}
var k:Integer;
begin
for k:=1 to n do
begin
if k=i then {Позиция переставляемой записи}
textattr:=red*16+white { Белые символы на красном фоне}
else
if k=imin then {Позиция записи с наименьшим ключём}
textattr:=blue*16+white {Белые символы на синем фоне}
else
textattr:=black*16+white;
write(t[k].Area);
textattr:=black*16+white;
write(' ');
end;
writeln;
end;
procedure SortTab(var T:Table; n:integer);
{Процедура сортировки}
var i, imin,j, k:integer;
tmp:rec;
begin
ClrScr;
WriteLn('Шаги сортировки (выделяются ключи переставляемых записей)');
for i:=1 to n-1 do
begin
imin:=i; {Определение индекса минимального элемента}
for j:=i+1 to n do
if t[j].Area<t[imin].Area then
imin:=j;
if imin<>i then
begin
{Промежуточная печать до перестановки}
Writeln('Шаг ', i);
WriteLn('До перестановки');
PrintTab(T,n,i,imin);
{Обмен записей}
tmp:=t[i];
t[i]:=t[imin];
t[imin]:=tmp;
{Промежуточная запись после перестановки}
WriteLn('После перестановки');
PrintTab(T,n,i,imin);
WriteLn('Нажмите любую клавишу…');
ReadKey;
end;
end;
end;
begin
repeat
ClrScr;
WriteLn('1. Ввести данные с клавиатуры.');
WriteLn('2. Загрузить таблицу из файла.');
WriteLn('3. Показать таблицу.');
WriteLn('4. Сортировка таблицы.');
WriteLn('------------------------------');
WriteLn('0. Выход.');
Write('Ваш выбор: ');
ReadLn(ch);
Case ch of
1: InTab(T,n);
2: InFileTab(T,n);
3: ShowTab(T,n);
4: SortTab(T,n);
end; {case}
until ch=0;
end.