Технический форум
Вернуться   Технический форум > Программирование > Форум программистов > Delphi, Kylix and Pascal


Ответ
 
Опции темы Опции просмотра
Старый 25.09.2016, 18:15   #1 (permalink)
EH0T
Новичок
 
Регистрация: 25.09.2016
Сообщений: 3
Сказал(а) спасибо: 0
Поблагодарили 0 раз(а) в 0 сообщениях
Репутация: 10
По умолчанию Работа с файлами

Привет всем! Требуется помощь: необходимо доработать существующую программу
Доработать:
1. вызов запросов оформить в виде меню;
2. добавить пункты: сохранить таблицу в файле и прочитать
таблицу из файла. Типы файлов:
– типизированный файл из записей;
– типизированный файл из символов;
– текстовый файл;
3. запросы оформить в виде подпрограмм. Все объявления и
подпрограммы должны быть оформлены в виде модуля (модулей).

код программы:
Код:
program laba1_2; 

uses 
   crt; 

const 
   N = 8; 

type 
   ZNAK1 = record 
   Surname, Name: string[20];          // Фамилия, имя 
   Zodiac: string[10];                 // Знак зодиака 
   Birthday: array[1..3] of integer;   // Число месяц год 
   end; 
   ArrZNAK = array[1..N] of Znak1;  
var 
   ZNAK: ArrZNAK;
   i:integer; 
   surname1:string;
   Birthday1:integer;

// Процедура ввода данных 
procedure Input(var ZNAK: ZNAK1; i: integer); 

var
   s: string;
   d, m, y, err: integer;
   err2: boolean;
begin
   ClrScr;
   writeln('Ввод ', i, ' пользователя.');
   writeln;
   write('Введите фамилию: ');
   readln(ZNAK.Surname);
   write('Введите имя: ');
   readln(ZNAK.Name);
   write('Введите знак зодиака: ');
   readln(ZNAK.Zodiac);
  
   repeat
     write('Введите дату рождения в формате ДД.ММ.ГГГГ: ');
     readln(s);
          err2 := False;
     
     Val(Copy(s, 1, Pos('.', s)-1), d, err);
     Delete(s, 1, Pos('.', s));
     if (err <> 0) then 
           err2 := true
   else
       if not (d in [1..31]) then err2 := true; 
     
     Val(Copy(s, 1, Pos('.', s)-1), m, err);
     Delete(s, 1, Pos('.', s));
     if (err <> 0) then 
           err2 := true
   else
       if not (m in [1..12]) then err2 := true;
     
     Val(Copy(s, 1, 4), y, err);
     if (err <> 0) then 
           err2 := true
   else
      if not (y in [1900..2017]) then err2 := true;
      
    if err2 then writeln('Неверные данные. Повторите ввод.');    
  until not err2;
  
  ZNAK.Birthday[1] := d;
  ZNAK.Birthday[2] := m;
  ZNAK.Birthday[3] := y; 
end;

// Процедура вывода массива записей в виде таблицы 
procedure Output(ZNAK:ArrZNAK; N: integer); 
var 
   i: integer; 
begin 
   writeln(' ┌────────────────────────────────────────────────────────────────────────┐'); 
   writeln(' │ Фамилия              │ Имя                  │Знак зодиака │ Дата       │'); 
   writeln(' ├──────────────────────┼──────────────────────┼─────────────┼────────────┤'); 

   for i := 1 to N do 
begin 
   writeln(' │ ', ZNAK[i].Surname:20, ' │ ', ZNAK[i].Name:20, ' │ ', ZNAK[i].Zodiac:11, ' │ ', 
   ZNAK[i].Birthday[1]:2 ,'.', ZNAK[i].Birthday[2]:2 ,'.', ZNAK[i].Birthday[3]:4,' │');

   if i <> N then 
   writeln(' ├──────────────────────┼──────────────────────┼─────────────┼────────────┤') 
   else 
   writeln(' └──────────────────────┴──────────────────────┴─────────────┴────────────┘'); 
end; 
end; 

