Работа с файлами
Привет всем! Требуется помощь: необходимо доработать существующую программу
Доработать:
1. вызов запросов оформить в виде меню;
2. добавить пункты: сохранить таблицу в файле и прочитать
таблицу из файла. Типы файлов:
– типизированный файл из записей;
– типизированный файл из символов;
– текстовый файл;
3. запросы оформить в виде подпрограмм. Все объявления и
подпрограммы должны быть оформлены в виде модуля (модулей).
код программы:
Код:
program laba1_2;
uses
crt;
const
N = 8;
type
ZNAK1 = record
Surname, Name: string[20]; // Фамилия, имя
Zodiac: string[10]; // Знак зодиака
Birthday: array[1..3] of integer; // Число месяц год
end;
ArrZNAK = array[1..N] of Znak1;
var
ZNAK: ArrZNAK;
i:integer;
surname1:string;
Birthday1:integer;
// Процедура ввода данных
procedure Input(var ZNAK: ZNAK1; i: integer);
var
s: string;
d, m, y, err: integer;
err2: boolean;
begin
ClrScr;
writeln('Ввод ', i, ' пользователя.');
writeln;
write('Введите фамилию: ');
readln(ZNAK.Surname);
write('Введите имя: ');
readln(ZNAK.Name);
write('Введите знак зодиака: ');
readln(ZNAK.Zodiac);
repeat
write('Введите дату рождения в формате ДД.ММ.ГГГГ: ');
readln(s);
err2 := False;
Val(Copy(s, 1, Pos('.', s)-1), d, err);
Delete(s, 1, Pos('.', s));
if (err <> 0) then
err2 := true
else
if not (d in [1..31]) then err2 := true;
Val(Copy(s, 1, Pos('.', s)-1), m, err);
Delete(s, 1, Pos('.', s));
if (err <> 0) then
err2 := true
else
if not (m in [1..12]) then err2 := true;
Val(Copy(s, 1, 4), y, err);
if (err <> 0) then
err2 := true
else
if not (y in [1900..2017]) then err2 := true;
if err2 then writeln('Неверные данные. Повторите ввод.');
until not err2;
ZNAK.Birthday[1] := d;
ZNAK.Birthday[2] := m;
ZNAK.Birthday[3] := y;
end;
// Процедура вывода массива записей в виде таблицы
procedure Output(ZNAK:ArrZNAK; N: integer);
var
i: integer;
begin
writeln(' ┌────────────────────────────────────────────────────────────────────────┐');
writeln(' │ Фамилия │ Имя │Знак зодиака │ Дата │');
writeln(' ├──────────────────────┼──────────────────────┼─────────────┼────────────┤');
for i := 1 to N do
begin
writeln(' │ ', ZNAK[i].Surname:20, ' │ ', ZNAK[i].Name:20, ' │ ', ZNAK[i].Zodiac:11, ' │ ',
ZNAK[i].Birthday[1]:2 ,'.', ZNAK[i].Birthday[2]:2 ,'.', ZNAK[i].Birthday[3]:4,' │');
if i <> N then
writeln(' ├──────────────────────┼──────────────────────┼─────────────┼────────────┤')
else
writeln(' └──────────────────────┴──────────────────────┴─────────────┴────────────┘');
end;
end;
// Процедура сортировки массива по знаку зодиака
procedure Sort(var ZNAK: ArrZnak; N: integer);
var
i, j, k, l, m: integer;
s: string;
SWAPZNAK: ZNAK1;
begin
k:=0;
while k<=n do
begin
for i:=1 to n-1 do
begin
l:=1; m:=0;
repeat
if ZNAK[i].Zodiac[l]<>ZNAK[i+1].Zodiac[l] then inc(m);
if ZNAK[i].Zodiac[l]>ZNAK[i+1].Zodiac[l] then
begin
s:=ZNAK[i].Zodiac;
ZNAK[i].Zodiac:=ZNAK[i+1].Zodiac;
ZNAK[i+1].Zodiac:=s;
end;
inc(l);
until (m=1) or (l>length(ZNAK[i].Zodiac));
end;
inc(k);
end;
end;
// Процедура поиска записи по месяцу рождения
procedure Search(ZNAK: ArrZNAK; N: integer; Birthday1: integer);
var
i: integer;
err: boolean;
begin
err := true;
for i := 1 to N do
if ZNAK[i].Birthday[2] = Birthday1 then
begin
err := false;
writeln;
writeln('Фамилия: ', ZNAK[i].Surname);
writeln('Имя: ', ZNAK[i].Name);
writeln('Дата рождения: ', ZNAK[i].Birthday[1], '.', ZNAK[i].Birthday[2], '.', ZNAK[i].Birthday[3]);
writeln('Знак зодиака: ',ZNAK[i].Zodiac);
end;
writeln;
if err = true then
writeln('Люди, родившиеся в месяц "', Birthday1,'" не найдены');
end;
begin
// Ввод массива записей
for i := 1 to N do
Input(ZNAK[i], i);
ClrScr;
// Вывод таблицы
Output(ZNAK, N);
// Сортировка записей по дате рождения
Sort(ZNAK, N);
readln;
writeln;
writeln('Результат сортировки:');
Output(ZNAK, N); // Вывод отсортированной таблицы
writeln;
writeln('Введите значение месяца рождения: ');
readln(Birthday1);
Search(ZNAK, N, Birthday1);// Вывод искомых данных
readln;
end.
|
