Unit Calendar; {================================================================} { Modulul este destinat calculilor calendaristice. { ----------------------- { Functiile folosesc in calitate de unitate de masura a timpului ziua, { de aceea se recomanda convertirea anilor si lunilor in zile, { efectuarea calculelor si apoi convertirea nr de zile inapoi in { zile, luni si ani. { { Calendarul utilizat este cel Iulian, alcatuit in anul 46 inainte de { Hristos de catre invatatul alexandrin Sosigene. { { La crearea acestui modul am utilizat cat se poate de putine { instructiuni conditionale si cat mai multe expresii matematice, { de aceea poate fi dificila perceperea formulelor. { ----------------------- { - Prima zi din an se considera 1 ianuarie = 01.01 { - Ziua 0 se considera 31 decembrie = 31.12 { { {================================================================} interface uses crt, dos; {================================================================} const Luna: array[1..12]of string[10] = ( 'ianuarie', 'februarie', 'martie', 'aprilie', 'mai', 'iunie', 'iulie', 'august', 'septembrie', 'octombrie', 'noiembrie', 'decembrie' ); QuadroAni = 3 * 365 + 366; { Un ciclu de 3 ani comuni si unu bisect exprimat in zile } QuadroLuni = 4 * 12; {================================================================} Function DataPask(Anul: word): integer; {Returneaza ziua din an} Function BisectAdd(Anul: word): byte; {Returneaza 1, daca anul e bisect, altfel - 0} Function DaysInMon(Mon: word): byte; {Returneaza nr de zile in luna} Function MonOfDays(Day: word): word; {Returneaza nr lunii in care este ziua} Function DayOfMon(Days: word): byte; {Returneaza nr zilei din luna (intre 1 si 31)} {Convertezte un nr de zile in nr de luni si nr de zile din luna (1-31)} Procedure DaysToMonDays(n: word; var m: word; var d: byte); {Returneaza stringul ce contine nr zilei si numele lunei} Function DataStr(z: integer): string; {================================================================} Implementation var { Variabile utilizate intern } i: longint; m: word; d: byte; {================================================================} Function DataPask(Anul: word): integer; const x = 15; y = 6; EchinoxMartie = 31 + 28 + 22; { Ianuarie + Februarie + 22 zile din martie} var a, b, c, d, e: byte; z: integer; Begin a := Anul mod 19; b := Anul mod 4; c := Anul mod 7; d := (19*a+x) mod 30; e := (2*b + 4*c + 6*d + y) mod 7; Z := EchinoxMartie + d + e; DataPask := z; End; {================================================================} {*}Function BisectAdd; begin BisectAdd:=1 shr (Anul and 3); end; {================================================================} { x mod 2 <-> x and 1 } { x mod 4 <-> x and 3 } Function DaysInMon(Mon: word): byte; var a: byte; Begin a := 1-(((Mon div 12 + 1) and 3 + 3)div 4); Mon := (Mon-1) mod 12+1; DaysInMon := 30 + Mon and 1 - (Mon div 8 * (Mon and 1 * 2-1)+ ((Mon-1) and 1 * ((12-Mon)div 10) * (2-a)) ); End; {================================================================} Procedure DaysToMonDays(n: word;var m: word;var d: byte); Begin If n>0 Then Begin m := ((n-1) div QuadroAni) * QuadroLuni; {Nr de luni in afara ciclului de 4 ani} n := (n-1) mod QuadroAni; {Nr de zile ce nu depasesc ciclul de 4 ani} While n >= DaysInMon(m+1) do Begin inc(m); n := n - DaysInMon(m); End; inc(m); d := n+1; End else Begin { Ziua 0 (zero) } m := 12; d := 31; End; End; {================================================================} Function MonOfDays(Day: word): word; Begin DaysToMonDays(Day,m,d); MonOfDays := m; End; {================================================================} Function DayOfMon(Days: word): byte; Begin DaysToMonDays(Days,m,d); DayOfMon := d; End; {================================================================} Function DataStr(z: integer): string; var s: string; Begin DaysToMonDays(z,M,D); Str(D,s); DataStr := s+' '+Luna[(M-1) mod 12 + 1]; End; {================================================================} End.