Calendar.PAS

{* Функции календарных вычислений *}

Unit CALENDAR;
Interface
Implementation
Begin
 writeln('Calendar - Функции календарных вычислений


Набор функций для работы с датами и вычислений по календарю.


{ Calendar.pas набор функций для работы с датами и вычислений по календарю. Автор: Виктор Осташев Fido: 2:5020/1194 E-mail: v_ostashev@chat.ru WWW: http://ostashev.newmail.ru'
);
End.

Program pas;

Uses Calendar.pas; {* Эту строку можно удалить *}
{        Calendar.pas   набор функций для работы с датами   и вычислений по календарю.  Автор:  Виктор Осташев  Fido:   2:5020 / 1194  E - mail: v_ostashev@chat.ru  WWW:    http: // ostashev.newmail.ru  }
unit calendar;
interface
Type {* Создание новых типов данных *}
  tdate = Record                                  d                   : byte;
  m                   : byte;
  y                   : integer;
  End{Хранит дату}
  tstyle = (grigorian, julian); {Старый стиль - это юлианский, а новый - григорианский}
Function datein(low, high, dt : tdate) : boolean; {Проверяет нахождение даты в промежутке   между low и high}
Procedure stringtodate(st : String;
Var {* Необходимые переменные *}
  dt                        : tdate); {Преобразует строку в дату}
Procedure datetostring(dt : tdate;
Var {* Объявление переменных *}
  st                        : String); {Преобразует дату в строку}
Function compdate(d1      : tdate);
d2                        : tdate); {Сравнивает две даты. Возвращает 0, если даты равны, - 1, если первая дата меньше второй и 1, если наоборот}
Function numofday(dat     : tdate;
style                     : tstyle); {Вычисляет условный номер дня для даты dat с учетом   нового стиля при style = true}
Function dayofweek(dat    : tdate;
style                     : tstyle); {Вычисляет день недели для даты dat с учетом   нового стиля при style = true}
Function numinyear(dat    : tdate;
style                     : tstyle); {Вычисляет номер дня от начала года с учетом стиля}
Function lenofmonth(month : byte;
year                      : word;
style                     : tstyle); {Вычисляет длину месяца с учетом стиля}
Procedure numtodate(num   : longint;
style                     : tstyle;
Var {* В работе нам потребуются переменные: *}
  dat                  : tdate); {Вычисляет дату по данному номеру дня}
Function isleap(year : integer); {Является ли год високосным}
Begin
datein := (compdate(low, dt) = 0);
Var {* Объявление переменных *}
  s                              : Array[1..3] Of String[5];
  i                              : integer;
  j                              : integer;
  Begin
For i := 1 To 3 Do{* Цикл для i => [1 .. 3] *}
  j := 1;
For i := 1 To 3 Do{* Увеличиваем i от 1 до 3 с шагом 1 *}
  If a - b < 0 Then
    compdate := - 1;
Var {* Необходимые переменные *}
  stcor                                   : integer; {По формуле num = [year * 365.25] + [(month + 1) * 30.6] + day + style}
  {Вычисляем поправку на григорианский стиль}
If style = grigorian Then
  Begin
stcor := 2 - dat.y Div 100 + dat.y Div 400; {А здесь ищем перебором месяц, поднимаясь вверх}
{Промахнулись на 1 месяц вверх}
{А уж что у нас осталось - то день месяца}
dat.d := num - numofday(dat, style) + 1;
Function isleap;
Begin
isleap := (((year Mod 4 = 0) And (year Mod 100  0)) Or (year Mod 400 = 0));
End;

End......