DUzun's Web
Programare, proiecte personale, divertisment

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.

​