Оригинальный DVD-ROM: eXeL@B DVD !
eXeL@B ВИДЕОКУРС !

ВИДЕОКУРС
выпущен 4 ноября!


УЗНАТЬ БОЛЬШЕ >>
Домой | Статьи | RAR-cтатьи | FAQ | Форум | Скачать | Видеокурс
Новичку | Ссылки | Программирование | Интервью | Архив | Связь

БОЛЬШОЙ FAQ ПО DELPHI



Вычисление даты Пасхи 2


 function Easter(Year: Integer): TDateTime;
 {----------------------------------------------------------------}
 { Вычисляет и возвращает день Пасхи определенного года.          }
 { Идея принадлежит Mark Lussier, AppVision <MLussier@best.com>.  }
 { Скорректировано для предотвращения переполнения целых, если по }
 { ошибке передан год с числом 6554 или более.                    }
 {----------------------------------------------------------------}
 
 var
   nMonth, nDay, nMoon, nEpact, nSunday,
     nGold, nCent, nCorx, nCorz: Integer;
 begin
   { Номер Золотого Года в 19-летнем Metonic-цикле: }
   nGold := (Year mod 19) + 1;
   { Вычисляем столетие: }
   nCent := (Year div 100) + 1;
   { Количество лет, в течение которых отслеживаются високосные года... }
   { для синхронизации с движением солнца: }
   nCorx := (3 * nCent) div 4 - 12;
   { Специальная коррекция для синхронизации Пасхи с орбитой луны: }
   nCorz := (8 * nCent + 5) div 25 - 5;
   { Находим воскресенье: }
   nSunday := (Longint(5) * Year) div 4 - nCorx - 10;
   { ^ Предохраняем переполнение года за отметку 6554}
   { Устанавливаем Epact - определяем момент полной луны: }
   nEpact := (11 * nGold + 20 + nCorz - nCorx) mod 30;
   if nEpact < 0 then
     nEpact := nEpact + 30;
   if ((nEpact = 25) and (nGold > 11)) or (nEpact = 24) then
     nEpact := nEpact + 1;
   { Ищем полную луну: }
   nMoon := 44 - nEpact;
   if nMoon < 21 then
     nMoon := nMoon + 30;
   { Позиционируем на воскресенье: }
   nMoon := nMoon + 7 - ((nSunday + nMoon) mod 7);
   if nMoon > l 31 then
   begin
     nMonth := 4;
     nDay := nMoon - 31;
   end
   else
   begin
     nMonth := 3;
     nDay := nMoon;
   end;
   Easter := EncodeDate(Year, nMonth, nDay);
 end; {Easter}
 




<< ВЕРНУТЬСЯ В ОГЛАВЛЕНИЕ



Материалы находятся на сайте https://exelab.ru/pro/



Оригинальный DVD-ROM: eXeL@B DVD !


Вы находитесь на EXELAB.rU
Проект ReactOS