// Процедура сортировки массива по знаку зодиака
procedure Sort(var ZNAK: ArrZnak; N: integer); 
var 
   i, j, k, l, m: integer;
   s: string; 
   SWAPZNAK: ZNAK1; 
begin
   k:=0;
   while k<=n do
begin
  for i:=1 to n-1 do
     begin
     l:=1; m:=0;
     repeat
     if ZNAK[i].Zodiac[l]<>ZNAK[i+1].Zodiac[l] then inc(m);
     if ZNAK[i].Zodiac[l]>ZNAK[i+1].Zodiac[l] then
       begin
       s:=ZNAK[i].Zodiac;
       ZNAK[i].Zodiac:=ZNAK[i+1].Zodiac;
       ZNAK[i+1].Zodiac:=s;
       end;
    inc(l);
    until (m=1) or (l>length(ZNAK[i].Zodiac));
    end;
inc(k);
end;
end;

// Процедура поиска записи по месяцу рождения
procedure Search(ZNAK: ArrZNAK; N: integer; Birthday1: integer); 
var 
   i: integer; 
   err: boolean; 
begin 
  err := true; 
  for i := 1 to N do 
  if ZNAK[i].Birthday[2] = Birthday1 then 
begin 
  err := false; 
  writeln; 
  writeln('Фамилия: ', ZNAK[i].Surname); 
  writeln('Имя: ', ZNAK[i].Name); 
  writeln('Дата рождения: ', ZNAK[i].Birthday[1], '.', ZNAK[i].Birthday[2], '.', ZNAK[i].Birthday[3]); 
  writeln('Знак зодиака: ',ZNAK[i].Zodiac); 
end; 

writeln; 

if err = true then 
writeln('Люди, родившиеся в месяц "', Birthday1,'" не найдены'); 
end; 

begin 
// Ввод массива записей 
for i := 1 to N do 
Input(ZNAK[i], i); 

ClrScr; 

// Вывод таблицы
Output(ZNAK, N); 

// Сортировка записей по дате рождения 
Sort(ZNAK, N); 

readln; 
writeln; 

writeln('Результат сортировки:'); 
Output(ZNAK, N); // Вывод отсортированной таблицы 

writeln; 

writeln('Введите значение месяца рождения: '); 
readln(Birthday1); 
Search(ZNAK, N, Birthday1);// Вывод искомых данных 

readln; 
end.
EH0T вне форума   Ответить с цитированием

Старый 25.09.2016, 18:15
Helpmaster
Member
 
Аватар для Helpmaster
 
Регистрация: 08.03.2016
Сообщений: 0

Ваш вопрос уже обсуждался на нашем форуме

Работа с файлами
Работа с файлами
работа с файлами в С#
Работа с файлами

Старый 25.09.2016, 21:20   #2 (permalink)
Vladimir_S
Специалист
 
Регистрация: 27.08.2008
Адрес: Санкт-Петербург
Сообщений: 27,807
Сказал(а) спасибо: 340
Поблагодарили 583 раз(а) в 208 сообщениях
Репутация: 113184
По умолчанию

Ну и сколько вас еще будет? Вся группа? Или весь курс?
В общем, сегодня целый день угрохал на это:
"Файлы", доработка программы с темой "Записи"
Так что на остальных у меня ни времени, ни возможности, ни желания, извините, нет. Уж не обижайтесь.
Vladimir_S вне форума   Ответить с цитированием
Ads

Яндекс

Member
 
Регистрация: 31.10.2006
Сообщений: 40200
Записей в дневнике: 0
Сказал(а) спасибо: 0
Поблагодарили 0 раз(а) в 0 сообщениях
Репутация: 55070
Ответ


Ваши права в разделе
Вы не можете создавать новые темы
Вы не можете отвечать в темах
Вы не можете прикреплять вложения
Вы не можете редактировать свои сообщения

BB коды Вкл.
Смайлы Вкл.
[IMG] код Выкл.
HTML код Выкл.
Trackbacks are Вкл.
Pingbacks are Вкл.
Refbacks are Выкл.




Часовой пояс GMT +4, время: 20:10.

Powered by vBulletin® Version 6.2.5.
Copyright ©2000 - 2014, Jelsoft Enterprises Ltd.