Консультации Портала - Консультация #177886

Задать вопрос Консультации Пользователи Форум

Задать вопрос экспертам

Консультация № 177886

17.04.2010, 12:31

0.00 руб.

0 9 1

Компьютеры Программирование

Сделать две программы:
1)программу по теме текстовые файлы.
2)программу по теме типизированные файлы.

Из задачи:
type
игрушка=record
название:string;
цена:integer;
цвет:string;
возраст1:1..16;
возраст2:1..16;
end;
............
Определить:
1)Название игрушек,цена которых не превышает даную и которые подходят детям даного возраста.
2)Найти самую дешёвую игрушку даного названия.
3)Найти самый распространнёный цвет игрушек.

Приложение:
пример:uses crt;
Const
qwe:set of char=['0'..'9'];
qwe1:set of char=['а'..'я'];
type
tel=record
fam:string;
Ntel:string;
adres:string;
end;

var
f1:text;
f:file of string;
a:array[1..1000] of tel;
i,n,n1,m,v,w,k,j:byte;
fam,adpec,buf,buf2,buf3:string;
nom:string;
q:boolean;

{<------------------ типизированная программа ------------------>}

procedure enter1;
begin
clrscr;
writeln('введите кол-во запесей');
readln(n);
rewrite(f);
clrscr;
k:=0;
for i:=1 to n do
begin
Writeln('Введите фамилию ',i);
Repeat
Readln(a[i].fam);
For j:=1 to length(a[i].fam) do
begin
if a[i].fam[j] in qwe then
begin
Writeln(a[i].fam[j]);
k:=k+1;
Writeln('Фамилия введена неверно! Попробуйте еще раз');
end;
End;
Until k=0;
write(f,a[i].fam);
Writeln('Введите номер ',i);
Repeat
k:=0;
Readln(a[i].Ntel);
For j:=1 to length(a[i].Ntel) do
begin
if a[i].Ntel[j] in qwe1 then
begin
Writeln(a[i].Ntel[j]);
k:=k+1;
Writeln('Номер введен неверно! Попробуйте еще раз');
end;
End;
Until k=0;
write(f,a[i].Ntel);
writeln('введите адрес');
readln(a[i].adres);
write(f,a[i].adres);
clrscr;
end;
close(f);
clrscr;
end;

procedure fan;
begin
reset(f);
writeln('введите фамилию нужного человека');
Repeat
k:=0;
readln(fam);
For j:=1 to length(fam) do
begin
if fam[j] in qwe then
begin
Writeln(fam[j]);
k:=k+1;
Writeln('Фамилия введена неверно! Попробуйте еще раз');
end;
End;
Until k=0;
w:=0;
q:=false;
for i:=1 to n do
if fam=a[i].fam then
begin
q:=true;
writeln('найденный человек: ',a[i].fam);
w:=w+1;
end;
if q=true then writeln('количиство его телефонов ',w,' номер телефона--> ', a[i].Ntel);
if q=false then writeln('такого нет');
writeln;
close(f);
writeln('для выхода в меню нажмите enter');
readln;
clrscr;
end;

procedure nob;
begin
writeln('введите № телефона человека');
readln(nom);
reset(f);
for i:=1 to n do
begin
writeln;
q:=false;
for i:=1 to n do
if nom=a[i].Ntel then
begin writeln('фамилия->',a[i].fam,' адрес->',a[i].adres);
q:=true;
end;
end;
if q=false then writeln('нет такого телефона');
close(f);
writeln;
writeln('для выхода в меню нажмите enter');
readln;
clrscr;
end;

procedure adr;
begin
writeln('введите адрес');
readln(adpec);
reset(f);
for i:=1 to n do
begin
writeln;
q:=false;
for i:=1 to n do
if (adpec=a[i].adres) then
begin
writeln('фамилия->',a[i].fam);
q:=true;
end;
end;
if q=false then writeln('такой улицы нет');
close(f);
writeln;
writeln('для выхода в меню нажмите enter');
readln;
clrscr;
end;

