Технический форум

Технический форум (http://www.tehnari.ru/)
-   Форум программистов (http://www.tehnari.ru/f22/)
-   -   Определение даты Пасхи (http://www.tehnari.ru/f22/t69671/)

Vladimir_S 25.02.2012 11:58

Определение даты Пасхи
 
Вложений: 1
Осуществил, наконец, давнюю задумку: составил программу расчета даты Пасхи в любом году. Определяются даты Православной (Orthodox), католической (Catholic) и еврейской (Jewish) Пасхи.
Очень это оказалось непростым делом: алгоритмов выложено много, но далеко не все правильные, многие с ошибками, а с учетом того, что создатели сайтов имеют обыкновение бездумно друг у друга копировать, то, сами понимаете... Ну вроде отладил. Если кому интересно, прошу протестировать и, буде ошибки вылезут, о том сообщить.
Ниже выложен исходник на Паскале и экзешник для DOS-моды. Если бы кто из Дельфийцев сделал из этого путный исполняемый файл под Windows, было бы совсем хорошо. Но это так, если есть желание.
Код:

Var
 Y,a,b,c,d,e,f,g,h,i,k,L,m,n,p,A1,M1,Date:LongInt;
 Month:String;
 Ksi,m2:Real;
Begin
 Write('Year = ');
 Readln(Y);
 Writeln;
 a:=(19*(Y mod 19)+15) mod 30;
 b:=(2*(Y mod 4)+4*(Y mod 7)+6*a+6) mod 7;
 If (a+b)>=10 then
  begin
  If a+b-9+13<31 then
    begin
    Month:='April';
    Date:=a+b-9+13;
    end
  else
    begin
    Month:='May';
    Date:=a+b-9+13-30;
    end;
  end
 else
  begin
  Month:='April';
  Date:=22+a+b+13-31;
  end;
 Writeln('Orthodox:');
 Writeln(Date:2,' of '+Month);
 Writeln;
 a:=Y mod 19;
 b:=Y div 100;
 c:=Y mod 100;
 d:=b div 4;
 e:=b mod 4;
 f:=(b+8) div 25;
 g:=(b-f+1) div 3;
 h:=(19*a+b-d-g+15) mod 30;
 i:=c div 4;
 k:=c mod 4;
 L:=(32+2*e+2*i-h-k) mod 7;
 m:=(a+11*h+22*L) div 451;
 n:=(h+L-7*m+114) div 31;
 p:=(h+L-7*m+114) mod 31;
 If n=3 then Month:='March' else Month:='April';
 Date:=p+1;
 Writeln('Catholic:');
 Writeln(Date:2,' of '+Month);
 Writeln;
 A1:=Y+3760;
 a:=(12*A1+17) mod 19;
 b:=A1 mod 4;
 Ksi:=32.0440933+1.5542418*a+0.25*b-0.00317779*A1;
 M1:=Trunc(Ksi);
 m2:=Ksi-1.0*M1;
 c:=(M1+3*A1+5*b+5) mod 7;
 If (c=1) and (a>b) and (m2>=0.63287037) then
  Date:=M1+1
 else
 If (c=2) or (c=4) or (c=6) or
 ((c=0) and (a>11) and (m2>=0.89772376)) then
  Date:=M1+1
 else Date:=M1;
 Inc(Date,13);
 If Date>31 then
  begin
  Month:='April';
  Dec(Date,31);
  end else Month:='March';
 Writeln('Jewish:');
 Writeln(Date:2,' of '+Month);
 Readln;
End.


Алехандро 27.02.2012 23:39

Не плохо сделано... И главное весьма кстати, ведь скоро Пасха. Но я хотел поинтересоваться, не могли бы Вы подсказать мне какие-нибудь советы или книги или сайты для чайников по программированию(я хочу стать программистом)? Я буду Вам очень признателен если вы не откажете мне в помощи...Или возможно с вами как-то связяться , например по скайпу...

kreol 28.02.2012 00:08

Цитата:

Сообщение от Vladimir_S (Сообщение 688739)
Если бы кто из Дельфийцев сделал из этого путный исполняемый файл под Windows, было бы совсем хорошо

Я могу попробовать. только чуть позже когда бует время. Но делать в lazarus е

Алехандро сначала следует определиться в какой сфере программирования хотите работать...

kreol 28.02.2012 02:38

Вложений: 1
Решил не откладывать) правда практически использовал исходный код почти без изменения и оптимизации для лазаруса (дельфи)...
ниже приведен архив с полным проектом под лазарус (хотя скорее всего откроется и нормально откомпилируется и в дельфи)
также .exe файл был упакован upx

кочевник 28.02.2012 02:44

Цитата:

Сообщение от Vladimir_S (Сообщение 688739)
Православной (Orthodox), католической (Catholic) и еврейской (Jewish) Пасхи.

Предлагаю отмечать все!

Eli 28.02.2012 02:55

Прикольно...:) жалко что он не дает второй раз поиск задать, выходить после первого запроса....

а то что в командной консоли открывает - имхо не мешает..

показывает точно :) и на этот год и на потом ( даже до 2080 года есть :)) ) понятно дело что не покажет что праздник у евреев начинается вечером ( день до того) ... на пример - в 2012 году в апреле 6 вечером зайдет песах)

