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

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

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

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

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

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

Вопрос № 178029: Уважаеиые эксперты,помогите решить задачу по записям. 1.Из ассортиментов конфет, выпускаемой фабрикой. Выбрать те изделия,которые стоят от 100 до 200 рублей за килограм. Указать срок их годности и номера магазинов в которых они имется в продажи.

Уважаеиые эксперты,помогите решить задачу по записям.
1.Из ассортиментов конфет, выпускаемой фабрикой. Выбрать те изделия,которые стоят от 100 до 200 рублей за килограм. Указать срок их годности и номера магазинов в которых они имется в продажи.
2.Распечатать список учеников музыкальной школы которые учатся играть на скрипке. Указать сколько лет они занимаются музыкой и принимали ли участия в конкурсах.

Отправлен: 25.04.2010, 08:31
Вопрос задал: Дмитрий Мороз, Посетитель
Всего ответов: 2
Страница вопроса »

Приложение:
{ Из ассортимента конфет, выпускаемой фабрикой, выбрать те изделия, которые стоят от 100 до 200 рублей за килограмм. Указать срок их годности и номера магазинов, в которых они имеются в продаже. } program q178029a; uses crt; const MAX_SHOP = 2; type TDate = record year : word; month: byte; day : byte; end; PTCandy = ^TCandy; TCandy = record next : PTCandy; name : string; { название } price: real; { цена } date : TDate; { срок годности } shops : array [0..MAX_SHOP] of word; { номера магазинов } end; var nTotal : integer; { общее кол-во корректных записей в файле } { удаление из строки начальных и конечных пробелов } function trim( s: string ): string; var i,j : integer; begin i := length( s ); while i > 0 do begin { пропускаем конечные пробелы } if (s[i] <> \' \') and (s[i] <> #9) then break; dec( i ); end; j := 1; while j <= i do begin { пропускаем начальные пробелы } if (s[j] <> \' \') and (s[j] <> #9) then break; inc( j ); end; trim := copy( s, j, i-j+1 ); end; const daysInMonth: array [1..12] of byte = ( 31, 28, 31, 30, 31, 30, 31, 31, 30, 31, 30, 31 ); { преобразование строки вида yyyy.mm.dd в дату } function str2date( s: string; var d: TDate ): boolean; var v, i1, i2, code : integer; begin str2date := false; { год } i1 := pos( \'.\', s ); if i1 = 0 then exit; val( trim(copy( s, 1, i1-1 )), v, code ); if (v < 2000) or (v > 2020) then exit; with d do begin year := v; { месяц } s[i1] := \' \'; i2 := pos( \'.\', s ); if i2 = 0 then exit; inc( i1 ); val( trim(copy( s, i1, i2-i1 )), v, code ); if (v < 1) or (v > 12) then exit; month := v; { день } val( trim(copy( s, i2+1, 100 )), v, code ); if v < 1 then exit; if v > daysInMonth[month] then begin if month <> 2 then exit; { в данном диапазоне лет (2000-2020) достаточно такой простой проверки на високосный год } if (v > 29) or ((year mod 4) <> 0) then exit; end; day := v; end; { with } str2date := true; end; { разбор одной строки и добавление в конец списка } function parseLine( s: string; var pList, pListEnd: PTCandy ): boolean; var i, i1, i2, code : integer; sdate: string; m : word; r : TCandy; pR: PTCandy; begin parseLine := false; { при любой ошибке выходим и возвращаем false } { название; цена; срок годности; магазин1[; магазин2[; магазин3]] } { срок годности (дата) в формате yyyy.mm.dd } { 1. название } i1 := pos( \';\', s ); if i1 = 0 then exit; r.name := trim(copy( s, 1, i1-1 )); { 2. цена } s[i1] := \' \'; i2 := pos( \';\', s ); if i2 = 0 then exit; inc( i1 ); val( trim(copy( s, i1, i2-i1 )), r.price, code ); if (code <> 0) or (r.price < 1) then exit; { 3. срок годности } s[i2] := \' \'; i1 := pos( \';\', s ); if i1 = 0 then exit; inc( i2 ); sdate := trim(copy( s, i2, i1-i2 )); if not str2date( sdate, r.date ) then exit; { 4. читаем номера магазинов (от одного до трех) } for i := 0 to MAX_SHOP do r.shops[i] := 0; for i := 0 to MAX_SHOP do begin s[i1] := \' \'; i2 := pos( \';\', s ); if i2 = 0 then i2 := length( s ) + 1; inc( i1 ); val( trim(copy( s, i1, i2-i1 )), m, code ); if code <> 0 then exit; r.shops[i] := m; if i2 > length( s ) then break; i1 := i2; end; { должен быть задан хотя бы один магазин } if r.shops[0] = 0 then exit; { добавляем новую запись в конец списка, так что при просмотре списка записи идут в том же порядке, что и в файле } new( pR ); r.next := nil; pR^ := r; if pListEnd <> nil then pListEnd^.next := pR else pList := pR; pListEnd := pR; parseLine := true; end; { чтение файла с заданным именем и формирование списка } procedure readFile( fname: string; var pList, pListEnd: PTCandy ); var f: text; s: string; begin assign( f, fname ); reset( f ); write( \'Загрузка данных...\' ); while not eof(f) do begin { читаем по одной строке до конца файла } readln( f, s ); if parseLine( s, pList, pListEnd ) then inc( nTotal ); { подсчитываем число записей } end; close( f ); writeln( \'OK\' ); end; { дополнение строки пробелами (для форматированного вывода) } function pad_with_spaces( s: string; len: integer ): string; var n: integer; begin n := length( s ); while n < len do begin inc(n); s[n] := \' \'; end; s[0] := chr( n ); pad_with_spaces := s; end; { вывод списка на экран } procedure print_list( pList: PTCandy ); var i: word; begin writeln( \'Название Цена Срок годности Магазины\' ); writeln( \'-----------------------------------------------------\' ); while pList <> nil do begin with pList^ do begin write( pad_with_spaces( name, 20 ), price:7:2, date.year:6, \'.\', date.month:2, \'.\', date.day:2, \' \' ); for i := 0 to MAX_SHOP do begin if shops[i] = 0 then break; if i <> 0 then write(\',\'); write( shops[i]:4 ); end; writeln; end; pList := pList^.next; end; writeln( \'-----------------------------------------------------\' ); end; { Выбрать те изделия,которые стоят от 100 до 200 рублей за килограмм. Указать срок их годности и номера магазинов, в которых они имеются в продаже. } procedure process( pList: PTCandy ); var i: word; begin writeln( \'Конфеты стоимостью от 100 до 200 рублей за килограмм:\' ); writeln( \'-----------------------------------------------------\' ); writeln( \'Название Цена Срок годности Магазины\' ); writeln( \'-----------------------------------------------------\' ); while pList <> nil do begin with pList^ do if (price >= 100.0) and (price <= 200.0) then begin write( pad_with_spaces( name, 20 ), price:7:2, date.year:6, \'.\', date.month:2, \'.\', date.day:2, \' \' ); for i := 0 to MAX_SHOP do begin if shops[i] = 0 then break; if i <> 0 then write(\',\'); write( shops[i]:4 ); end; writeln; end; pList := pList^.next; end; writeln( \'-----------------------------------------------------\' ); end; { добавление новой записи } procedure add_rec( var pList, pListEnd : PTCandy ); var i, code : integer; s : string; r : TCandy; pR: PTCandy; begin write( \'Название: \' ); readln( s ); r.name := trim( s ); write( \'Цена: \' ); readln( r.price ); write( \'Срок годности (гггг.мм.дд): \' ); readln( s ); if not str2date( s, r.date ) then exit; for i := 0 to MAX_SHOP do r.shops[i] := 0; for i := 0 to MAX_SHOP do begin write( \'Номер магазина \', i+1, \' или [Enter] для окончания: \'); readln( s ); s := trim(s); if length(s) = 0 then break; val( s, r.shops[i], code ); if code <> 0 then exit; end; { должен быть задан хотя бы один магазин } if r.shops[0] = 0 then exit; { добавляем новую запись в конец списка, так что при просмотре списка записи идут в том же порядке, что и в файле } new( pR ); r.next := nil; pR^ := r; if pListEnd <> nil then pListEnd^.next := pR else pList := pR; pListEnd := pR; end; { удаление всего списка } procedure clear_data( pList: PTCandy ); var p: PTCandy; begin while pList <> nil do begin p := pList^.next; dispose( pList ); pList := p; end; end; { сохранение списка в файл } procedure save_data( fname: string; pList: PTCandy ); var i: word; f: text; begin assign( f, fname ); rewrite( f ); write( \'Сохранение данных в файл "\', fname, \'" ...\' ); while pList <> nil do begin with pList^ do begin write( f, name, \';\', price:7:2, \';\', date.year, \'.\', date.month, \'.\', date.day, \';\' ); for i := 0 to MAX_SHOP do begin if shops[i] = 0 then break; if i <> 0 then write( f, \';\' ); write( f, shops[i] ); end; writeln( f ); end; pList := pList^.next; end; close( f ); writeln( \'OK\' ); end; { --------------------------------------------------------- } { функции-обертки, использующие глобальные переменные } var pList, pListEnd : PTCandy; fname : string; procedure load_data; begin write( \'Введите имя файла с данными: \' ); readln( fname ); readFile( fname, pList, pListEnd ); end; { сохранение данных в файл под другим именем } procedure save_as( pList: PTCandy ); begin write( \'Введите имя файла: \' ); readln( fname ); save_data( fname, pList ); end; { --------------------------------------------------------- } var ch: char; begin pList := nil; pListEnd := nil; nTotal:= 0; fname := \'\'; repeat writeln( \'-------------------------\' ); writeln( \'1. Загрузить из файла\'#13#10\'2. Новая запись\'#13#10\'3. Сохранить\'#13#10\'4. Сохранить как...\' ); writeln( \'5. Вывести на экран\'#13#10\'6. Обработать\'#13#10\'7. Очистить данные\'#13#10\'0. Выход\' ); writeln( \'-------------------------\' ); ch := readkey; case ch of \'1\': load_data; \'2\': add_rec( pList, pListEnd ); \'3\': if fname = \'\' then save_as( pList) else save_data( fname, pList ); \'4\': save_as( pList ); \'5\': print_list( pList ); \'6\': process( pList ); \'7\': begin clear_data( pList ); pList := nil; pListEnd := nil; end; end; until ch = \'0\'; clear_data( pList ); end.

Ответ отправил: amnick, 10-й класс
Ответ отправлен: 29.04.2010, 22:02
Номер ответа: 261111

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

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

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

Приложение:
program p178029; { Из ассортимента конфет, выпускаемых фабрикой, выбрать изделия стоимостью от 100 до 200 рублей за килограмм. Указать срок их годности и номера магазинов, в которых они имеются в продаже. } uses crt; const TotalSweets = 10; { максимально используемое количество записей в массиве конфет } TotalShops = 5; { максимально возможное количество магазинов } type TName = string[10]; TShops = array[1..TotalShops] of 0..1; { массив магазинов } TSweet = record { запись о сорте конфет и магазинах } name: TName; { сорт } price: integer; { цена } time: integer; { срок годности } sh: TShops; { массив магазинов } end; TTrade = record shops: array[1..TotalSweets] of TSweet; { массив записей о конфетах, каждая содержит, в том числе, массив магазинов } lines: integer; { использовано строк в массиве конфет, для печати } end; TSweetFile = file of TSweet; { файл записей о конфетах } var iChoice : integer; { выбранный пункт меню } fH: TSweetFile; { обрабатываемый файл } IsOpen: boolean; { признак: файл открыт?} trade: TTrade; { массив конфет } procedure Create( var fH: TSweetFile ); var fName: string; { имя файла } begin { если открыт, закроем } if IsOpen then begin Close( fH ); IsOpen := false; end; write(\'Имя файла:\'); readln(fName); {$I-} Assign(fH, fName); Rewrite(fH); {$I+} if (IOResult <> 0) then Writeln(\'Файл уже существует\') else begin IsOpen := true; Writeln(\'Файл успешно создан\'); end; readln; end; { Create } procedure InsertOrUpdate( var fH: TSweetFile ); var sw: TSweet; { запись о конфете для считывания из файла и сохранения в файл } count: integer; { число вводимых записей } i: integer; { номер вводмой записи } j: integer; { счетчик числа магазинов } { временные переменные для считывания с клавиатуры сведений о поставке } name: TName; {} price: integer; {} shop: integer; {} time: integer; { срок годности} found: boolean; { обнаружена запись о сорте? } begin if not (IsOpen) then begin writeln(\'Файл не открыт\'); readln; exit; end; { Диалоговый ввод данных } GotoXY(1,8); write( \'Число поставок\' ); GotoXY(20,8); readln( count ); for i:= 1 to count do begin GotoXY(1,10); write(\'Название конфет:\'); GotoXY(1,11); write(\'Цена:\'); GotoXY(1,12); write(\'Срок:\'); GotoXY(1,13); write(\'Магазин:\'); GotoXY( 20, 10); readln( name ); GotoXY( 20, 11); readln( price ); GotoXY( 20, 12); readln( time ); GotoXY( 20, 13); readln( shop ); seek(fH, 0); { Есть ли уже такие конфеты ? } found := false; while not( eof( fH ) ) and not(found) do begin read( fH, sw ); if (sw.name = name) then found := true; { Конфеты в файле найдены } end; sw.sh[shop] := 1; if found then { редактируем запись о конфетах } begin sw.sh[shop] := 1; seek( fH, filepos( fH )-1); write( fH, sw ); end else begin { добавляем запись о конфетах } for j:= 1 to TotalShops do sw.sh[j] := 0; sw.sh[shop] := 1; sw.name := name; sw.price := price; sw.time := time; seek( fH, FileSize( fH ) ); write( fH, sw ); end; end; readln; end; { Input } procedure Menu; begin clrscr; Writeln( \' 0. Выход\' ); Writeln( \' 1. Создание файла\' ); Writeln( \' 2. Открытие файла\' ); Writeln( \' 3. Ввод/корректировка\' ); Writeln( \' 4. Печать\' ); Writeln( \' 5. Конфеты от 100 до 200 рублей\' ); Write( \' Выбран пункт:\'); end; { Menu } procedure Open( var fH: TSweetFile ); { Открываем файл } var fName: string; { имя файла } begin { если открыт, закроем } if IsOpen then begin Close( fH ); IsOpen := false; end; write(\'Имя файла:\'); readln(fName); {$I-} Assign(fH, fName); Reset(fH); {$I+} if ((IOResult <> 0) or (fName = \'\')) then Writeln(\'Файл не существует\') else begin IsOpen := true; Writeln(\'Файл успешно открыт\'); end; readln; end; { Open } procedure FileToArray(var fH: TSweetFile; var trade: TTrade; cond: integer); { загрузка из файла в массив } var sw: TSweet; begin if not (IsOpen) then begin writeln(\'Файл не открыт\'); exit; end; trade.lines := 0; seek(fH, 0); while not( eof( fH ) ) and (trade.lines<TotalSweets) do begin read( fH, sw ); if (cond=0) or (cond>0) and (sw.price>=100) and (sw.price<=200) then begin trade.lines:= trade.lines+1; trade.shops[trade.lines] := sw; end; { if } end; { while not eof() } if not( eof( fH ) ) then writeln(\'Файл слишком велик, печатаем первые \',TotalSweets, \' записей\'); end; { FileToArray } procedure Print( trade: TTrade ); var sw: TSweet; i: integer; j: integer; PrintedShop: boolean; { для печати } begin writeln( \'-------------------------------------------------------\' ); writeln( \'Номер Название Цена Срок Магазины\' ); writeln( \'-------------------------------------------------------\' ); with trade do begin for i:= 1 to lines do begin PrintedShop := false; { ни один магазин не отпечатан } write( i:3, \' \', shops[i].name, \' \':20-length(shops[i].name), shops[i].price:3, \' \', shops[i].time:3 ); for j:= 1 to TotalShops do if (shops[i].sh[j]=1) then begin if PrintedShop then write(\',\') else write(\' \'); PrintedShop := true; write(j); end; writeln; if i mod 10 = 0 then readln; { выдача порциями по 10 } end; { for i } end; { with } readln; end; { Print } procedure SayGoodBye; begin writeln( \'Удачи!\' ); readln; end; { SayGoodBye } begin { Main } iChoice := 0; IsOpen := false; while true do begin Menu; Readln( iChoice ); case iChoice of 0: begin if IsOpen then Close( fH ); SayGoodBye; exit end; 1: Create( fH ); { Создание файла } 2: Open( fH ); { Открытие файла } 3: InsertOrUpdate( fH ); { Ввод данных } 4: begin FileToArray( fH, trade, 0 ); Print( trade ); { Вывод данных } end; 5: begin FileToArray( fH, trade, 1 ); Print( trade); { Вывод данных по условию} end; end; { case } end; { while } end.

Ответ отправил: lamed, Бакалавр
Ответ отправлен: 30.04.2010, 11:42
Номер ответа: 261121

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

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

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

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

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