Procedure procv;
Begin
Reset(f);
Writeln('==--Базы данных--==');
Writeln('Все записи:');
For i:=1 to n do
Begin
Writeln('фамилия: ',a[i].fam,'; № телефона: ',a[i].Ntel,'; Адрес: ',a[i].adres);
End;
Close(f);
Writeln('Всего записей :',i);
writeln;
end;

Procedure doz2;{Сортировка по алфавиту}
Begin
Writeln('Сортировка по алфавиту ');
For i:=1 to n-1 do
Begin
for j:=1 to n-1 do
Begin
If a[j].fam>a[j+1].fam then
Begin
buf2:=a[j].fam;
a[j].fam:=a[j+1].fam;
a[j+1].fam:=buf2;
buf:=a[j].Ntel;
a[j].Ntel:=a[j+1].Ntel;
a[j+1].Ntel:=buf;
buf3:=a[j].adres;
a[j].adres:=a[j+1].adres;
a[j+1].adres:=buf3;
End;
End;
End;
For i:=1 to n do
Begin
Writeln(a[i].fam);
End;
End;

procedure zad1;
begin
assign(f,'aа.txt');
rewrite(f);
Repeat
Writeln('<==== Выберите дальнейшие действия ====>');
writeln('1:Начать новую запись');
writeln('2:поиск нужного человека');
writeln('3:поиск по номеру телефона');
writeln('4:поиск по улице');
writeln('5:просмотр всей данных в базе');
writeln('6:сортировка данных по алфавиту');
writeln('0:выход в главное меню');
Readln(n1);
clrscr;
Case n1 of
1:enter1;
2:fan;
3:nob;
4:adr;
5:procv;
6:doz2;
0:break;
end;
Writeln('Для продолжения нажмите ENTER');
Readln;
until n1=7;
end;

{<==------------------ текстовая программа ------------------==>}

procedure enter;
begin
clrscr;
writeln('введите кол-во запесей');
readln(n);
rewrite(f1);
clrscr;
for i:=1 to n do
begin
Writeln('Введите фамилию ',i);
Repeat
k:=0;
Readln(a[i].fam);
For j:=1 to length(a[i].fam) do
begin
if a[i].fam[j] in qwe then
begin
Writeln(a[i].fam[j]);
k:=k+1;
Writeln('Фамилия введена неверно! Попробуйте еще раз');
end;
End;
Until k=0;
write(f1,a[i].fam);
Writeln('Введите номер ',i);
Repeat
k:=0;
Readln(a[i].Ntel);
For j:=1 to length(a[i].Ntel) do
begin
if a[i].Ntel[j] in qwe1 then
begin
Writeln(a[i].Ntel[j]);
k:=k+1;
Writeln('Номер введен неверно! Попробуйте еще раз');
end;
End;
Until k=0;
write(f1,a[i].Ntel);
writeln('введите адрес');
readln(a[i].adres);
write(f1,a[i].adres);
clrscr;
end;
close(f1);
clrscr;
end;

procedure fanb;
begin
writeln('введите фамилию нужного человека');
readln(fam);
reset(f1);
w:=0;
q:=false;
for i:=1 to n do
if fam=a[i].fam then
begin
q:=true;
writeln('найденный человек: ',a[i].fam);
w:=w+1;
end;
if q=true then writeln('количиство его телефонов ',w,' номер телефона--> ', a[i].Ntel);
if q=false then writeln('такого нет');
close(f1);
writeln;
end;

procedure nodb;
begin
clrscr;
writeln('введите № телефона человека');
readln(nom);
reset(f1);
for i:=1 to n do
begin
writeln;
q:=false;
for i:=1 to n do
if (nom=a[i].Ntel) then
begin writeln('фамилия->',a[i].fam,' адрес->',a[i].adres);
q:=true;
end;
end;
if q=false then writeln('нет такого телефона');
close(f1);
writeln;
end;

procedure adreb;
begin
writeln('введите адрес');
readln(adpec);
reset(f1);
for i:=1 to n do
begin
writeln;
q:=false;
for i:=1 to n do
if (adpec=a[i].adres) then
begin
writeln('фамилия->',a[i].fam);
q:=true;
end;
end;
if q=false then writeln('такой улицы нет');
close(f1);
writeln;
end;