Eli 28.02.2012 03:09

прошу прощения ( просто ночь что и влияет уже на мышление... да и не успел исправить в самом посте сверху )

Цитата:

показывает точно и на этот год и на потом ( даже до 2080 года есть ) понятно дело что не покажет что праздник у евреев начинается вечером ( день до того) ... на пример - в 2012 году в апреле 6 вечером зайдет песах)
показывает точно( относительно) :) и на этот год и на потом ( даже до 2080 года есть :)) ) кстати - Владимир - не знаю если ты знаешь, праздник у евреев начинается вечером ( день до того) ... на пример - в 2012 году в апреле 6 вечером зайдет песах)( в точности - вечер Песаха - что и есть начало Праздника.)

в программе просто, 7 числа... праздник показан у евреев...

Vladimir_S 28.02.2012 11:19

Цитата:

Сообщение от kreol (Сообщение 690809)
Решил не откладывать) правда практически использовал исходный код почти без изменения и оптимизации для лазаруса (дельфи)...
ниже приведен архив с полным проектом под лазарус (хотя скорее всего откроется и нормально откомпилируется и в дельфи)
также .exe файл был упакован upx

Пытался экзешник запустить - не хочет. Либо вовсе не запускается, либо что-то молниеносно упрыгивает за край экрана. ЧЯДНТ?

Артём 28.02.2012 11:21

А у меня прекрасно все запустилось и работает (я про экзешник Креола).

Артём 28.02.2012 11:22

XP Prof 32 бит - на всякий случай. :)

Vladimir_S 28.02.2012 11:32

Вложений: 1
Цитата:

Сообщение от Олег (Сообщение 690812)
Прикольно...:) жалко что он не дает второй раз поиск задать, выходить после первого запроса....

Олег, да какие проблемы? Пожалуйста, зациклил:
Вложение 69430
Цитата:

Сообщение от Олег (Сообщение 690819)
Владимир - не знаю если ты знаешь, праздник у евреев начинается вечером ( день до того) ... на пример - в 2012 году в апреле 6 вечером зайдет песах)( в точности - вечер Песаха - что и есть начало Праздника.)
в программе просто, 7 числа... праздник показан у евреев...

Ну, я алгоритмом готовым пользовался. А менять - боязно :D.

Vladimir_S 28.02.2012 11:34

Цитата:

Сообщение от Family Man (Сообщение 690873)
XP Prof 32 бит - на всякий случай. :)

Такая же. Может быть, по низкому экранному разрешению не работает (у меня 600х800)?

