Хостинг портала RFpro.ru:
Московский хостер
Профессиональный ХОСТИНГ на базе Linux x64 и Windows x64

РАССЫЛКИ ПОРТАЛА RFPRO.RU

Чемпионы рейтинга экспертов в этой рассылке

lamed Статус: Практикант Рейтинг: 2359 ∙ повысить рейтинг »

Boriss Статус: Академик Рейтинг: 2092 ∙ повысить рейтинг »

_Ayl_ Статус: Практикант Рейтинг: 1865 ∙ повысить рейтинг »

Вопрос № 177886: Сделать две программы: 1)программу по теме текстовые файлы. 2)программу по теме типизированные файлы. Из задачи: type игрушка=record название:string; цена:integer; цвет:string; возраст1:1..16; возраст2:1..16; end...

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

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

Отправлен: 17.04.2010, 07:31
Вопрос задал: sannek2, Посетитель
Всего ответов: 1
Страница вопроса »

Приложение:
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.

Ответ отправил: Алексей S, 3-й класс
Ответ отправлен: 17.04.2010, 18:11
Номер ответа: 260876

Оценка ответа: 5
Комментарий к оценке:
Спасибо огромное

Вам помог ответ? Пожалуйста, поблагодарите эксперта за это! Как сказать этому эксперту "спасибо"?

Отправить SMS #thank 260876 на номер 1151 (Россия) | Еще номера »

Отправить WebMoney: Неплохо (30 руб.) Хорошо (40 руб.) Отлично (55 руб.) БЛЕСТЯЩЕ! (80 руб.)

Оценить выпуск »
Нам очень важно Ваше мнение об этом выпуске рассылки!

Задать вопрос экспертам этой рассылки »