procedure zapb;
begin
append(f1);
i:=i+1;
n:=n+1;
writeln('введите фамилию');
readln(a[i].fam);
writeln(f1,a[i].fam);
writeln('введите номер');
readln(a[i].Ntel);
writeln(f1,a[i].Ntel);
writeln('введите адрес');
readln(a[i].adres);
writeln(f1,a[i].adres);
m:=n+1;
close(f1);
clrscr;
end;

Procedure procmb;
Begin
Reset(f1);
Writeln('==--Базы данных--==');
Writeln('Все записи:');
For i:=1 to n do
Begin
Writeln('фамилия: ',a[i].fam,'; № телефона: ',a[i].Ntel,'; Адрес: ',a[i].adres);
End;
Close(f1);
Writeln('Всего записей :',i);
writeln;
end;

Procedure doz3;{Сортировка по алфавиту}
Begin
Writeln('Сортировка по алфавиту ');
For i:=1 to n-1 do
Begin
for j:=1 to n-1 do
Begin
If a[j].fam>a[j+1].fam then
Begin
buf2:=a[j].fam;
a[j].fam:=a[j+1].fam;
a[j+1].fam:=buf2;
buf:=a[j].Ntel;
a[j].Ntel:=a[j+1].Ntel;
a[j+1].Ntel:=buf;
buf3:=a[j].adres;
a[j].adres:=a[j+1].adres;
a[j+1].adres:=buf3;
End;
End;
End;
For i:=1 to n do
Begin
Writeln(a[i].fam);
End;
End;

procedure zad2;
begin
assign(f1,'a.txt');
rewrite(f1);
Repeat

Writeln('<==== Выберите дальнейшие действия ====>');
writeln('1:Начать новую запись');
writeln('2:Продолжить запись');
writeln('3:поиск нужного человека');
writeln('4:поиск по номеру телефона');
writeln('5:поиск по улице ');
writeln('6:просмотр всех данных ');
writeln('7:сортировка данных по алфавиту');
writeln('0:Выход из программы');
Readln(n1);
clrscr;
Case n1 of
1:enter;
2:zapb;
3:fanb;
4:nodb;
5:adreb;
6:procmb;
7:doz3;
0:break;
end;
until n1=8
end;

{<========------------------ справка -------------------========>}

procedure c;
begin
clrscr;
writeln('===---текстовая пограмма:---===');
writeln('предназначена для создания телефонной базы данных (с дозаписью)');
writeln('в данной программе можно осужествлять запись и дозапись в базу данных,');
writeln('также осуществлять поиск в базе по фамилии, номеру телефона и адресу');
writeln('при вводе цифры 1 вы начнете создавать базу, где указываются ');
writeln('количетво первоначальных данных, а затем все остальные данные');
writeln('при вводе цифры 2 можно дозаписать созданную ранее базу');
writeln('при вводе цифры 3 производится поиск нужного вам человек в');
writeln('созданной ранее базе');
writeln('при вводе цифры 4 вы сможете получить сведения о человеке по введенному номеру телефона');
writeln('при вводе цифры 5 осуществляется поиск по адресу');
writeln('при вводе цифры 6 осуществится просмотр всей базы данных');
writeln('при вводе цифры 0 осуществится выход в главное меню');
end;

procedure cc;
begin
clrscr;
writeln('===---типизированная программа:---===');
writeln('предназначена для создания телефонной базы данных (без дозаписи)');
writeln('в данной программе можно осужествлять запись в базу данных, также');
writeln('осуществляеть поиск в базе по фамилии, номеру телефона и адресу');
writeln('при вводе цифры 1 вы начнете создавать базу, где указываются ');
writeln('количетво первоначальных данных, а затем все остальные данный');
writeln('при вводе цифры 2 производит поиск нужного вам человека в ');
writeln('созданной ранее базе');
writeln('при вводе цифры 3 вы сможете получить сведения о человеке по введенному номеру телефона');
writeln('при вводе цифры 4 осуществляется поиск по адресу');
writeln('при вводе цифры 5 осуществится просмотр всей базы данных');
writeln('при вводе цифры 0 осуществится выход в главное меню');
end;