Артём 28.02.2012 11:36

Сомнительно... Но у меня разрешение высокое стоит.

KUS 28.02.2012 11:37

Нормально запускается и работает. Win7 Проф. х64

kreol 28.02.2012 14:49

Вложений: 1
Цитата:

Сообщение от Vladimir_S (Сообщение 690876)
Такая же. Может быть, по низкому экранному разрешению не работает (у меня 600х800)?

Да. Проблема была в разрешении.
Вот исправленный вариант. У меня просто разрешение широкоформатное(1366х768) и форма при компиляции была справа) вот там изначально программа и запускалась. С низким разрешением оно естественно и улетало вправо за экран))...

Vladimir_S 28.02.2012 14:56

Вложений: 1
Цитата:

Сообщение от kreol (Сообщение 690948)
Да. Проблема была в разрешении.
Вот исправленный вариант. У меня просто разрешение широкоформатное(1366х768) и форма при компиляции была справа) вот там изначально программа и запускалась. С низким разрешением оно естественно и улетало вправо за экран))...

А - ну вот это уже, как говорится, "другой коленкор". Спасибо!

kreol 28.02.2012 15:24

Если есть еще какие-то интересные проекты которые целесообразно запихать в дельфи то выкладывай) будет интересно посмотреть...

Артём 28.02.2012 15:33

А можно вместо той рожи (или лапы, я плохо вижу), что в левом верхнем углу окна, вставить изображение пасхального куличика? :)

Vladimir_S 28.02.2012 16:07

Цитата:

Сообщение от kreol (Сообщение 690955)
Если есть еще какие-то интересные проекты которые целесообразно запихать в дельфи то выкладывай) будет интересно посмотреть...

Таки есть парочка. С одним-то просто: это атрибуты восточного календаря (животное, цвет, стихия), тут примерно то же, что с Пасхой, а вот другой... Есть у меня программка выдачи календаря любого года, но тут - графика. Возьмешься?
Ну вот два варианта ORIENT.
С кириллицей:
Код:

{ Это для перевода текущего года в восточную символику }
CONST
  Matter_Color:ARRAY[0..9] of STRING[16]=('Металл  Белый  ',
                                          'Металл  Белый  ',
                                          'Вода    Черный ',
                                          'Вода    Черный ',
                                          'Дерево  Синий  ',
                                          'Дерево  Синий  ',
                                          'Огонь    Красный',
                                          'Огонь    Красный',
                                          'Земля    Желтый ',
                                          'Земля    Желтый ');

 Animal:ARRAY[0..11] of STRING[8]=('Обезьяна',
                                  'Курица  ',
                                  'Пес    ',
                                  'Свинья  ',
                                  'Мышь    ',
                                  'Корова  ',
                                  'Тигр    ',
                                  'Заяц    ',
                                  'Дракон  ',
                                  'Змея    ',
                                  'Конь    ',
                                  'Овца    ');

VAR
 CurYear, Mod1, Mod2, Mod3:LongInt;

BEGIN
 WRITELN('Для выхода из программы введите нулевой год.');
 WRITELN;
 REPEAT
  WRITE('Введите год:  '); READLN(CurYear);
  IF CurYear>0 THEN
  BEGIN
    Mod1:=CurYear mod 60;
    Mod2:=Mod1 mod 10;
    Mod3:=Mod1 mod 12;
    WRITELN(CurYear:8,' Н.Э.      ',Animal[Mod3],'  ',
            Matter_Color[Mod2]);
  END;
 UNTIL CurYear<=0;
END.

С латиницей:
Код:

