Вводится дата рождения и текущая дата. Программа вычисляет и выводит на экран общее количество дней, часов, минут и секунд, разделяющих обе даты, а также прогнозирует на месяц вперед даты, соответствующие максимуму и минимуму биоритмов
{Программа для определения физической, эмоциональной и интеллектуальной
активности человека. Вводится дата рождения и текущая дата. Программа
вычисляет и выводит на экран общее количество дней, часов, минут и секунд,
разделяющих обе даты, а также прогнозирует на месяц вперед даты,
соответствующие максимуму и минимуму биоритмов.
}
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,y);
{Проверяем непротиворечивость дат:}
correctly := y > y0;
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_numbers_of_days(d0,m0,y0,d,m,y: 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}
{-------------------}
Procedure Variant3;
{Подсчет количества дней в месяцах и годах, разделяющих обе
даты }
var
mm, yy : integer;
begin {Variant3}
mm := m0 + 1;
while mm <= 12 do {Учитываем остаток года рождения:}
begin
days := days+Size_of_Month[mm];
if (mm = 2) and (y0 mod 4 = 0) then
inc(days);
inc(mm)
end;
yy := y0 + 1;
while yy < y do {Прибавляем разницу лет:}
begin
days := days + 365;
if yy mod 4 = 0 then
inc(days);
inc(yy)
end;
mm := 1;
while mm < m do {Прибавляем начало текущего года:}
begin
days := days + Size_of_Month[mm];
if (y mod 4 = 0) and (mm = 2) then
inc(days);
inc(mm)
end
end; {Variant3}
{-------------------}
begin {Get_numbers_of_days}
if (y = y0) and (m = m0) then {Даты отличаются только днями:}
days := d - d0
else {Даты отличаются не только днями:}
begin
days := d + Size_of_Month[m0] - d0;
{Учитываем количество дней в текущем месяце и
количество дней до конца месяца рождения}
if (y0 mod 4 = 0) and (m0 = 2) then
inc(days); {Учитываем високосный год}
if y = y0 then
Variant2 {Разница в месяцах одного и того же года}
else
Variant3 {Даты отличаются годами}
end
end; {Get_numbers_of_days}
{-------------------------------}
Procedure FindMaxMin(var dmin,dmax: integer;
days: integer);
{Поиск критических дней}
const
TF = 2*3.1416/23.6884; {Период физической активности}
TE = 2*3.1416/28.4261; {Период эмоциональной активности}
TI = 2*3.1416/33.1638; {Период интеллектуальной активности}
INTERVAL = 30; {Интервал прогноза}
var
min, {Накапливает минимум биоритмов}
max, {Накапливает максимум биоритмов}
x : real; {Текущее значение биоритмов}
i : integer;
begin {FindMaxMin}
max := sin(days*TF)+sin(days*TE)+sin(days*TI);
min := max; {Начальное значение минимума и максимума равно
значению биоритмов для текущего дня}
dmin := days;
dmax := days;
for i := 0 to INTERVAL do
begin
x := sin((days+i)*TF) + sin((days+i)*TE) +
sin((days+i)*TI);
if x > max then
begin
max := x;
dmax := days + i
end
else if x < min then
begin
min := x;
dmin := days + i
end
end;
end; {FindMaxMin}
{-------------------------------}
Procedure WriteDates(dmin,dmax,days : integer);
{Определение и вывод дат критических дней.
Вывод дополнительной информации о количестве
прожитых дней, часов, минут и секунд }
{-------------------}
Procedure WriteDate(text: string; dd: integer);
{Определение даты для дня DD от момента рождения. В глобальных
переменных d, m и y имеется текущая дата, в переменной DAYS -
количество дней, прошедших от момента рождения до текущей
даты.
Выводится сообщение TEXT и найденная дата в формате
ДД-МЕС-ГГГГ}
const
Names_of_Monthes : array [1..12] of string [3] =
('янв','фев','мар','апр','мая','июн',
'июл','авг','сен','окт','ноя','дек');
var
d0,m0,y0,ddd : integer;
begin {WriteDate}
d0 := d;
m0 := m;
y0 := y;
ddd := days;
while ddd<>dd do
begin
inc(d0); {Наращиваем число}
if (y0 mod 4 <> 0) and (d0 > Size_of_Month[m0]) or
(y0 mod 4=0) and (d0=30) then
begin {Корректируем месяц}
d0 := 1;
inc(m0);
if m0 = 13 then {Корректируем год}
begin
m0 := 1;
inc(y0)
end
end;
inc(ddd)
end;
WriteLn(text,d0,'-',Names_of_Monthes[m0],'-',y0)
end; {WriteDate}
{-------------------}
var
LongDays: LongInt; {"Длинная" целая переменная для часов,
минут и секунд }
begin {WriteDates}
LongDays := days;
WriteLn('Прошло: ',LongDays,' дней, ',longDays*24,
' часов, ', LongDays*24*60,' минут, ',
LongDays*24*60*60,' секунд');
WriteDate('Наименее благоприятный день: ',dmin);
WriteDate('Наиболее благоприятный день: ',dmax)
end; {WriteDates}
{-------------------------------}
begin {Главная программа}
InputDates(d0,m0,y0,d,m,y);
Get_numbers_of_days(d0,m0,y0,d,m,y,days);
FindMaxMin(dmin,dmax,days);
WriteDates(dmin,dmax,days)
end.