procedure help;
begin
writeln('Cправка предназначена для ознакомления с программами');
writeln;
writeln('для какой программы вы хотите получить справку 1 или 2?');
writeln;
writeln('чтобы прочитать справку введите-> 1 или 2');
readln(v);
if v=1 then cc else c;
writeln;
writeln('для выхода введите-> 0');
readln(n1);
clrscr;
Repeat
case n1 of
0:break;
end;
until n1=0
end;

{<=====------------------ главное меню -------------------=====>}

procedure menu;
begin
Repeat
Writeln('<==== Выберите дальнейшие действия ====>');
writeln('1:работа с типизированным файлом');
writeln('2:работа с текстовым файлом');
writeln('3:справка');
writeln('0:Выход из программы');
Readln(n1);
clrscr;
Case n1 of
1:zad1;
2:zad2;
3:help;
0:halt(1);
end;
until n1>0
end;

{<===------------------ основная программа ------------------===>}

begin
textcolor(green);
textsize(9);
menu;
end.

Обсуждение

Неизвестный

17.04.2010, 13:27

общий

sannek2:
Можно поподробнее:
1 Чем должны отличаться две программы?
2 Что это за выдержка из задачи - кусок должен присутствовать в обоих?
3 Что такое "возраст1" и "возраст2"?
4 У вас работает пример, который вы приложили?

Неизвестный

17.04.2010, 13:31

общий

Вам нужно обязательно по этому файлу сделать? Или можно аналогичное, но свое? Мне не все, мягко говоря, в предложенном варианте нравится.
И еще уж не pascalABCDEFGH... ли (не люблю его)

Неизвестный

17.04.2010, 13:34

общий

Помогите пожалуйста.очень прошу.
1)Одну программу нужно сделать по теме текстовые файлы а другую по теме типизированные файлы.
2)Это было в задаче,а возраст1 и возраст2 это тоже из задачи
3)Пример работает но там суть похожая.Там про человека.и в примере две программы обьеденены в процедуру чтобы было удобнее
Пример я взял у знакомых у них другое название но сделано по теме типизированые и текстовые файлы

Неизвестный

17.04.2010, 13:36

общий

В приложении там пример но другой программы.но там тоже две программы текстовые и типизированые.но они обьеденены в процедуру для удобства.

Неизвестный

17.04.2010, 13:40

общий

sannek2:
В чём смысловая разница между "возраст1" и "возраст2"? Можно ли один тогда выкинуть?

Неизвестный

17.04.2010, 13:41

общий

Boriss:
Можно мне ссылку на pascalABCDEFGH, в обычном у меня не компилится строка "a:array[1..1000] of tel;" и ещё кое что.

Неизвестный

17.04.2010, 13:41

общий

можно и выкунуть.помогите сделать плизз

Неизвестный

17.04.2010, 13:44

общий

Паскаль АВС http://files.freesoft.ru/rep/666749/PABCDistr.zip

Неизвестный

17.04.2010, 18:11

общий

18.04.2010, 12:03

это ответ

Здравствуйте, sannek2.
Решение в приложении. Программу не проверял, просто перебил пример. Если что-то не будет работать, обращайся.

Приложение:
uses
crt;

const
qwe: set of char = ['0'..'9'];
qwe1: set of char = ['а'..'я'];
type
toy = record
name: String;
cost: Integer;
color: String;
age1: Byte;
age2: Byte;
end;
var
f1: text;
f: file of string;
a: array[1..1000] of toy;
i, n, n1, v, w, k, j: byte;
fam, adpec, buf, buf2, buf3: string;
nom: string;
q: boolean;
cost: Integer;
age: Byte;
name: String;
choice: Byte;