CONST
  Matter_Color:ARRAY[0..9] of STRING[16]=('Metal    White  ',
                                          'Metal    White  ',
                                          'Water    Black  ',
                                          'Water    Black ',
                                          'Wood    Blue  ',
                                          'Wood    Blue  ',
                                          'Fire    Red  ',
                                          'Fire    Red  ',
                                          'Earth    Yellow',
                                          'Earth    Yellow');

 Animal:ARRAY[0..11] of STRING[8]=('Monkey',
                                  'Hen  ',
                                  'Dog  ',
                                  'Swine ',
                                  'Mouse ',
                                  'Cow  ',
                                  'Tiger ',
                                  'Rabbit',
                                  'Dragon',
                                  'Snake ',
                                  'Horse ',
                                  'Sheep ');

VAR
 CurYear, Mod1, Mod2, Mod3:LongInt;

BEGIN
 WRITELN('Enter zero year to exit');
 WRITELN;
 REPEAT
  WRITE('Enter the year:  '); READLN(CurYear);
  IF CurYear>0 THEN
  BEGIN
    Mod1:=CurYear mod 60;
    Mod2:=Mod1 mod 10;
    Mod3:=Mod1 mod 12;
    WRITELN(CurYear:8,'  ',Animal[Mod3],'  ',Matter_Color[Mod2]);
  END;
 UNTIL CurYear<=0;
END.


kreol 28.02.2012 16:46

Вложений: 1
Можно и с куличиком))
И еще небольшая плюшка)))
вот только exe файл...

Ну а почему бы и нет)
Кст. в lazaruse увидел интересную штуку. i18n для перевода.(правда я ее ни разу не использовал...)
А с графикой в дельфи примерно то же самое что и в паскале. Только работа с канвой...

Артём 28.02.2012 16:49

Спасибо :)

Vladimir_S 28.02.2012 17:19

Вложений: 1
Цитата:

Сообщение от kreol (Сообщение 690992)
А с графикой в дельфи примерно то же самое что и в паскале. Только работа с канвой...

Да знаю - писал когда-то графические программы в Delphi... вот только обленился и всё перезабыл. Ну ладно, вот текст программы-календаря. Пояснение: модуль GrfStart - самописный, он, помимо еще кое-каких мелочей, содержит процедуру INITIALIZE, в которой прописаны всякие там параметры графических драйверов, пути и собственно сама процедура InitGfaph.
Код:

USES GRAPH, GrfStart, CRT;
CONST
 NumDays:ARRAY[1..2,1..12] of WORD=((31,28,31,30,31,30,31,31,30,31,30,31),
                                    (31,29,31,30,31,30,31,31,30,31,30,31));
 Ds:ARRAY[1..7] of STRING=('Mo',
                          'Tu',
                          'We',
                          'Th',
                          'Fr',
                          'Sa',
                          'Su');
 Months:ARRAY[1..12] of STRING=('JANUARU',
                                'FEBRUARY',
                                'MARCH',
                                'APRIL',
                                'MAY',
                                'JUNE',
                                'JULY',
                                'AUGUST',
                                'SEPTEMBER',
                                'OCTOBER',
                                'NOVEMBER',
                                'DECEMBER');
 DY=12;
 DX=20;

VAR
 D400,M400,D100,M100,D4,M4,SumDays1,SumDays,Mo:LongInt;
 i,line,day,month,CurYear,X0,Y0,Xcur,Ycur:WORD;
 YearType,Cl,WeekDay,WeDa:ShortInt;

Function Int2Str(L : LongInt) : string;
{ Converts an integer to a string for use with OutText, OutTextXY }
var
  S : string;
begin
  Str(L, S);
  Int2Str := S;
end; { Int2Str }

PROCEDURE WD(CY,CM,CD:LongInt;VAR YT,DW:ShortInt);
BEGIN
 D400:=(CY-1) div 400;
 M400:=(CY-1) mod 400;
 D100:=M400 div 100;
 M100:=M400 mod 100;
 D4:=M100 div 4;
 M4:=M100 mod 4;
 SumDays1:=D400*146097+D100*36524+D4*1461+M4*365;
 SumDays:=SumDays1;

 M400:=CY mod 400;
 M100:=M400 mod 100;
 M4:=M100 mod 4;

 IF (M400=0) OR ((M100>0) AND (M4=0)) THEN YT:=2 ELSE YT:=1;
 FOR Month:=1 TO CM-1 DO
  SumDays:=SumDays+NumDays[YearType,Month];
 SumDays:=SumDays+CD;
 DW:=SumDays mod 7;
