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

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

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

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

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

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

Вопрос № 177587: Доброй ночи,уважаемые эксперты,помогите пожалуйста вот с такой задачей: Задание: Определите запись для хранения информации об адресе проживания: название улицы, номер дома, номер кварт...

Доброй ночи,уважаемые эксперты,помогите пожалуйста вот с такой задачей:
Задание:
Определите запись для хранения информации об адресе проживания: название улицы, номер дома, номер квартиры, этаж.
Напишите
– процедуру вывода одной записи print,
– процедуру вывода массива записей print1,
– процедуру ввода массива записей enter,
– процедуру, определяющую запись с наибольшим номером квартиры среди всех адресов населённого пункта (соответствующая запись должна быть выходным параметром процедуры),
– процедуру формирования по заданному массиву записей нового массива, содержащего адреса с названием заданной улицы,
– функцию, определяющую количество жителей первого этажа,
– процедуру сортировки массива записей по каждому полю записи.
Напишите клиентскую программу, содержащую вызов всех процедур и функций

Отправлен: 01.04.2010, 03:16
Вопрос задал: angel.nero, Посетитель
Всего ответов: 1
Страница вопроса »

Приложение:
uses CRT; const len_street = 10; len_house = 5; Type OneInfo = record Street: String[len_street]; House : String[len_house]; {Может быть кроме номера еще и корпус: а, б ...} Room : Integer; Level : Integer; end; CONST max_Infos = 100; dat_fileName = \'177587.dat\'; {Файл для хранения записей} VAR {Для хранения используем массив фиксированной длины в 100 записей} Info: Array[1..max_Infos] of OneInfo; Streets: Array[1..max_Infos] of OneInfo; count: Integer; {Число записей в базе данных} count_streetS: Integer; {Число улиц} changed: Boolean; {были ли изменения списка} function UpRuss(s: String): String; {Преобразование строки в состоящую из заглавных букв. Нужна для правильного сравнения} var i, len: Integer; begin len := length(s); for i:=1 to len do Case s[i] of \'a\'..\'z\': s[i] := UpCase(s[i]); \'а\'..\'п\': s[i] := chr(ord(s[i]) - 32); \'р\'..\'я\': s[i] := chr(ord(s[i]) - 80); end; UpRuss := s end; procedure ReadFromFile; var f : file of OneInfo; c : Integer; o : OneInfo; begin Assign(f, dat_fileName); {$I-} Reset(f); {$I+} if IOResult <> 0 then begin WriteLn(\'Считывание информации невозможно: файл \',dat_fileName,\' не найден\'); WriteLn(\' Нажмите любую клавишу\'); ReadKey; Exit; {Немедленный вывход из подпрограммы} end; WriteLn(\'Добавление информации из файла \', dat_fileName); if count = max_Infos then WriteLn(\'Список полон - нельзя добавить информацию\') else begin c:= 0; while (c + count + 1< max_Infos) and (NOT EOF(f)) do begin Read(f, Info[c + count + 1]); inc(c); end; WriteLn(\'Добавлено записей: \',c); if count <> 0 then changed := True; count := count + c; end; WriteLn(\' Нажмите любую клавишу\'); ReadKey; Close(f); end; procedure SaveToFile; {сохранение списка в файл} var f: file of OneInfo; i: Integer; begin if count = 0 then WriteLn(\'Списк пуст, нечего сохранять\') else begin WriteLn(\'Сохранение информации в файл\'); Assign(f, dat_fileName); {Сначала проверим, есть ли такой} {$I-} Reset(f); {$I+} if IOResult = 0 then begin Close(f); WriteLn(\'Файл с именем \',dat_fileName,\' уже имеется\'); WriteLn(\'Если не хотите изменить файл, нажмите 1\'); WriteLn(\' После нажатия любой друго клавиши старая информаиця дудет удалена\'); if ReadKey = \'1\' then Exit; {Немедленный выход ничего не делая} {В принципе, можно и дописать в конец, но тут возможна ситация, когда запишешь больше чем сможешь прочиитать (количество считываемого ограничено)} end; Rewrite(f); for i:=1 to count do Write(f, Info[i]); Close(f); WriteLn(\'Добавлено записей: \', count) end; changed := false; WriteLn(\' Для продолжения работы нажмите любую клавишу\'); ReadKey end; procedure Print(no: Integer); {Вывод одной записи с заданным номером} begin if (no > 0) and (no <= count) then {элементарная проверка} WriteLn(no:4,\') \', Info[no].Street:len_street,\' \', Info[no].House:len_house,\' \', Info[no].Room:5,\' \',Info[no].Level:5); end; procedure Print1; {Вывод всего списка} var i: integer; begin if count =0 then WriteLn(\'Список пуст\') else begin WriteLn(\'номер Улица дом квартира этаж\'); for i:=1 to count do Print(i); end; WriteLn(\' Для продолжения работы нажмите любую клавишу\'); ReadKey end; procedure Enter; {Заполнение массива} var c: Integer; s: String; begin ClrScr; c := 0; WriteLn(\'Заполнение массива. Для завершения введите пустое название улицы\'); while ( c + count < 100) do begin Write(\'Введите название улицы: \'); ReadLn(s); if s = \'\' then Break; {Немедленный выход из цикла} inc(c); Info[count + c].Street := Copy(s, 1, len_street); {Не более len_street букв в названии} Write(\'Введите номер дома: \'); ReadLn(s); Info[count + c].House := Copy(s, 1, len_house); Write(\'Введите номер квартиры: \'); ReadLn(Info[count+ c].Room); Write(\'Введите этаж: \'); ReadLn(Info[count + c].Level); WriteLn; end; count := count + c; WriteLn(\'Добавлено новых записей: \',c,\'. Всего в списке записей: \', count); changed := true; WriteLn(\' Для продолжения работы нажмите любую клавишу\'); ReadKey end; procedure MaxRoomNumber; {Поиск квартиры с наибольшим номером} var i, max_no, max_no_count: Integer; begin if count = 0 then WriteLn(\'Список пуст\') else begin max_no := 1; max_no_count := 1; {число квартир с наибольшим. По крайней мере одна есть} for i:= 2 to count do if Info[i].Room > Info[max_no].Room then begin max_no_count := 1; max_no := i end else if Info[i].Room = Info[max_no].Room then inc(max_no_count); end; WriteLn(\'Максимальный номер квартиры: \',Info[max_no].Room, \' Количество квартир с таким номером: \', max_no_count); WriteLn(\' Для продолжения работы нажмите любую клавишу\'); ReadKey end; procedure FirstLevelPopulation; var i, population: Word; begin if count = 0 then WriteLn(\'Список пуст\') else begin population := 0; for i:=1 to count do if Info[i].Level = 1 then inc(population); if population = 0 then WriteLn(\'На первом этаже никто не живет\') else WriteLn(\'Количество квартир на первом этаже: \', population); end; WriteLn(\' Для продолжения работы нажмите любую клавишу\'); ReadKey end; procedure DoStreet; var newStreet: String; i: Integer; begin if count = 0 then WriteLn(\'Список пуст\') else begin Write(\'Введите название улицы: \'); ReadLn(newStreet); newStreet := Copy(newStreet, 1, len_street); count_streets := 0; for i:=1 to count do if UpRuss(Info[i].Street) = UpRuss(newStreet) then begin inc(count_streets); Streets[count_streets] := Info[i]; end; if count_streets = 0 then WriteLn(\'Такой улицы \',newStreet,\' нет в списке\') else begin WriteLn(\'Список адресов на улице \', newStreet); for i:=1 to count_streets do WriteLn(i:3,\') \', Streets[i].Street:len_Street,\' \', Streets[i].House:len_house,\' \', Streets[i].Room:5,\' \', Streets[i].Level:5); end; end; WriteLn(\' Для продолжения работы нажмите любую клавишу\'); ReadKey end; procedure Sort; var temp: OneInfo; i, j, min_no: Integer; {термин "одна процедура сортировки по каждому" понимаю как сортировка сначала по первому, потом при равных первых полях по второму полю и т.д. По четвертому полю сортировать бесполезно - просто глупость одна квартира на нескольких этажах. Бывают многоэтажные, но адрес у них один - я так думаю. Если не так нужно, напишите} begin if count = 0 then WriteLn(\'Список пуст\') else begin WriteLn(\'Сортировка массива\'); Write(\'По первому полю\'); {Сначала все по первому полю} for i:=1 to count-1 do for j := i+1 to count do if UpRuss(Info[i].Street) > UpRuss(Info[j].Street) then {UpRuss, чтоб сортировать без учета регистра Сотрировка - пузырьковая} begin temp := Info[i]; Info[i]:= Info[j]; Info[j]:= temp end; WriteLn(\' закончена\'); Write(\'По второму полю \'); {Теперь по второму полю - сортировка вставкой} i:=1; while i < count do begin if UpRuss(Info[i].Street) = UpRuss(Info[i+1].Street) then {если ли вообще равные по первому} begin {ищем среди равных по первому полю минимальный по второму полю} j:=i+1; min_no := i; while UpRuss(Info[i].Street) = UpRuss(Info[j].Street) do begin if UpRuss(Info[j].House) < UpRuss(Info[min_no].House) then min_no := j; inc(j) end; {Нашли минимальный вставили} if min_no <> i then begin temp := Info[i]; Info[i] := Info[min_no]; Info[min_no] := temp end; end; inc(i) {здесь можно немного оптимизировать - если надо, то помогу} end; WriteLn(\' закончена\'); {Проход по третьему полю} Write(\'Сортировка по третьему полю\'); i :=1; while i < count do begin if (UpRuss(Info[i].Street) = UpRuss(Info[i+1].Street)) and (UpRuss(Info[i].House) = UpRuss(Info[i+1].House)) then {если ли вообще равные по первому, второму?} begin {Опять метод вставки} j:=i+1; min_no := i; while (UpRuss(Info[i].Street) = UpRuss(Info[j].Street)) and (UpRuss(Info[i].House) = UpRuss(Info[i+1].House)) do begin if Info[j].Room < Info[min_no].Room then min_no := j; inc(j) end; if min_no <> i then begin temp := Info[i]; Info[i] := Info[min_no]; Info[min_no] := temp end; end; inc(i) end; WriteLn(\' закончена\'); end; WriteLn(\' Для продолжения работы нажмите любую клавишу\'); ReadKey end; procedure Menu; var selection: Char; begin repeat ClrScr; WriteLn(\'Выберите действие:\'); WriteLn(\' 1 - Вывод всего списка\'); WriteLn(\' 2 - Ввод (добавление) инфомации\'); WriteLn(\' 3 - Очистка базы\'); WriteLn(\' 4 - Поиск наибольшего номера квартиры\'); WriteLn(\' 5 - Количество жителей первого этажа\'); WriteLn(\' 6 - Сформировать список для улицы\'); WriteLn(\' 7 - Сортировать список\'); WriteLn(\' 8 - Сохранить список в файл\'); WriteLn(\' 9 - Ввести информацию из файла\'); WriteLn(\' 0 - Выход (окончание работы)\'); WriteLn; WriteLn(\'Информация: в списке \',count,\' записей\'); selection:=ReadKey; case selection of \'1\': Print1; \'2\': Enter; \'3\': count := 0; \'4\': MaxRoomNumber; \'5\': FirstLevelPopulation; \'6\': DoStreet; \'7\': Sort; \'8\': SaveToFile; \'9\': ReadFromFile; \'0\', #27: Exit; {Дополнительное прекращение работы по нажатию Esc} end until selection = \'0\'; end; BEGIN count := 0; count_streetS := 0; changed := False; Menu; if changed then begin WriteLn(\'Список изменен. Сохранить в файл? (Y/N)\'); Case ReadKey of \'Y\',\'y\',\'Н\',\'н\', #13: SaveToFile; {и Enter} end; end; END.
-----
Вывод - то место в тексте, где вы устали думать

Ответ отправил: Boriss, Академик
Ответ отправлен: 05.04.2010, 17:05
Номер ответа: 260617

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

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

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

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

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