{<------------------ типизированная программа ------------------>}
procedure enter1;
begin
Clrscr;
Writeln('Введите количество записей');
Readln(n1);
Rewrite(f);
Clrscr;
for i := 1 to n1 do begin
Writeln('Введите название игрушки ', i);
repeat
Readln(a[i].name);
k := 0;
for j := 1 to length(a[i].name) do
if a[i].name[j] in qwe then begin
Writeln(a[i].name[j]);
k := k + 1;
Writeln('Название введено неверно! Попробуйте еще раз');
end;
until k = 0;
Write(f, a[i].name);
Writeln('Введите цену ', i);
Readln(a[i].cost);
Write(f, IntToStr(a[i].cost));
Writeln('Введите цвет игрушки ', i);
repeat
Readln(a[i].color);
k := 0;
for j := 1 to length(a[i].color) do
if a[i].color[j] in qwe then begin
Writeln(a[i].color[j]);
k := k + 1;
Writeln('Цвет введён неверно! Попробуйте еще раз');
end;
until k = 0;
Write(f, a[i].color);
Writeln('Введите рекомендуемый минимальный возраст для игрушки ', i);
Readln(a[i].age1);
Write(f, IntToStr(a[i].age1));
Writeln('Введите рекомендуемый максимальный возраст для игрушки ', i);
Readln(a[i].age2);
Write(f, IntToStr(a[i].age2));
Clrscr;
end;
Close(f);
Clrscr;
end;

procedure req11;
begin
Reset(f);
Writeln('Введите максимально допустимую цену игрушки');
Readln(cost);
Writeln('Введите возраст ребёнка');
Readln(age);
w := 0;
q := False;
for i := 1 to n1 do
if (cost <= a[i].cost) and (age >= a[i].age1) and (age <= a[i].age2) then
begin
q := True;
Writeln('Найденная игрушка: ', a[i].name);
w := w + 1;
end;
if q then Writeln('Найденно игрушек: ', w)
else Writeln('Игрушек не найденно');
Writeln;
Close(f);
Writeln('Для выхода в меню нажмите ENTER');
Readln;
Clrscr;
end;

procedure req12;
var
Cheapest: Integer;
begin
Writeln('Введите название игрушки');
repeat
k := 0;
readln(name);
for j := 1 to length(name) do
if name[j] in qwe then begin
Writeln(name[j]);
k := k + 1;
Writeln('Название введено неверно! Попробуйте еще раз');
end;
until k = 0;
Reset(f);
Cheapest := -1;
for i := 1 to n1 do
if (a[i].name = name) and ((a[i].cost < Cheapest) or
(Cheapest = -1)) then Cheapest := a[i].cost;
if Cheapest > -1 then Writeln('Самая дешёвая цена для игрушки с',
'заданным названием - ', Cheapest)
else Writeln('Игрушки с таким названием не найденно');
Close(f);
Writeln;
Writeln('Для выхода в меню нажмите ENTER');
Readln;
Clrscr;
end;

procedure req13;
type
ColorCount = record
color: String;
count: Byte;
end;
var
ccAr: array[1..10] of ColorCount;
ccArLen: Byte;
mostFreq: Byte;
begin
Reset(f);
for i := 1 to n1 do
for j := 1 to ccArLen do begin
if ccAr[j].color = a[i].color then begin
Inc(ccAr[j].count);
break;
end;
if j = ccArLen then begin
Inc(ccArLen);
ccAr[ccArLen].color := a[i].color;
ccAr[ccArLen].count := 1;
end;
end;
mostFreq := 1;
for i := 2 to ccArLen do
if ccAr[i].count > ccAr[mostFreq].count then mostFreq := i;
Writeln('Самый частый цвет игрушек - ', ccAr[mostFreq].color);
Close(f);
Writeln;
Writeln('Для выхода в меню нажмите ENTER');
Readln;
Clrscr;
end;

procedure zapv;
begin
Rewrite(f);
for i := 1 to n do begin
Write(f, a[i].name);
Write(f, IntToStr(a[i].cost));
Write(f, a[i].color);
Write(f, IntToStr(a[n].age1));
Write(f, IntToStr(a[n].age2));
end;
n1 := n1 + 1;
Writeln('Введите название игрушки');
Readln(a[n1].name);
Write(f, a[n1].name);
Writeln('Введите цену');
Readln(a[n1].cost);
Write(f, IntToStr(a[n1].cost));
Writeln('Введите цвет');
Readln(a[n1].color);
Write(f, a[n1].color);
Writeln('Введите рекомендуемый минимальный возраст для игрушки ', i);
Readln(a[n1].age1);
Write(f, IntToStr(a[n1].age1));
Writeln('Введите рекомендуемый максимальный возраст для игрушки ', i);
Readln(a[n1].age2);
Write(f, IntToStr(a[n1].age2));
Close(f);
Clrscr;
end;

