Turbo Pascal
ГЛАВНАЯ | ЗАКАЗАТЬ РАБОТУ НА TURBO PASCAL | КАК ОПЛАТИТЬ? | О САЙТЕ | КОНТАКТЫ

Иллюстрированный самоучитель по
Turbo Pascal

Воскресенье
25 июня 2017 года

 

Определение биоритмов

{Программа для определения физической, эмоциональной и интеллектуальной активности человека. Вводится дата рождения и текущая дата. Программа вычисляет и выводит на экран общее количество дней, часов, минут и секунд, разделяющих обе даты, а также прогнозирует на месяц вперед даты, соответствующие максимуму и минимуму биоритмов. Описание программы см. п. 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}

{---------------}

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 (yO mod 4=0) then

inc (days) ; 

inc (mm)

end;

yy := y0 + 1;

while yy < у 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 у = 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; {Период физической активности} 

ТЕ = 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 WriteDatettext: String; dd: Integer);

{Определение даты для дня DD от момента рождения. В глобальных переменных d, m и у имеется текущая дата, в переменной 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: Longlnt; {"Длинная" целая переменная для часов, минут и секунд } 

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, у) ;

Get_numbers_of_days (d0,m0,y0,d,m,y,days) ;

FindMaxMin (dmin, dmax, days) ;

WriteDates (dmin, dmax, days) 

end .

 


Последние новости

Сервис инновация
заправка картриджей Предлагаю Вам оценить сайт наших партнеров - Сервисный центр по заправке картриджей "Сервис инновация". Они профессионально занимаются заправкой картриджей в Красноярске с 2007 года. Очень быстро и качественно оказывают заправку картриджей. Рекомендую!

Скупка новых картриджей

Если у на работе остались неипользованные новые картриджи, а принтер уже вышел из строя, мы купим у вас такие картриджи по высокой цене. Мы занимаемся скупкой новых картриджей в Красноярске.

скупка картриджей

Скупка новых картриджей уже многим принесла неплохой дополнительный заработок. Скупка осуществляется круглосуточно, без выходных. Осуществляется выезд к клиенту!


Счетчики






Реклама

Полезная информация



 
 
 
email
:tanucik2004@ya.ru Copyright © TP7.INFO, 2007-2013
icq
: 308-364-613
тел.
: +7 953 580 83 78