home *** CD-ROM | disk | FTP | other *** search
/ Turbo Toolbox / Turbo_Toolbox.iso / 1990 / 01 / heimwerk / feiertag.pas < prev   
Encoding:
Pascal/Delphi Source File  |  1989-11-16  |  2.7 KB  |  89 lines
  1. (* ------------------------------------------------------ *)
  2. (*                    FEIERTAG.PAS                        *)
  3. (*          Kleines "Bonbon" für Pascal-Freunde           *)
  4. (* ------------------------------------------------------ *)
  5. USES Crt, Dos;
  6.  
  7. VAR  tag, monat, jahr, rest : WORD;
  8.      vmzahl                 : LONGINT;
  9.      wt                     : BYTE;
  10.      einjahr                : INTEGER;
  11.      karfreitag, ostern     : LONGINT;
  12.      himmelfahrt, pfingsten : LONGINT;
  13.      fronleichnam, bbtag    : LONGINT;
  14.  
  15. FUNCTION DatToZahl(tag, monat, jahr : WORD) : LONGINT;
  16. BEGIN
  17.   IF monat < 3 THEN BEGIN
  18.     Inc(monat, 12);   Dec(jahr);
  19.   END;
  20.   DatToZahl := LongInt(jahr) * 365 + jahr SHR 2 -
  21.                jahr DIV 100 + jahr div 400 +
  22.                Trunc(30.60001 * Succ(monat)) - 122 + tag
  23. END;
  24.  
  25. PROCEDURE ZahlToDatum(zahl : LONGINT;
  26.                       VAR tag, monat, jahr : WORD);
  27. BEGIN
  28.   jahr := Trunc(zahl/365.2425);
  29.   Dec(zahl, LongInt(jahr) * 365 + jahr shr 2 -
  30.             jahr DIV 100 + jahr DIV 400 - 122);
  31.   monat := Pred(Trunc(zahl/30.60001));
  32.   tag   := zahl - Trunc(30.60001 * Succ(monat));
  33.   IF monat > 12 THEN BEGIN
  34.     Dec(monat, 12);  Inc(jahr);
  35.   END;
  36. END;
  37.  
  38. FUNCTION Wochentag(tag, monat, jahr : WORD) : BYTE;
  39. BEGIN
  40.   Wochentag := (DatToZahl(tag, monat, jahr) + 2) MOD 7;
  41. END;
  42.  
  43. PROCEDURE Vollmond;
  44. BEGIN
  45.   rest := jahr MOD 19;
  46.   IF rest =  0 THEN tag := 14;
  47.   IF rest =  1 THEN tag :=  3;
  48.   IF rest =  2 THEN tag := 23;
  49.   IF rest =  3 THEN tag := 11;
  50.   IF rest =  4 THEN tag := 31;
  51.   IF rest =  5 THEN tag := 18;
  52.   IF rest =  6 THEN tag :=  8;
  53.   IF rest =  7 THEN tag := 28;
  54.   IF rest =  8 THEN tag := 16;
  55.   IF rest =  9 THEN tag :=  5;
  56.   IF rest = 10 THEN tag := 25;
  57.   IF rest = 11 THEN tag := 13;
  58.   IF rest = 12 THEN tag :=  2;
  59.   IF rest = 13 THEN tag := 22;
  60.   IF rest = 14 THEN tag := 10;
  61.   IF rest = 15 THEN tag := 30;
  62.   IF rest = 16 THEN tag := 17;
  63.   IF rest = 17 THEN tag :=  7;
  64.   IF rest = 18 THEN tag := 27;
  65.   IF rest in(.2, 4, 7, 10, 13, 15, 18.) THEN monat := 3
  66.                                         ELSE monat := 4;
  67.   vmzahl := DatToZahl(tag, monat, jahr);
  68.   wt := Wochentag(tag, monat, jahr);
  69.   IF wt = 0 THEN ostern := vmzahl + 7;
  70.   ostern := vmzahl + 7 - wt;
  71. END;
  72.  
  73. PROCEDURE Feiertage;
  74. BEGIN
  75.   karfreitag   := ostern -  2;
  76.   himmelfahrt  := ostern + 39;
  77.   pfingsten    := ostern + 49;
  78.   fronleichnam := ostern + 60;
  79.   tag   := 15;                 { Buß- und Bettag ermitteln }
  80.   monat := 11;
  81.   REPEAT
  82.     tag := tag + 1;
  83.     wt  := Wochentag(tag, monat, jahr);
  84.   UNTIL wt = 3;
  85.   bbtag := DatToZahl(tag, monat, jahr);
  86. END;
  87. (* ------------------------------------------------------ *)
  88. (*               Ende von FEIERTAG.PAS                    *)
  89.