procedure procv;
begin
Reset(f);
Writeln('==--Базы данных--==');
Writeln('Все записи:');
for i := 1 to n1 do
Writeln('Название игрушки: ', a[i].name, '; Цена: ', a[i].cost,
'; Цвет: ', a[i].color, '; Возраст: от ', a[i].age1, ' до ',
a[i].age2);
Close(f);
Writeln('Всего записей :',n1);
Writeln;
end;

procedure doz2;{Сортировка по алфавиту}
var
sBuf: String;
iBuf: Integer;
bBuf: Byte;
begin
Writeln('Сортировка по алфавиту ');
for i := 1 to n1 - 1 do
for j := i + 1 to n do
if a[i].name > a[j].name then begin
sBuf := a[i].name;
a[i].name := a[j].name;
a[j].name := sBuf;
iBuf := a[i].cost;
a[i].cost := a[j].cost;
a[j].cost := iBuf;
sBuf := a[i].color;
a[i].color := a[j].color;
a[j].color := sBuf;
bBuf := a[i].age1;
a[i].age1 := a[j].age1;
a[j].age1 := bBuf;
bBuf := a[i].age2;
a[i].age2 := a[j].age2;
a[j].age2 := bBuf;
end;
for i := 1 to n1 do Writeln(a[i].name);
end;

procedure zad1;
begin
Assign(f, 'aа.txt');
repeat
Writeln('<==== Выберите дальнейшие действия ====>');
Writeln('1: Начать новую запись');
Writeln('2: Продолжить запись');
Writeln('3: Поиск игрушек по цене и возрасту');
Writeln('4: Поиск самой дешёвой игрушки по названию');
Writeln('5: Определение самого распространённого цвета игрушек');
Writeln('6: Просмотр всех данных в базе');
Writeln('7: Сортировка данных по алфавиту');
Writeln('0: Выход в главное меню');
Readln(choice);
Clrscr;
Case choice of
1: enter1;
2: zapv;
3: req11;
4: req12;
5: req13;
6: procv;
7: doz2;
0: break;
end;
Writeln('Для продолжения нажмите ENTER');
Readln;
until choice = 7;
end;

{<==------------------ текстовая программа ------------------==>}
procedure enter;
begin
Clrscr;
Writeln('Введите количество записей');
Readln(n);
Rewrite(f1);
Clrscr;
for i := 1 to n do begin
Writeln('Введите название игрушки ', i);
repeat
Readln(a[i].name);
k := 0;
for j := 1 to length(a[i].name) do
if a[i].name[j] in qwe then begin
Writeln(a[i].name[j]);
k := k + 1;
Writeln('Название введено неверно! Попробуйте еще раз');
end;
until k = 0;
Write(f1, a[i].name);
Writeln('Введите цену ', i);
Readln(a[i].cost);
Write(f1, IntToStr(a[i].cost));
Writeln('Введите цвет игрушки ', i);
repeat
Readln(a[i].color);
k := 0;
for j := 1 to length(a[i].color) do
if a[i].color[j] in qwe then begin
Writeln(a[i].color[j]);
k := k + 1;
Writeln('Цвет введён неверно! Попробуйте еще раз');
end;
until k = 0;
Write(f1, a[i].color);
Writeln('Введите рекомендуемый минимальный возраст для игрушки ', i);
Readln(a[i].age1);
Write(f1, IntToStr(a[i].age1));
Writeln('Введите рекомендуемый максимальный возраст для игрушки ', i);
Readln(a[i].age2);
Write(f1, IntToStr(a[i].age2));
Clrscr;
end;
Close(f1);
Clrscr;
end;

