Определение биоритмов
{Программа для определения физической, эмоциональной и интеллектуальной активности человека.
'Вводится дата рождения и текущая дата. Программа вычисляет и выводит на экран
'общее количество дней, часов, минут и секунд, разделяющих обе даты,
'а также прогнозирует на месяц вперед даты, соответствующие максимуму
'и минимуму биоритмов. Описание программы см. п. 2. 7. 2.}
const
Size_of_Month: array [1..12] of Byte =
(31, 28, 31, 30, 31, 30, 31, 31, 30, 31, 30, 31);
var
d0, d, {Дни рождения и текущий}
m0, m, {Месяцы рождения и текущий}
y0, y, {Годы рождения и текущий}
dmin, {Наименее благоприятный день}
dmax, {Наиболее благоприятный день}
days: Integer; {Количество дней от рождения}
{--------------------------}
Procedure InputDates(var d0,m0,y0,d,m,y: Integer);
{Вводит дату рождения и текущую дату. Контролирует правильность дат
'и их непротиворечивость (текущая дата должна быть позже даты рождения)}
var
correctly: Boolean; {Признак правильного ввода}
{-------------------}
Procedure InpDate(text: String; var d,m,y: Integer);
{Выводит приглашение TEXT, вводит дату в формате ДД ММ ГГГГ и проверяет ее правильность}
const
YMIN =1800; {Минимальный правильный год}
YMAX =2000; {Максимальный правильный год}
begin {InpDate}
repeat
Write(text);
ReadLn(d,m,y);
correctly: = (y >= YMIN) and (Y <= YMAX) and (m >= 1)
and (m <= 12) and (d > 0);
if correctly then
if (m = 2) and (d = 29) and (y mod 4=0)
then
{Ничего не делать: это 29 февраля високосного года!}
else
correctly: = d <= Size_of_Month[m];
if not correctly then
WriteLn('Ошибка в дате!')
until correctly
end; {InpDate}
{----------------}
begin {InputDates}
repeat
InpDate('Введите дату рождения в формате ДД ММ ГГГГ:',d0,m0,y0);
InpDate(' Введите текущую дату: ', d, m, у);
{Проверяем непротиворечивость дат:}
correctly: = у > у0;
if not correctly and (y = y0) then
begin
correctly: = m > m0;
if not correctly and (m = m0) then
correctly: = d >= d0
end
until correctly
end; {InputDates}
{-----------------}
Procedure Get_number s_of_days (d0,m0, y0,d,m, у: Integer; var days: Integer);
{Определение полного количества дней, прошедших от одной даты до другой }
{-------------------}
Procedure Variant2;
{Подсчет количества дней в месяцах, разделяющих обе даты }
var
mm: Integer;
begin {Variant2}
mm: = m0;
while mm < m do
begin
days: = days + Size_of_Month[mm];
if (mm = 2) and (y0 mod 4=0) then
inc(days);
inc (mm)
end
end; {Variant2}