2.4ЛистингпрограммынаязыкеPascal
programsubd;
type
TShops = record
ReestrNumber: integer;
FIOName: string[10];
Adress, FormaObucheniy : record
Street : string[15];
Ochnay, Zaochnay, Vechernyy:char;
NumberOfBld : byte;
end;
faculfy : string[10];
Specialty, NumberAttestata, SrBall : integer;
Medal:char;
end;
TBaseMass = array[1..255] of TShops;
{Процедура формирования новой таблицы}
procedureInputNewBase(varBase:TBaseMass; varNumOfRec:byte);
var i: byte;
Shop: TShops;
ContinueInput: char;
begin
i:=0;
WriteLn;
repeat
i:= i + 1;
with Shop do
begin
write('Введите ФИО ',i,'-го абитуриента: ');
readLn(FIOName);
writeLn('Введите адрес абитуриента ',FIOName);
write(' Улица: ');
readLn(Adress.Street);
write(' Дом: ');
readLn(Adress.NumberOfBld);
write('Факультет абитуриента ',FIOName,': ');
readLn(faculfy);
write('Специальность абитуриента ',FIOName,': ');
readLn(Specialty);
writeLn('Форма обучения абитуриента ',FIOName);
write(' Очная: ');
readLn(FormaObucheniy.Ochnay);
write(' Заочная: ');
readLn(FormaObucheniy.Zaochnay);
write(' Вечерняя: ');
readLn(FormaObucheniy.Vechernyy);
write('Номер аттестата абитуриента ',FIOName,': ');
readLn(NumberAttestata);
write('Ср. балл аттестата абитуриента ',FIOName,': ');
readLn(SrBall);
write('Наличие медали у абитуриента ',FIOName,': ');
readLn(Medal);
end;
Base[i] := Shop;
writeLn('Введите данные о следующем абитуриента ');
writeLn('Если код окончен, введите 0, если нет - 1');
readLn(ContinueInput);
untilContinueInput='0';
NumOfRec:=i;
end;
{Процедура вывода базы на экран}
procedureOutBase(const Base:TBaseMass; const NumOfRec:byte);
vari,j: byte;
begin
writeLn;
ifNumOfRec<> 0 then
begin
writeLn('База данных содержит следующие сведения:');
for j:=1 to 179 do
write('-');
writeLn;
writeLn('N п/п':6,'| ','ФИО|':12,'Адрес.Улица |':17,'Дом |':7,'Факультет |':8,'Специальность |':15, 'Формаобучения.Очная |':22, 'Заочная |':10, 'Вечерняя|':10, 'Номераттестата |':17, 'Ср.Баллаттестата|':19,'Наличиемедали|':17);
forj:=1 to 179 do
write('=');
writeLn;
for i:=1 to NumOfRec do
with Base[i] do
begin
write(i:5,' |');
write(FIOName:10,' |');
write(Adress.Street:15,' |');
write(Adress.NumberOfBld:5,' |');
write(faculfy:9,' |');
write(Specialty:13,' |');
write(FormaObucheniy.Ochnay:21,' |');
write(FormaObucheniy.Zaochnay:8,' |');
write(FormaObucheniy.Vechernyy:8,' |');
write(NumberAttestata:15,' |');
write(SrBall:17,' |');
writeLn(Medal:15,' |');
for j:=1 to 179 do
write('-');
writeLn;
end;
end
else
writeLn('БД пуста');
end;
{ПроцедураобработкизапросакБД
(поиск медалистов, подавших заявления на заданную специальность)}
Procedure Medal(const Base:TBaseMass; const NumOfRec: byte);
vari,j: byte;
NeedSpecialty,Specialty: integer;
Medal:char;
begin
ifNumOfRec<> 0 then
begin
writeLn;
writeLn('Запрос к БД: список медалистов, подавших заявления на заданную специальность ');
writeLn;
write('Введите специальность:');
readln (NeedSpecialty);
for i:= 1 to NumOfRec do
with Base[i] do
writeLn('Результат запроса:');
for j:=1 to 179 do
write('-');
writeLn;
writeLn('N п/п':6,'| ','ФИО|':12,'Адрес.Улица |':17, 'Дом |':7,'Факультет |':8,'Специальность |':15, 'Формаобучения.Очная |':22, 'Заочная |':10, 'Вечерняя|':10, 'Номераттестата |':17, 'Ср.Баллаттестата |':19, 'Наличиемедали |':17);
for j:=1 to 179 do
write('=');
writeLn;
for i:=1 to NumOfRec do
with Base[i] do
if (Specialty = NeedSpecialty) and (medal='+')then
begin
write(i:5,' |');
write(FIOName:10,' |');
write(Adress.Street:15,' |');
write(Adress.NumberOfBld:5,' |');
write(faculfy:9,' |');
write(Specialty:13,' |');
write(FormaObucheniy.Ochnay:21,' |');
write(FormaObucheniy.Zaochnay:8,' |');
write(FormaObucheniy.Vechernyy:8,' |');
write(NumberAttestata:15,' |');
write(SrBall:17,' |');
writeLn(Medal:15,' |');
for j:=1 to 179 do
write('-');
writeLn;end;end
else
writeLn('В базе нет такой специальности ', NeedSpecialty);
end;
{Процедура обработки запроса к БД
(поиск абитуриентов-очников)}
Procedure Ochnik(const Base:TBaseMass; const NumOfRec: byte);
vari,j: byte;
Ochnay: char;
begin
ifNumOfRec<> 0 then
begin
writeLn;
writeLn('Запрос к БД: список абитуриентов-очников);
writeLn('Результат запроса:');
for j:=1 to 179 do
write('-');
writeLn;
writeLn('N п/п':6,'| ','ФИО|':12,'Адрес.Улица |':17, 'Дом |':7,'Факультет |':8,'Специальность |':15, 'Формаобучения.Очная |':22, 'Заочная |':10, 'Вечерняя|':10, 'Номераттестата |':17, 'Ср.Баллаттестата |':19, 'Наличиемедали |':17);
for j:=1 to 179 do
write('=');
writeLn;
for i:=1 to NumOfRec do
with Base[i] do
if (FormaObucheniy.Ochnay = '+') then
begin
write(i:5,' |');
write(FIOName:10,' |');
write(Adress.Street:15,' |');
write(Adress.NumberOfBld:5,' |');
write(faculfy:9,' |');
write(Specialty:13,' |');
write(FormaObucheniy.Ochnay:21,' |');
write(FormaObucheniy.Zaochnay:8,' |');
write(FormaObucheniy.Vechernyy:8,' |');
write(NumberAttestata:15,' |');
write(SrBall:17,' |');
writeLn(Medal:15,' |');
for j:=1 to 179 do
write('-');
writeLn;end;end
else
writeLn('В базе нет очников ');
end;
{Процедура обработки запроса к БД
(поиск абитуриентов с наименьшим средним баллом в аттестате)}
Procedure srBall(const Base:TBaseMass; const NumOfRec: byte);
vari,j, k: byte;
SrA: integer;
SrBall : integer;
begin
ifNumOfRec<> 0 then
begin
writeLn;
writeLn('Запрос к БД: список абитуриентов с наименьшим средним баллом в аттестате ');
writeLn('Результат запроса:');
for j:=1 to 179 do
write('-');
writeLn;
writeLn('N п/п':6,'| ','ФИО|':12,'Адрес.Улица |':17, 'Дом |':7,'Факультет |':8,'Специальность |':15, 'Формаобучения.Очная |':22, 'Заочная |':10, 'Вечерняя|':10, 'Номераттестата |':17, 'Ср.Баллаттестата |':19, 'Наличиемедали |':17);
for j:=1 to 179 do
write('=');
writeLn;
for i:=1 to NumOfRec do
with Base[i] do
if (srBall<4) then
begin
write(i:5,' |');
write(FIOName:10,' |');
write(Adress.Street:15,' |');
write(Adress.NumberOfBld:5,' |');
write(faculfy:9,' |');
write(Specialty:13,' |');
write(FormaObucheniy.Ochnay:21,' |');
write(FormaObucheniy.Zaochnay:8,' |');
write(FormaObucheniy.Vechernyy:8,' |');
write(NumberAttestata:15,' |');
write(SrBall:17,' |');
writeLn(Medal:15,' |');
for j:=1 to 179 do
write('-');
writeLn; end;end
else
writeLn('В базе нет абитуриентов с низким ср.баллом в аттестатом ');
end;
{процедура выводящая главное меню программы}
procedureMainMenu;
varPunktOfMenu: byte;
Base: TBaseMass;
NumOfRec : byte;
begin
NumOfRec := 0;
repeat
writeLn;
writeLn('Выберите нужное действие:');
writeLn('1 - Ввод новой БД');
writeLn('2 - Вывод БД');
writeLn('3 - поиск медалистов, подавших заявления на заданную специальность ');
writeLn('4 - поиск абитуриентов-очников ');
writeLn('5 - поиск абитуриентов с наименьшим средним баллом в аттестате');
writeLn('6 - Выход');
write('Ваш выбор:');
readLn(PunktOfMenu);
casePunktOfMenu of
1: InputNewBase(Base, NumOfRec);
2: OutBase(Base, NumOfRec);
3: Medal(Base, NumOfRec);
4: Ochnik(Base, NumOfRec);
5: srBall(Base, NumOfRec)
else
ifPunktOfMenu<>6 then
writeLn('Введите корректный пункт меню');
end;
untilPunktOfMenu = 6 ;
end;
{очень короткая главная программа}
begin
MainMenu;
end.