procedure req21;
begin
Reset(f1);
Writeln('Введите максимально допустимую цену игрушки');
Readln(cost);
Writeln('Введите возраст ребёнка');
Readln(age);
w := 0;
q := False;
for i := 1 to n do
if (cost <= a[i].cost) and (age >= a[i].age1) and (age <= a[i].age2) then
begin
q := True;
Writeln('Найденная игрушка: ', a[i].name);
w := w + 1;
end;
if q then Writeln('Найденно игрушек: ', w)
else Writeln('Игрушек не найденно');
Writeln;
Close(f1);
Writeln('Для выхода в меню нажмите ENTER');
Readln;
Clrscr;
end;

procedure req22;
var
Cheapest: Integer;
begin
Writeln('Введите название игрушки');
repeat
k := 0;
readln(name);
for j := 1 to length(name) do
if name[j] in qwe then begin
Writeln(name[j]);
k := k + 1;
Writeln('Название введено неверно! Попробуйте еще раз');
end;
until k = 0;
Reset(f1);
Cheapest := -1;
for i := 1 to n do
if (a[i].name = name) and ((a[i].cost < Cheapest) or
(Cheapest = -1)) then Cheapest := a[i].cost;
if Cheapest > -1 then Writeln('Самая дешёвая цена для игрушки с',
'заданным названием - ', Cheapest)
else Writeln('Игрушки с таким названием не найденно');
Close(f1);
Writeln;
Writeln('Для выхода в меню нажмите ENTER');
Readln;
Clrscr;
end;

procedure req23;
type
ColorCount = record
color: String;
count: Byte;
end;
var
ccAr: array[1..10] of ColorCount;
ccArLen: Byte;
mostFreq: Byte;
begin
Reset(f1);
for i := 1 to n do
for j := 1 to ccArLen do begin
if ccAr[j].color = a[i].color then begin
Inc(ccAr[j].count);
break;
end;
if j = ccArLen then begin
Inc(ccArLen);
ccAr[ccArLen].color := a[i].color;
ccAr[ccArLen].count := 1;
end;
end;
mostFreq := 1;
for i := 2 to ccArLen do
if ccAr[i].count > ccAr[mostFreq].count then mostFreq := i;
Writeln('Самый частый цвет игрушек - ', ccAr[mostFreq].color);
Close(f1);
Writeln;
Writeln('Для выхода в меню нажмите ENTER');
Readln;
Clrscr;
end;

procedure zapb;
begin
Append(f1);
n := n + 1;
Writeln('Введите название игрушки');
Readln(a[n].name);
Write(f1, a[n].name);
Writeln('Введите цену');
Readln(a[n].cost);
Write(f1, IntToStr(a[n].cost));
Writeln('Введите цвет');
Readln(a[n].color);
Write(f1, a[n].color);
Writeln('Введите рекомендуемый минимальный возраст для игрушки ', i);
Readln(a[n].age1);
Write(f1, IntToStr(a[n].age1));
Writeln('Введите рекомендуемый максимальный возраст для игрушки ', i);
Readln(a[n].age2);
Write(f1, IntToStr(a[n].age2));
Close(f1);
Clrscr;
end;

procedure procmb;
begin
Reset(f1);
Writeln('==--Базы данных--==');
Writeln('Все записи:');
for i := 1 to n do
Writeln('Название игрушки: ', a[i].name, '; Цена: ', a[i].cost,
'; Цвет: ', a[i].color, '; Возраст: от ', a[i].age1, ' до ',
a[i].age2);
Close(f1);
Writeln('Всего записей :',i);
Writeln;
end;

procedure doz3;{Сортировка по алфавиту}
var
sBuf: String;
iBuf: Integer;
bBuf: Byte;
begin
Writeln('Сортировка по алфавиту ');
for i := 1 to n - 1 do
for j := i + 1 to n do
if a[i].name > a[j].name then begin
sBuf := a[i].name;
a[i].name := a[j].name;
a[j].name := sBuf;
iBuf := a[i].cost;
a[i].cost := a[j].cost;
a[j].cost := iBuf;
sBuf := a[i].color;
a[i].color := a[j].color;
a[j].color := sBuf;
bBuf := a[i].age1;
a[i].age1 := a[j].age1;
a[j].age1 := bBuf;
bBuf := a[i].age2;
a[i].age2 := a[j].age2;
a[j].age2 := bBuf;
end;
for i := 1 to n do Writeln(a[i].name);
end;

