home *** CD-ROM | disk | FTP | other *** search
/ Turbo Toolbox / Turbo_Toolbox.iso / 1989 / 12 / heimwerk / datum.bas next >
Encoding:
BASIC Source File  |  1989-09-14  |  9.3 KB  |  386 lines
  1. DECLARE FUNCTION Ultimo! (Datum$)
  2. DECLARE FUNCTION Schaltjahr% (Datum$)
  3. DECLARE FUNCTION Datumstest$ (Datum$)
  4. DECLARE FUNCTION Monat$ (Datum$)
  5. DECLARE FUNCTION VonBis$ (Datum$, Differenz!)
  6. DECLARE FUNCTION DiffDate! (Datum1$, Datum2$)
  7. DECLARE FUNCTION Wotag$ (Datum$)
  8. DECLARE FUNCTION SysDate$ ()
  9. DECLARE FUNCTION Gregor$ (Jul!)
  10. DECLARE FUNCTION Julian! (Datum$)
  11.  
  12. '* ------------------------------------------------------- *
  13. '*                     DATUM.BAS                           *
  14. '*                  Kalendermodule                         *
  15. '*           (c) 1989  W.Rinke  &  TOOLBOX                 *
  16. '* ------------------------------------------------------- *
  17. CONST TRUE = -1
  18. CONST FALSE = 0
  19.  
  20.  
  21. DIM Tabelle$(1 TO 42)
  22.  
  23. Kalenderjahr = 1990
  24.  
  25. '* ----------------- Überschrift ------------------------- *
  26. Message$ = "toolbox wünscht Ihnen Gesundheit und Erfolg in "
  27. Message$ = Message$ + LTRIM$(STR$(Kalenderjahr))
  28. underld$ = STRING$(80, "=")
  29. trailer = (80 - LEN(Message$)) / 2
  30. Message$ = SPACE$(trailer) + Message$
  31.  
  32. LPRINT Message$
  33. LPRINT underld$: LPRINT
  34.  
  35. FOR zaehler = 1 TO 12
  36.   Mon = zaehler
  37.   Mondstring$ = LTRIM$(STR$(Mon))
  38.   IF LEN(Mondstring$) = 1 THEN
  39.     Mondstring$ = "0" + Mondstring$
  40.   END IF
  41.   Daystring$ = "01"
  42.   Datestring$ = Daystring$ + "." + Mondstring$ + "."
  43.   Datestring$ = Datestring$ + LTRIM$(STR$(Kalenderjahr))
  44.  
  45.   SELECT CASE Wotag$(Datestring$)
  46.     CASE IS = "Montag"
  47.       Offset = 0
  48.     CASE IS = "Dienstag"
  49.       Offset = 1
  50.     CASE IS = "Mittwoch"
  51.       Offset = 2
  52.     CASE IS = "Donnerstag"
  53.       Offset = 3
  54.     CASE IS = "Freitag"
  55.       Offset = 4
  56.     CASE IS = "Samstag"
  57.       Offset = 5
  58.     CASE IS = "Sonntag"
  59.       Offset = 6
  60.   END SELECT             '* für "leere Tage" am Monatsanfang
  61.  
  62.   '* ----------- Vorbereiten der Monatstabellen ---------- *
  63.   FOR i = 1 TO Offset
  64.     Tabelle$(i) = "    "
  65.   NEXT i
  66.  
  67.   FOR i = Offset + 1 TO Ultimo(Datestring$) + Offset
  68.     h$ = LTRIM$(STR$(i - Offset))
  69.     IF LEN(h$) = 1 THEN h$ = " " + h$
  70.     Tabelle$(i) = h$ + "  "
  71.   NEXT i
  72.  
  73.   FOR i = Ultimo(Datestring$) + Offset + 1 TO 42
  74.     Tabelle$(i) = "    "
  75.   NEXT i
  76.  
  77.   '* ---------- Monatstabelle ausgeben ------------------- *
  78.   LPRINT "           "; Monat$(Datestring$)
  79.   LPRINT "---------------------------------"
  80.   LPRINT "Montag     ";
  81.   FOR i = 0 TO 5
  82.     LPRINT Tabelle$(i * 7 + 1);
  83.   NEXT i : LPRINT
  84.   LPRINT "Dienstag   ";
  85.   FOR i = 0 TO 5
  86.     LPRINT Tabelle$(i * 7 + 2);
  87.   NEXT i : LPRINT
  88.   LPRINT "Mittwoch   ";
  89.   FOR i = 0 TO 5
  90.     LPRINT Tabelle$(i * 7 + 3);
  91.   NEXT i: LPRINT
  92.   LPRINT "Donnerstag ";
  93.   FOR i = 0 TO 5
  94.     LPRINT Tabelle$(i * 7 + 4);
  95.   NEXT i: LPRINT
  96.   LPRINT "Freitag    ";
  97.   FOR i = 0 TO 5
  98.     LPRINT Tabelle$(i * 7 + 5);
  99.   NEXT i: LPRINT
  100.   LPRINT "Samstag    ";
  101.   FOR i = 0 TO 5
  102.     LPRINT Tabelle$(i * 7 + 6);
  103.   NEXT i : LPRINT
  104.   LPRINT "Sonntag    ";
  105.   FOR i = 0 TO 5
  106.     LPRINT Tabelle$(i * 7 + 7);
  107.   NEXT i: LPRINT : LPRINT
  108.  
  109. NEXT zaehler
  110.  
  111. END
  112.  
  113.  
  114. FUNCTION Datumstest$ (Datum$)
  115. '* ------------------------------------------------------- *
  116. '* Plausibilitätsüberprüfung von Datumseingaben            *
  117. '* Eingabe: das zu testende Datum                          *
  118. '* Ausgabe: Fehlermeldung                                  *
  119.  
  120.   IF LEN(Datum$) <> 10 THEN
  121.     Datumstest$ = "Datum bitte in der Form <dd.mm.jjjj>!"
  122.     EXIT FUNCTION
  123.   END IF
  124.  
  125.   dd = VAL(LEFT$(Datum$, 2))
  126.   mm = VAL(MID$(Datum$, 4, 2))
  127.   jj = VAL(RIGHT$(Datum$, 2))
  128.  
  129.   IF (dd < 1) OR (dd > Ultimo(Datum$)) THEN
  130.     Datumstest$ = "diesen Tag gibt's nicht !"
  131.     EXIT FUNCTION
  132.   END IF
  133.  
  134.   IF (mm < 1) OR (mm > 12) THEN
  135.     Datumstest$ = "Monate nur von 1..12 !"
  136.     EXIT FUNCTION
  137.   END IF
  138.  
  139.   Datumstest$ = ""
  140.  
  141. END FUNCTION
  142.  
  143.  
  144. FUNCTION DiffDate (Datum1$, Datum2$)
  145. '* ------------------------------------------------------- *
  146. '*  Absolute Differenz zwischen zwei Daten                 *
  147.  
  148.   jul1 = Julian(Datum1$)
  149.   jul2 = Julian(Datum2$)
  150.  
  151.   IF jul1 >= jul2 THEN
  152.     DiffDate = jul1 - jul2
  153.   ELSE
  154.     DiffDate = jul2 - jul1
  155.   END IF
  156.  
  157. END FUNCTION
  158.  
  159.  
  160. FUNCTION Gregor$ (Jul)
  161. '* ------------------------------------------------------- *
  162. '*  Umrechnung von Julianischer Tageszählung in            *
  163. '*  Gregorianisches Datum                                  *
  164. '*  Algorithmen aus PASCAL 7'87                            *
  165.  
  166.   JulReferenz = 2305812#         '* hat im Hauptmodul nix zu
  167.   JulRefJahr = 1601              '* suchen !
  168.  
  169.   jahr = JulRefJahr
  170.   Diff = Jul - JulReferenz
  171.   Tage = INT(Diff)
  172.  
  173.   IF Tage > 146097 THEN
  174.     Hilfe = INT(Tage / 146097)
  175.     Tage = Tage - 146097 * Hilfe
  176.     jahr = jahr + 400 * Hilfe
  177.   END IF
  178.  
  179.   IF Tage > 36524 THEN
  180.     Hilfe = INT(Tage / 36524)
  181.     Tage = Tage - 36524 * Hilfe
  182.     jahr = jahr + 100 * Hilfe
  183.   END IF
  184.  
  185.   IF Tage > 1461 THEN
  186.     Hilfe = INT(Tage / 1461)
  187.     Tage = Tage - 1461 * Hilfe
  188.     jahr = jahr + 4 * Hilfe
  189.   END IF
  190.  
  191.   IF Tage > 365 THEN
  192.     Hilfe = INT(Tage / 365)
  193.     Tage = Tage - 365 * Hilfe
  194.     jahr = jahr + Hilfe
  195.   END IF
  196.  
  197.   IF Tage <> 0 THEN
  198.     Hilfe = 0: mond = 0: Laenge = 0
  199.     DO
  200.       Tage = Tage - Laenge
  201.       mond = mond + 1
  202.       Hilfe = 1 - Hilfe
  203.       IF mond = 8 THEN Hilfe = 1
  204.       Laenge = 30 + Hilfe
  205.       IF mond = 2 THEN
  206.         Laenge = Laenge - 2
  207.         j = jahr
  208.         IF j MOD 100 THEN j = j / 100
  209.         IF j MOD 4 THEN Laenge = Laenge + 1
  210.       END IF
  211.     LOOP UNTIL Tage <= Laenge
  212.     tag = FIX(Tage)
  213.     jahr = FIX(jahr)
  214.     mond = FIX(mond)
  215.   ELSE
  216.     jahr = FIX(jahr) - 1
  217.     mond = 12
  218.     tag = 31
  219.   END IF
  220.  
  221.   tag$ = LTRIM$(STR$(tag))
  222.   IF LEN(tag$) = 1 THEN tag$ = "0" + tag$
  223.   mond$ = LTRIM$(STR$(mond))
  224.   IF LEN(mond$) = 1 THEN mond$ = "0" + mond$
  225.   Gregor$ = tag$ + "." + mond$ + "." + LTRIM$(STR$(jahr))
  226.  
  227. END FUNCTION
  228.  
  229.  
  230. FUNCTION Julian (Datum$)
  231. '* ------------------------------------------------------- *
  232. '*  Umrechnung Gregorianisches Datum -> Julianisch         *
  233.  
  234.   JulReferenz = 2305812#
  235.   JulRefJahr% = 1601
  236.  
  237.   tag% = VAL(LEFT$(Datum$, 2))
  238.   mond% = VAL(MID$(Datum$, 4, 2))
  239.   jahr% = VAL(RIGHT$(Datum$, 4))
  240.  
  241.   j1 = jahr% - JulRefJahr%
  242.   jd = JulReferenz + j1 * 365
  243.   jd = jd + INT(j1 / 4) - INT(j1 / 100) + INT(j1 / 400)
  244.  
  245.   IF mond% > 2 THEN
  246.     jd = jd + INT(30.6 * mond% - 32.3)
  247.     j2 = jahr%
  248.     IF j2 MOD 100 = 0 THEN j2 = INT(j2 / 100)
  249.     IF j2 MOD 4 = 0 THEN jd = jd + 1
  250.   ELSE
  251.     jd = jd + 31 * mond% - 31
  252.   END IF
  253.  
  254.   Julian = jd + tag%
  255.  
  256. END FUNCTION
  257.  
  258.  
  259. FUNCTION Monat$ (Datum$)
  260. '* ------------------------------------------------------- *
  261. '*  Gibt zum übergebenen Datum den Monat im "Klartext" aus *
  262.  
  263.   mond = VAL(MID$(Datum$, 4, 2))
  264.   SELECT CASE mond
  265.     CASE 1
  266.       Monat$ = "Januar"
  267.     CASE 2
  268.       Monat$ = "Februar"
  269.     CASE 3
  270.       Monat$ = "März"
  271.     CASE 4
  272.       Monat$ = "April"
  273.     CASE 5
  274.       Monat$ = "Mai"
  275.     CASE 6
  276.       Monat$ = "Juni"
  277.     CASE 7
  278.       Monat$ = "Juli"
  279.     CASE 8
  280.       Monat$ = "August"
  281.     CASE 9
  282.       Monat$ = "September"
  283.     CASE 10
  284.       Monat$ = "Oktober"
  285.     CASE 11
  286.       Monat$ = "November"
  287.     CASE 12
  288.       Monat$ = "Dezember"
  289.   END SELECT
  290.  
  291. END FUNCTION
  292.  
  293.  
  294. FUNCTION Schaltjahr% (Datum$)               '* Quasi-Boolean
  295. '* ------------------------------------------------------- *
  296. '*  Schaltjahr oder keins?                                 *
  297. '*  TRUE (-1) und FALSE (0) stehen im Hauptprogramm        *
  298.  
  299.   Schaltjahr = FALSE
  300.   aa = VAL(RIGHT$(Datum$, 4))
  301.   IF aa MOD 100 = 0 THEN aa = aa / 100
  302.   IF aa MOD 4 = 0 THEN Schaltjahr = TRUE
  303.  
  304. END FUNCTION
  305.  
  306.  
  307. FUNCTION SysDate$
  308. '* ------------------------------------------------------- *
  309. '*  Wandelt das Systemdatum in eine Zeichenkette um, mit   *
  310. '*  der die Bibliotheksroutinen arbeiten können            *
  311.  
  312.   Datum$ = DATE$
  313.  
  314.   tag$ = MID$(Datum$, 4, 2)
  315.   mond$ = LEFT$(Datum$, 2)
  316.   jahr$ = RIGHT$(Datum$, 4)
  317.  
  318.   SysDate$ = tag$ + "." + mond$ + "." + jahr$
  319.  
  320. END FUNCTION
  321.  
  322.  
  323. FUNCTION Ultimo (Datum$)
  324. '* ------------------------------------------------------- *
  325. '*  Bestimmung des "Monatsletzten"                         *
  326.  
  327.   mm = VAL(MID$(Datum$, 4, 2))
  328.  
  329.   SELECT CASE mm
  330.     CASE 4, 6, 9, 11
  331.       Ultimo = 30
  332.     CASE 1, 3, 5, 7, 8, 10, 12
  333.       Ultimo = 31
  334.     CASE 2
  335.       IF Schaltjahr(Datum$) THEN
  336.         Ultimo = 29
  337.       ELSE
  338.         Ultimo = 28
  339.       END IF
  340.   END SELECT
  341.  
  342. END FUNCTION
  343.  
  344.  
  345. FUNCTION VonBis$ (Datum$, Differenz)
  346. '* ------------------------------------------------------- *
  347. '*  Beantwortet Fragen wie:                                *
  348. '*       "Welches Datum ist in 100 Tagen?"                 *
  349. '*       "Welches Datum war vor 365 Tagen?"  (Oh nein!)    *
  350.  
  351.   jul1 = Julian(Datum$)
  352.   jul2 = jul1 + Differenz
  353.   VonBis$ = Gregor$(jul2)
  354.  
  355. END FUNCTION
  356.  
  357.  
  358. FUNCTION Wotag$ (Datum$)
  359. '* ------------------------------------------------------- *
  360. '*  Gibt den Wochentag im Klartext zurück                  *
  361.  
  362.   F = Julian(Datum$)
  363.   wert = FIX(F - 7 * INT(F / 7))
  364.  
  365.   SELECT CASE wert
  366.     CASE 0
  367.       Wotag$ = "Dienstag"
  368.     CASE 1
  369.       Wotag$ = "Mittwoch"
  370.     CASE 2
  371.       Wotag$ = "Donnerstag"
  372.     CASE 3
  373.       Wotag$ = "Freitag"
  374.     CASE 4
  375.       Wotag$ = "Samstag"
  376.     CASE 5
  377.       Wotag$ = "Sonntag"
  378.     CASE 6
  379.       Wotag$ = "Montag"
  380.   END SELECT
  381.  
  382. END FUNCTION
  383.  
  384. '* ------------------------------------------------------- *
  385. '*                  Ende von DATUM.BAS                     *
  386.