END;

BEGIN
 WRITE('Enter the year: '); Readln(CurYear);
 INITIALIZE;
 ClearDevice;
 SetTextStyle(TriplexScriptFont, HorizDir, 7);
 SetTextJustify(CenterText, TopText);
 SetColor(LightCyan);
 OutTextXY(320,10,Int2Str(CurYear));
 SetTextStyle(DefaultFont, HorizDir, 1);
 SetTextJustify(LeftText,TopText);
 FOR Line:=1 TO 3 DO
  FOR Day:=1 TO 7 DO
  BEGIN
    IF (Day=6) OR (Day=7) THEN SetColor(LightRed) ELSE SetColor(Yellow);
    X0:=30;
    Y0:=100+(Line-1)*120+Day*DY;
    OutTextXY(X0,Y0,Ds[Day]);
    X0:=610;
    OutTextXY(X0,Y0,Ds[Day]);
  END;
 FOR Mo:=1 TO 12 DO
  BEGIN
  SetTextStyle(DefaultFont, HorizDir, 1);
  SetTextJustify(CenterText,BottomText);
  SetColor(LightGreen);
  IF Mo<5 THEN
    BEGIN
    X0:=80+(Mo-1)*140;
    Y0:=100;
    OutTextXY(X0+50,Y0+4,Months[Mo]);
    END  ELSE
  IF Mo<9 THEN
    BEGIN
    X0:=80+(Mo-5)*140;
    Y0:=220;
    OutTextXY(X0+50,Y0+4,Months[Mo]);
    END  ELSE
    BEGIN
    X0:=80+(Mo-9)*140;
    Y0:=340;
    OutTextXY(X0+50,Y0+4,Months[Mo]);
    END;
  SetTextStyle(DefaultFont, HorizDir, 1);
  SetTextJustify(RightText,TopText);
  WD(CurYear,Mo,1,YearType,WeekDay);
  IF WeekDay=0 THEN WeDa:=1 ELSE WeDa:=8-WeekDay;
  FOR i:=1 TO NumDays[YearType,Mo] DO
    BEGIN
    IF i<=WeDa THEN Xcur:=0 ELSE Xcur:=(((i-1-WeDa) div 7)+1)*DX;
    IF i<=WeDa THEN Ycur:=(7-(WeDa-i))*DY ELSE Ycur:=((i-WeDa) mod 7)*DY;
    IF Ycur=0 THEN Ycur:=7*DY;
    IF (Ycur div DY = 6) OR (Ycur div DY = 7) THEN SetColor(LightRed)
      ELSE SetColor(Yellow);
    OUTTEXTXY(Xcur+X0,Ycur+Y0,Int2Str(i));
    END;
  END;
 ReadKey;
 CloseGraph;
END.


Eli 29.02.2012 02:02

то есть - это создание граф.. Календаря через программирование?

Vladimir_S 29.02.2012 09:51

Цитата:

Сообщение от Олег (Сообщение 691392)
то есть - это создание граф.. Календаря через программирование?

Ну да. Суть программы в том, чтобы по номеру года правильно определить день недели 1 января, учесть тип года (високосный/обычный), ну и расположить оптимально.
Хотя, если переводить на Delphi, то графика, скорее всего, и не нужна, достаточно организовать выдачу текстовой информации. Просто в DOS-Паскале в текстовой моде календарь не впихивается в экран (символы слишком большие), вот и пришлось перейти на графическую моду.

artos 12.03.2012 23:29