procedure zad2;
begin
Assign(f1,'a.txt');
repeat
Writeln('<==== Выберите дальнейшие действия ====>');
Writeln('1: Начать новую запись');
Writeln('2: Продолжить запись');
Writeln('3: Поиск игрушек по цене и возрасту');
Writeln('4: Поиск самой дешёвой игрушки по названию');
Writeln('5: Определение самого распространённого цвета игрушек');
Writeln('6: Просмотр всех данных ');
Writeln('7: Сортировка данных по алфавиту');
Writeln('0: Выход из программы');
Readln(choice);
Clrscr;
case choice of
1: enter;
2: zapb;
3: req21;
4: req22;
5: req23;
6: procmb;
7: doz3;
0: break;
end;
until choice = 8;
end;

{<========------------------ справка -------------------========>}

procedure c;
begin
Clrscr;
Writeln('===---текстовая пограмма:---===');
Writeln('предназначена для создания базы данных игрушек (с дозаписью)');
Writeln('в данной программе можно осуществлять запись и дозапись в базу данных,');
Writeln('также осуществлять выборки из базы по различным параметрам');
Writeln('при вводе цифры 1 вы начнете создавать базу, где указываются ');
Writeln('количетво первоначальных данных, а затем все остальные данные');
Writeln('при вводе цифры 2 можно дозаписать созданную ранее базу');
Writeln('при вводе цифры 3 производится поиск игрушек,цена которых не');
Writeln('превышает даную и которые подходят детям даного возраста');
Writeln('при вводе цифры 4 производится поиск самой дешёвой игрушки с заданным названием');
Writeln('при вводе цифры 5 опрежеляется самый распространённый цвет игрушек');
Writeln('при вводе цифры 6 осуществится просмотр всей базы данных');
Writeln('при вводе цифры 0 осуществится выход в главное меню');
end;

procedure cc;
begin
clrscr;
Writeln('===---типизированная программа:---===');
Writeln('предназначена для создания базы данных игрушек (без дозаписи)');
Writeln('в данной программе можно осуществлять запись в базу данных,');
Writeln('также осуществлять выборки из базы по различным параметрам');
Writeln('при вводе цифры 1 вы начнете создавать базу, где указываются ');
Writeln('количетво первоначальных данных, а затем все остальные данные');
Writeln('при вводе цифры 2 производится поиск игрушек,цена которых не');
Writeln('превышает даную и которые подходят детям даного возраста');
Writeln('при вводе цифры 3 производится поиск самой дешёвой игрушки с заданным названием');
Writeln('при вводе цифры 4 опрежеляется самый распространённый цвет игрушек');
Writeln('при вводе цифры 5 осуществится просмотр всей базы данных');
Writeln('при вводе цифры 0 осуществится выход в главное меню');
end;

procedure help;
begin
Writeln('Cправка предназначена для ознакомления с программами');
Writeln;
Writeln('для какой программы вы хотите получить справку 1 или 2?');
Writeln;
Writeln('чтобы прочитать справку введите-> 1 или 2');
Readln(v);
if v = 1 then cc else c;
Writeln;
Writeln('для выхода введите-> 0');
Readln(n1);
Clrscr;
repeat
case n1 of
0: break;
end;
until n1=0
end;

{<=====------------------ главное меню -------------------=====>}
procedure menu;
begin
Repeat
Writeln('<==== Выберите дальнейшие действия ====>');
Writeln('1: работа с типизированным файлом');
Writeln('2: работа с текстовым файлом');
Writeln('3: справка');
Writeln('0: Выход из программы');
Readln(choice);
Clrscr;
case choice of
1: zad1;
2: zad2;
3: help;
0: halt(1);
end;
until choice > 0
end;

{<===------------------ основная программа ------------------===>}
Begin
textcolor(green);
textsize(9);
menu;
End.

Спасибо огромное

Форма ответа

Отправка постов/ответов доступна только зарегистрированным и подтвержденным пользователям.

Если Вы уже зарегистрированы на Портале - войдите в систему, если Вы еще не регистрировались - пройдите простую процедуру регистрации.