home *** CD-ROM | disk | FTP | other *** search
/ Frozen Fish 1: Amiga / FrozenFish-Apr94.iso / bbs / mar94 / util / misc / kalender.lha / Kalender / txt / Datum.mod < prev    next >
Text File  |  1993-12-18  |  9KB  |  382 lines
  1.  IMPLEMENTATION MODULE Datum; (* Copyright 1993 by Kai Hofmann *)
  2.  
  3.  (*$ StackChk    := FALSE *)
  4.  (*$ RangeChk    := FALSE *)
  5.  (*$ OverflowChk := FALSE *)
  6.  (*$ NilChk      := FALSE *)
  7.  (*$ CaseChk     := FALSE *)
  8.  (*$ ReturnChk   := FALSE *)
  9.  (*$ LargeVars   := FALSE *)
  10.  (*$ EntryClear  := TRUE  *)
  11.  (*$ Volatile    := TRUE  *)
  12.  (*$ StackParms  := TRUE  *)
  13.  (*$ CStrings    := TRUE  *)
  14.  
  15.  
  16.  FROM SYSTEM        IMPORT ADR;
  17.  FROM IntuitionL    IMPORT CurrentTime;
  18.  FROM Conversions    IMPORT ValToStr;
  19.  FROM String        IMPORT Concat;
  20.  
  21.  
  22.  CONST
  23.     ErsterTag    =    1; (* Ab diesem Datum fängt die Systemzeit *)
  24.      ErsterMonat    =    1; (* an zu zählen.                        *)
  25.      ErstesJahr    = 1978;
  26.      ErsterWochentag =    7;
  27.  
  28.  
  29.  PROCEDURE GetSeconds() : LONGCARD;    (* Holt die Systemzeit des Amiga *)
  30.                     (* in Sekunden             *)
  31.  VAR
  32.     sekunden,microsek : LONGCARD;
  33.  
  34.  BEGIN
  35.    CurrentTime(ADR(sekunden),ADR(microsek));
  36.    RETURN sekunden;
  37.  END GetSeconds;
  38.  
  39.  
  40.  PROCEDURE Schaltjahr(Jahr : CARDINAL) : BOOLEAN; (* Ermittelt, ob es sich *)
  41.                           (* bei Jahr um ein       *)
  42.  BEGIN                          (* Schaltjahr handelt    *)
  43.    IF (Jahr MOD 4 = 0) AND (Jahr MOD 100 > 0) THEN
  44.      RETURN(TRUE);
  45.    ELSE
  46.      RETURN(FALSE);
  47.    END;
  48.  END Schaltjahr;
  49.  
  50.  
  51.  PROCEDURE Year(VAR Tag : LONGCARD) : CARDINAL; (* Ermittelt das Jahr durch   *)
  52.                             (* umrechnung der anzahl Tage *)
  53.  VAR
  54.     JAHR : CARDINAL;               (* die seit dem Systemstart   *)
  55.                            (* (siehe CONST) vergangen    *)
  56.  BEGIN                           (* sind.                 *)
  57.    INC(Tag);
  58.    JAHR := ErstesJahr;
  59.    REPEAT
  60.      Tag := Tag - 365;
  61.      IF Schaltjahr(JAHR) THEN
  62.        DEC(Tag);
  63.      END;
  64.      INC(JAHR);
  65.    UNTIL ((Tag <= 365) AND (NOT Schaltjahr(JAHR))) OR
  66.                     (Schaltjahr(JAHR) AND (Tag <= 366));
  67.    RETURN(JAHR);
  68.  END Year;
  69.  
  70.  
  71.  PROCEDURE maxDays(Monat : SHORTCARD; Jahr : CARDINAL) : SHORTCARD; (* Ermittelt die Anzahl *)
  72.                             (* von Tagen, welche es *)
  73.  BEGIN                            (* in einem Monat gibt. *)
  74.    IF Monat IN {1,3,5,7,8,10,12} THEN            (* bei einem falschen   *)
  75.      RETURN(31);                    (* Monat wird 0 als     *)
  76.    ELSIF Monat IN {4,6,9,11} THEN            (* Fehler ausgegeben    *)
  77.      RETURN(30);
  78.    ELSIF (Monat = 2) AND Schaltjahr(Jahr) THEN
  79.      RETURN(29);
  80.    ELSIF (Monat = 2) AND (NOT Schaltjahr(Jahr)) THEN
  81.      RETURN(28);
  82.    ELSE
  83.      RETURN(0);
  84.    END;
  85.  END maxDays;
  86.  
  87.  
  88.  PROCEDURE Month(VAR Tag : LONGCARD; Jahr : CARDINAL) : SHORTCARD; (* Ermittelt *)
  89.                                 (* den akt.  *)
  90.  VAR                                (* Monat.    *)
  91.     MONAT : SHORTCARD;
  92.  
  93.  BEGIN
  94.    MONAT := ErsterMonat;
  95.    WHILE Tag > maxDays(MONAT,Jahr) DO
  96.      Tag := Tag - maxDays(MONAT,Jahr);
  97.      INC(MONAT);
  98.    END;
  99.    RETURN(MONAT);
  100.  END Month;
  101.  
  102.  
  103.  PROCEDURE Weekday (Tag,Monat : SHORTCARD; Jahr : CARDINAL) : SHORTCARD;(* Ermittelt aus dem *)
  104.                             (* Datum den Wochen- *)
  105.  VAR
  106.     JAHR        : CARDINAL;
  107.     WOCHENTAG    : CARDINAL;
  108.     MONAT        : SHORTCARD;            (* tag. (1 = Montag) *)
  109.  
  110.  BEGIN
  111.    WOCHENTAG := ErsterWochentag;
  112.    JAHR := ErstesJahr;
  113.    WHILE JAHR < Jahr DO
  114.      INC(JAHR);
  115.      INC(WOCHENTAG);
  116.      IF Schaltjahr(JAHR) AND (JAHR # Jahr) THEN
  117.        INC(WOCHENTAG);
  118.      END;
  119.    END;
  120.    MONAT := 1;
  121.    WHILE MONAT < Monat DO
  122.      WOCHENTAG := WOCHENTAG + maxDays(MONAT,Jahr);
  123.      INC(MONAT);
  124.    END;
  125.    WOCHENTAG := WOCHENTAG + Tag - 1;
  126.    WOCHENTAG := WOCHENTAG MOD 7;
  127.    IF WOCHENTAG = 0 THEN
  128.      WOCHENTAG := 7;
  129.    END;
  130.    RETURN(SHORTCARD(WOCHENTAG));
  131.  END Weekday;
  132.  
  133.  
  134.  PROCEDURE GetDate (VAR Wochentag,Tag,Monat : SHORTCARD; VAR Jahr : CARDINAL);(* Holt das      *)
  135.                                 (* aktuelle Datum*)
  136.  VAR
  137.     sekunden        : LONGCARD;
  138.     Sekunde,Minute,Stunde    : SHORTCARD;
  139.  
  140.  BEGIN
  141.    sekunden    := GetSeconds();
  142.    Sekunde    := sekunden - (sekunden DIV 60) * 60;
  143.    sekunden    := (sekunden - Sekunde) DIV 60;
  144.    Minute    := sekunden - (sekunden DIV 60) * 60;
  145.    sekunden    := (sekunden - Minute) DIV 60;
  146.    Stunde    := sekunden - (sekunden DIV 24) * 24;
  147.    sekunden    := (sekunden - Stunde) DIV 24;
  148.    Jahr        := Year(sekunden);
  149.    Monat    := Month(sekunden,Jahr);
  150.    Tag        := sekunden;
  151.    Wochentag    := Weekday(Tag,Monat,Jahr);
  152.  END GetDate;
  153.  
  154.  
  155.  PROCEDURE GetTime (VAR Stunde,Minute,Sekunde : SHORTCARD);(* Holt die aktuelle*)
  156.                              (* Uhrzeit.         *)
  157.  VAR
  158.     sekunden : LONGCARD;
  159.  
  160.  BEGIN
  161.    sekunden  := GetSeconds();
  162.    Sekunde   := sekunden - (sekunden DIV 60) * 60;
  163.    sekunden  := (sekunden - Sekunde) DIV 60;
  164.    Minute    := sekunden - (sekunden DIV 60) * 60;
  165.    sekunden  := (sekunden - Minute) DIV 60;
  166.    Stunde    := sekunden - (sekunden DIV 24) * 24;
  167.  END GetTime;
  168.  
  169.  
  170.  PROCEDURE tagdiff(tag1,monat1 : SHORTCARD; jahr1 : CARDINAL; tag2,monat2 : SHORTCARD; jahr2 : CARDINAL) : INTEGER;
  171.                         (* Berechnet die       *)
  172.  VAR                        (* differnenz zwischen *)
  173.     t1,t2 : CARDINAL;            (* zwei Daten in Tagen *)
  174.                         (* Datum1 > Datum2     *)
  175.  BEGIN                        (* ergibt negatives    *)
  176.    t1 := tag1;                    (* Ergebnis           *)
  177.    t2 := tag2;
  178.    WHILE monat1 > 1 DO
  179.      DEC(monat1);
  180.      t1 := t1 + maxDays(monat1,jahr1);
  181.    END;
  182.    WHILE monat2 > 1 DO
  183.      DEC(monat2);
  184.      t2 := t2 + maxDays(monat2,jahr2);
  185.    END;
  186.    WHILE jahr1 > jahr2 DO
  187.      t1 := t1 + 365;
  188.      DEC(jahr1);
  189.      IF Schaltjahr(jahr1) THEN
  190.        INC(t1);
  191.      END;
  192.    END;
  193.    WHILE jahr2 > jahr1 DO
  194.      t2 := t2 + 365;
  195.      DEC(jahr2);
  196.      IF Schaltjahr(jahr2) THEN
  197.        INC(t2);
  198.      END;
  199.    END;
  200.    RETURN(t2-t1);
  201.  END tagdiff;
  202.  
  203.  
  204.  PROCEDURE wochentag(Tag : SHORTCARD; VAR string : wtstring;
  205.                       Sprache : SHORTCARD) : SHORTCARD;
  206.                                 (* Gibt den      *)
  207.  VAR                                (* Wochentag als *)
  208.     len : SHORTCARD;                    (* Text zurück   *)
  209.  
  210.  BEGIN
  211.    string := "";
  212.    CASE Sprache OF
  213.      0 : CASE Tag OF
  214.        1 : string := "monday";    |
  215.        2 : string := "tuesday";   |
  216.        3 : string := "wednesday"; |
  217.        4 : string := "thursday";  |
  218.        5 : string := "freiday";   |
  219.        6 : string := "saturday";  |
  220.        7 : string := "sunday";
  221.      ELSE
  222.      END;
  223.          len := 9;|
  224.      1 : CASE Tag OF
  225.        1 : string := "Montag";     |
  226.        2 : string := "Dienstag";   |
  227.        3 : string := "Mittwoch";   |
  228.        4 : string := "Donnerstag"; |
  229.        5 : string := "Freitag";    |
  230.        6 : string := "Samstag";    |
  231.        7 : string := "Sonntag";
  232.      ELSE
  233.      END;
  234.          len := 10;|
  235.      2 : CASE Tag OF
  236.        1 : string := "lundi";   |
  237.        2 : string := "mardi";   |
  238.        3 : string := "mercredi";|
  239.        4 : string := "jeudi";   |
  240.        5 : string := "vendredi";|
  241.        6 : string := "samedi";  |
  242.        7 : string := "dimanche";
  243.      ELSE
  244.      END;
  245.          len := 8;|
  246.      3 : CASE Tag OF
  247.        1 : string := "lunes";     |
  248.        2 : string := "martes";    |
  249.        3 : string := "miércoles";|
  250.        4 : string := "jueves";    |
  251.        5 : string := "viernes";   |
  252.        6 : string := "sábado";   |
  253.        7 : string := "domingo";
  254.      ELSE
  255.      END;
  256.          len := 9;
  257.    END;
  258.    RETURN(len);
  259.  END wochentag;
  260.  
  261.  
  262.  PROCEDURE GetWeek(Tag,Monat : SHORTCARD; Jahr : CARDINAL) : SHORTCARD;
  263.  
  264.  VAR week : SHORTCARD;
  265.      wt   : SHORTCARD;
  266.  
  267.  BEGIN
  268.     wt := Weekday(1,1,Jahr);
  269.     IF wt = 1 THEN
  270.       week := tagdiff(1,1,Jahr,Tag,Monat,Jahr) DIV 7 +1;
  271.     ELSE
  272.       week := tagdiff(9-wt,1,Jahr,Tag,Monat,Jahr);
  273.       IF week < 0 THEN
  274.         week := GetWeek(31,12,Jahr-1);
  275.       ELSE
  276.         week := week DIV 7 +1;
  277.       END;
  278.     END;
  279.     RETURN(week);
  280.  END GetWeek;
  281.  
  282.  
  283.  PROCEDURE FormatDate(Tag,Monat : SHORTCARD; Jahr : CARDINAL; VAR datum : datestr);
  284.  
  285.  VAR tag,monat    : ARRAY [1..3] OF CHAR;
  286.      jahr    : ARRAY [1..5] OF CHAR;
  287.      err    : BOOLEAN;
  288.  
  289.  BEGIN
  290.    datum := "";
  291.    ValToStr(Tag,FALSE,tag,10,2,'0',err);
  292.    ValToStr(Monat,FALSE,monat,10,2,'0',err);
  293.    ValToStr(Jahr,FALSE,jahr,10,4,'0',err);
  294.    Concat(datum,tag);
  295.    Concat(datum,".");
  296.    Concat(datum,monat);
  297.    Concat(datum,".");
  298.    Concat(datum,jahr);
  299.  END FormatDate;
  300.  
  301.  
  302.  PROCEDURE monat(Monat : SHORTCARD; VAR string : wtstring;
  303.                     Sprache : SHORTCARD) : SHORTCARD;
  304.  
  305.  VAR
  306.     len : SHORTCARD;
  307.  
  308.  BEGIN
  309.    string := "";
  310.    CASE Sprache OF
  311.      0 : CASE Monat OF
  312.         1 : string := "january";|
  313.         2 : string := "february";|
  314.         3 : string := "march";|
  315.         4 : string := "april";|
  316.         5 : string := "may";|
  317.         6 : string := "june";|
  318.         7 : string := "july";|
  319.         8 : string := "august";|
  320.         9 : string := "september";|
  321.        10 : string := "october";|
  322.        11 : string := "november";|
  323.        12 : string := "december";
  324.      ELSE
  325.      END;
  326.          len := 9;|
  327.      1 : CASE Monat OF
  328.         1 : string := "Januar";|
  329.         2 : string := "Februar";|
  330.         3 : string := "März";|
  331.         4 : string := "April";|
  332.         5 : string := "Mai";|
  333.         6 : string := "Juni";|
  334.         7 : string := "Juli";|
  335.         8 : string := "August";|
  336.         9 : string := "September";|
  337.        10 : string := "Oktober";|
  338.        11 : string := "November";|
  339.        12 : string := "Dezember";
  340.      ELSE
  341.      END;
  342.          len := 9;|
  343.      2 : CASE Monat OF
  344.         1 : string := "janvier";|
  345.         2 : string := "février";|
  346.         3 : string := "mars";|
  347.         4 : string := "avril";|
  348.         5 : string := "mai";|
  349.         6 : string := "juni";|
  350.         7 : string := "juillet";|
  351.         8 : string := "août";|
  352.         9 : string := "septembre";|
  353.        10 : string := "octobre";|
  354.        11 : string := "novembre";|
  355.        12 : string := "décembre";
  356.      ELSE
  357.      END;
  358.          len := 9;|
  359.      3 : CASE Monat OF
  360.         1 : string := "enero";|
  361.         2 : string := "febrero";|
  362.         3 : string := "marzo";|
  363.         4 : string := "abril";|
  364.         5 : string := "mayo";|
  365.         6 : string := "junio";|
  366.         7 : string := "julio";|
  367.         8 : string := "agosto";|
  368.         9 : string := "septiembre";|
  369.        10 : string := "octubre";|
  370.        11 : string := "noviembre";|
  371.        12 : string := "diciembre";
  372.      ELSE
  373.      END;
  374.          len := 10;
  375.    END;
  376.    RETURN(len);
  377.  END monat;
  378.  
  379.  
  380.  BEGIN
  381.  END Datum.
  382.