Вложений: 2
Ну вот и подоспела делфи-версия:) Только вашего алгоритма я не понял немного, делал с нуля, но принцип тот же. Календарь можно сохранить в jpeg-е, напечатать(функция глючит немного пока что), задать цвет, шрифт, язык и отображение праздников.
Вложение 71159

Daniellos 12.03.2012 23:38

Цитата:

Сообщение от artos (Сообщение 699179)
artos

А где исходник :)

artos 12.03.2012 23:56

Вложений: 1
Мне просто стыдно выкладывать исходник т.к. код уж очень убогий и абсолютно нечитабельный:) Ну ладно может кто разберется и оптимизирует...

Vladimir_S 15.03.2012 20:54

Так, потестировал. Увы - не пойдёт! Неправильно описан Григорианский календарь, алгоритм соответствует скорее Юлианскому. Объясняю.
В Юлианском календаре каждый четвертый год - високосный, т.е. в феврале 29 дней. А вот в принятом сейчас почти во всём мире Григорианском - чуть сложнее: вековые года (1900, 2100, 2200 и т.д) - невисокосные, кроме тех, что кратны 400. Таким образом, 2000, 2400 и т.п. - високосные, как и в Юлианском календаре. Именно поэтому дальнейшего расхождения календарей в 2000 году не произошло. А вот если существующая система сохранится до 2100 года, то после него Рождество переедет с 7 на 8 января, а Старый новый год - с 14 на 15.
Всё это в моей программе как раз учтено, а вот в Вашей - нет.
Ну и еще дефектик. У бедолаг вроде меня, предпочитающих низкое видеоразрешение (600х800) окно календаря не лезет в экран.
Если выберете время поправить - будет очень даже здорово.

Daniellos 15.03.2012 21:08

Вложений: 1
Вот подправил... Проверьте...


Ой, не то подправил... :tehnari_ru_942:

Vladimir_S 16.03.2012 12:40

Цитата:

Сообщение от Daniellos (Сообщение 700824)
Вот подправил... Проверьте...

Проверил. Никаких изменений не увидел: например, 2100 год как был поставлен високосным, так им и остался, а должен быть обычным. И в экран не лезет...

artos 16.03.2012 22:42

Цитата:

Сообщение от Vladimir_S (Сообщение 700817)
В Юлианском календаре каждый четвертый год - високосный, т.е. в феврале 29 дней. А вот в принятом сейчас почти во всём мире Григорианском - чуть сложнее: вековые года (1900, 2100, 2200 и т.д) - невисокосные, кроме тех, что кратны 400. Таким образом, 2000, 2400 и т.п. - високосные, как и в Юлианском календаре. Именно поэтому дальнейшего расхождения календарей в 2000 году не произошло. А вот если существующая система сохранится до 2100 года, то после него Рождество переедет с 7 на 8 января, а Старый новый год - с 14 на 15.

Если б я всё это знал... :) Ну ладно, будем исправлять. А вот с разрешением сложновато. Это получается надо пропорционально все размеры менять? Установить какой-нибудь общий коэфицент для прорисовки каждой части календаря и изменять его в зависимости от разрешения?

Ваня 17.03.2012 00:06

Этот можно вот так вот запросто написать .ехе программу? :tehnari_ru_211:
Преклоняю перед вами колени!
Программка для расчета Пасхи порадовала. А вот календарь закрывается, при нажатии на кнопки. Хотя может это аваст чудит... :)

Vladimir_S 17.03.2012 18:29

Цитата:

Сообщение от artos (Сообщение 701541)
А вот с разрешением сложновато. Это получается надо пропорционально все размеры менять? Установить какой-нибудь общий коэфицент для прорисовки каждой части календаря и изменять его в зависимости от разрешения?

Да уж это как получится.:)


Часовой пояс GMT +4, время: 10:58.

Powered by vBulletin® Version 4.5.3
Copyright ©2000 - 2024, Jelsoft Enterprises Ltd.