home *** CD-ROM | disk | FTP | other *** search
/ Turbo Toolbox / Turbo_Toolbox.iso / 1990 / 01 / heimwerk / feiertag.bas next >
Encoding:
BASIC Source File  |  1989-10-26  |  6.3 KB  |  252 lines
  1. DECLARE FUNCTION Ostern$ (Datum$)
  2. DECLARE FUNCTION Bettag$ (Datum$)
  3. DECLARE FUNCTION Vollmond$ (Datum$)
  4. DECLARE FUNCTION wochtag! (Datum$)
  5. DECLARE FUNCTION VonBis$ (Datum$, Differenz!)
  6. DECLARE FUNCTION Gregor$ (Jul!)
  7. DECLARE FUNCTION Julian! (Datum$)
  8.  
  9. '* ------------------------------------------------------- *
  10. '*                   FEIERTAG.BAS                          *
  11. '*         Berechnung der beweglichen Feiertage            *
  12. '*        (c) 1989  S.Hund,  W.Rinke  &  TOOLBOX           *
  13. '* ------------------------------------------------------- *
  14. CONST TRUE = -1
  15. CONST FALSE = 0
  16.  
  17. CLS
  18.  
  19. Datum$ = "01.01.1989"
  20.  
  21. basis$ = Ostern$(Datum$)
  22. bbtag$ = Bettag$(Datum$)
  23. PRINT "Feiertage "; RIGHT$(Datum$, 4)
  24. PRINT
  25. PRINT "Neujahr             : "; "01.01."; RIGHT$(Datum$, 4)
  26. PRINT "Hl. Drei Könige     : "; "06.01."; RIGHT$(Datum$, 4)
  27. PRINT "Karfreitag          : "; VonBis$(basis$, -2)
  28. PRINT "Ostersonntag        : "; basis$
  29. PRINT "Ostermontag         : "; VonBis$(basis$, 1)
  30. PRINT "Himmelfahrt         : "; VonBis$(basis$, 39)
  31. PRINT "Pfingstsonntag      : "; VonBis$(basis$, 49)
  32. PRINT "Pfingstmontag       : "; VonBis$(basis$, 50)
  33. PRINT "Fronleichnam        : "; VonBis$(basis$, 60)
  34. PRINT "Tag der dt. Einheit : "; "17.06."; RIGHT$(Datum$, 4)
  35. PRINT "Mariä Himmelfahrt   : "; "15.08."; RIGHT$(Datum$, 4)
  36. PRINT "Allerheiligen       : "; "01.11."; RIGHT$(Datum$, 4)
  37. PRINT "Buß- und Bettag     : "; bbtag$
  38. PRINT "Weihnachten         : "; "25.12."; RIGHT$(Datum$, 4)
  39.  
  40. END
  41.  
  42.  
  43. FUNCTION Bettag$ (Datum$)
  44. '* ------------------------------------------------------- *
  45. '*           Berechnung des Buß- und Bettags
  46.  
  47.   jahr$ = RIGHT$(Datum$, 4)
  48.   FOR tag = 16 TO 22
  49.     btag$ = LTRIM$(STR$(tag) + ".11." + jahr$)
  50.     IF wochtag(btag$) = 1 THEN EXIT FOR
  51.   NEXT tag
  52.   Bettag$ = LTRIM$(btag$)
  53.  
  54. END FUNCTION
  55.  
  56.  
  57. FUNCTION Gregor$ (Jul)
  58. '* ------------------------------------------------------- *
  59. '*  Umrechnung von Julianischer Tageszählung in            *
  60. '*  Gregorianisches Datum                                  *
  61. '*  Algorithmen aus PASCAL 7'87                            *
  62.  
  63.   JulReferenz = 2305812#         '* hat im Hauptmodul nix zu
  64.   JulRefJahr = 1601              '* suchen !
  65.  
  66.   jahr = JulRefJahr
  67.   diff = Jul - JulReferenz
  68.   Tage = INT(diff)
  69.  
  70.   IF Tage > 146097 THEN
  71.     Hilfe = INT(Tage / 146097)
  72.     Tage = Tage - 146097 * Hilfe
  73.     jahr = jahr + 400 * Hilfe
  74.   END IF
  75.  
  76.   IF Tage > 36524 THEN
  77.     Hilfe = INT(Tage / 36524)
  78.     Tage = Tage - 36524 * Hilfe
  79.     jahr = jahr + 100 * Hilfe
  80.   END IF
  81.  
  82.   IF Tage > 1461 THEN
  83.     Hilfe = INT(Tage / 1461)
  84.     Tage = Tage - 1461 * Hilfe
  85.     jahr = jahr + 4 * Hilfe
  86.   END IF
  87.  
  88.   IF Tage > 365 THEN
  89.     Hilfe = INT(Tage / 365)
  90.     Tage = Tage - 365 * Hilfe
  91.     jahr = jahr + Hilfe
  92.   END IF
  93.  
  94.   IF Tage <> 0 THEN
  95.     Hilfe = 0: mond = 0: Laenge = 0
  96.     DO
  97.       Tage = Tage - Laenge
  98.       mond = mond + 1
  99.       Hilfe = 1 - Hilfe
  100.       IF mond = 8 THEN Hilfe = 1
  101.       Laenge = 30 + Hilfe
  102.       IF mond = 2 THEN
  103.         Laenge = Laenge - 2
  104.         j = jahr
  105.         IF j MOD 100 THEN j = j / 100
  106.         IF j MOD 4 THEN Laenge = Laenge + 1
  107.       END IF
  108.     LOOP UNTIL Tage <= Laenge
  109.     tag = FIX(Tage)
  110.     jahr = FIX(jahr)
  111.     mond = FIX(mond)
  112.   ELSE
  113.     jahr = FIX(jahr) - 1
  114.     mond = 12
  115.     tag = 31
  116.   END IF
  117.  
  118.   tag$ = LTRIM$(STR$(tag))
  119.   IF LEN(tag$) = 1 THEN tag$ = "0" + tag$
  120.   mond$ = LTRIM$(STR$(mond))
  121.   IF LEN(mond$) = 1 THEN mond$ = "0" + mond$
  122.   Gregor$ = tag$ + "." + mond$ + "." + LTRIM$(STR$(jahr))
  123.  
  124. END FUNCTION
  125.  
  126. FUNCTION Julian (Datum$)
  127. '* ------------------------------------------------------- *
  128. '*  Umrechnung Gregorianisches Datum -> Julianisch         *
  129.  
  130.   JulReferenz = 2305812#
  131.   JulRefJahr% = 1601
  132.  
  133.   tag% = VAL(LEFT$(Datum$, 2))
  134.   mond% = VAL(MID$(Datum$, 4, 2))
  135.   jahr% = VAL(RIGHT$(Datum$, 4))
  136.  
  137.   j1 = jahr% - JulRefJahr%
  138.   jd = JulReferenz + j1 * 365
  139.   jd = jd + INT(j1 / 4) - INT(j1 / 100) + INT(j1 / 400)
  140.  
  141.   IF mond% > 2 THEN
  142.     jd = jd + INT(30.6 * mond% - 32.3)
  143.     j2 = jahr%
  144.     IF j2 MOD 100 = 0 THEN j2 = INT(j2 / 100)
  145.     IF j2 MOD 4 = 0 THEN jd = jd + 1
  146.   ELSE
  147.     jd = jd + 31 * mond% - 31
  148.   END IF
  149.  
  150.   Julian = jd + tag%
  151.  
  152. END FUNCTION
  153.  
  154. FUNCTION Ostern$ (Datum$)
  155. '* ------------------------------------------------------- *
  156. '*            Berechnung des Ostersonntags
  157.  
  158.   voll$ = Vollmond$(Datum$)
  159.   wovo = wochtag(voll$)
  160.   diff = 5 - wovo
  161.   IF wovo < 0 THEN diff = wovo + 7
  162.   Ostern$ = VonBis(voll$, diff)
  163.  
  164. END FUNCTION
  165.  
  166.  
  167. FUNCTION Vollmond$ (Datum$)
  168. '* ------------------------------------------------------- *
  169. '*    Berechnung des ersten Vollmonds nach dem 21.3.
  170.  
  171.   jahr = VAL(RIGHT$(Datum$, 4))
  172.   rest = jahr MOD 19
  173.  
  174.   SELECT CASE rest
  175.     CASE IS = 0
  176.       tag$ = "14"
  177.     CASE IS = 1
  178.       tag$ = "03"
  179.     CASE IS = 2
  180.       tag$ = "23"
  181.     CASE IS = 3
  182.       tag$ = "11"
  183.     CASE IS = 4
  184.       tag$ = "31"
  185.     CASE IS = 5
  186.       tag$ = "18"
  187.     CASE IS = 6
  188.       tag$ = "08"
  189.     CASE IS = 7
  190.       tag$ = "28"
  191.     CASE IS = 8
  192.       tag$ = "16"
  193.     CASE IS = 9
  194.       tag$ = "05"
  195.     CASE IS = 10
  196.       tag$ = "25"
  197.     CASE IS = 11
  198.       tag$ = "13"
  199.     CASE IS = 12
  200.       tag$ = "02"
  201.     CASE IS = 13
  202.       tag$ = "22"
  203.     CASE IS = 14
  204.       tag$ = "10"
  205.     CASE IS = 15
  206.       tag$ = "30"
  207.     CASE IS = 16
  208.       tag$ = "17"
  209.     CASE IS = 17
  210.       tag$ = "07"
  211.     CASE IS = 18
  212.       tag$ = "27"
  213.   END SELECT
  214.  
  215.   SELECT CASE rest
  216.     CASE 2, 4, 7, 19, 13, 15, 18
  217.       mon$ = "03"
  218.     CASE ELSE
  219.       mon$ = "04"
  220.   END SELECT
  221.  
  222.   Vollmond$ = tag$ + "." + mon$ + "." + RIGHT$(Datum$, 4)
  223.  
  224. END FUNCTION
  225.  
  226.  
  227. FUNCTION VonBis$ (Datum$, Differenz)
  228. '* ------------------------------------------------------- *
  229. '*  Beantwortet Fragen wie:                                *
  230. '*       "Welches Datum ist in 100 Tagen?"                 *
  231. '*       "Welches Datum war vor 365 Tagen?"  (Oh nein!)    *
  232.  
  233.   jul1 = Julian(Datum$)
  234.   jul2 = jul1 + Differenz
  235.   VonBis$ = Gregor$(jul2)
  236.  
  237. END FUNCTION
  238.  
  239.  
  240. FUNCTION wochtag (Datum$)
  241. '* ------------------------------------------------------- *
  242. '*    gibt den Wochentag als Zahl zwischen 1..7 zurück
  243. '*    (Dienstag = 0)
  244.  
  245.   F = Julian(Datum$)
  246.   wochtag = FIX(F - 7 * INT(F / 7))
  247.  
  248. END FUNCTION
  249. '* ------------------------------------------------------- *
  250. '*                  Ende von DATUM.BAS                     *
  251.  
  252.