home *** CD-ROM | disk | FTP | other *** search
/ Power-Programmierung / CD1.mdf / pascal / library / dos / pstoolbx / kaldef.int < prev    next >
Encoding:
Text File  |  1993-07-28  |  10.0 KB  |  275 lines
  1. UNIT KalDef;
  2.  
  3. {$X+,F+,O+,D-,L-,R-,B-}
  4.  
  5. INTERFACE
  6.  
  7. USES Dos, Objects;
  8.  
  9. const  Copyright = ' (c) 1991 G. Blumert, Hochdonner Chaussee 16, D-2224 Burg/Dithm.';
  10.  
  11. TYPE
  12.  
  13.   STRING40 = STRING[40];
  14.  
  15.  
  16.   PUnSortedStringCollection = ^UnSortedStringCollection;
  17.   UnSortedStringCollection = OBJECT(TStringCollection)
  18.     constructor init(ALimit, ADelta: integer);
  19.     FUNCTION Compare(Key1, Key2: POINTER): INTEGER; VIRTUAL;
  20.   END;
  21.   { Compare gibt stets 0 zurück, daher werden die Strings in der Reihenfolge }
  22.   { belassen, in der sie angefügt werden }
  23.  
  24.   FtagArr = ARRAY[1..4] OF WORD;
  25.  
  26.   { Für GetMoonMonth }
  27.   Kalenderdatum = RECORD
  28.     t,m,j: INTEGER;
  29.     h, min: BYTE
  30.   END;
  31.   MondMonat =  ARRAY[1..6] OF Kalenderdatum;
  32.  
  33.   Feiertagstabelle = RECORD
  34.                    beachten    : BOOLEAN;
  35.                    JMin, JMax  : INTEGER;
  36.                    CASE Art: CHAR OF
  37.                      'A','O': (Differenz: INTEGER); { Advent, Ostern }
  38.  
  39.                      { Am ersten Tag mit Wochentagnummer ab Tagnummer T_min }
  40.                      'W': (T_min, Dummy: WORD; Wochentagnummer: BYTE);
  41.  
  42.                      { Am festen Datum }
  43.                      'D': (Tagnummer: WORD);
  44.  
  45.                      { In Schaltjahren }
  46.                      'S': (Nummer: INTEGER)
  47.  
  48.   END;
  49.  
  50.   PFtagRec = ^FTagRec;
  51.   FTagRec = OBJECT(TObject)
  52.           Tab : Feiertagstabelle;
  53.           Name: PString;
  54.   END;
  55.  
  56.   Jahr  = ARRAY[1..386] OF FtagArr;         { Nimmt Nummern der Feiertage auf }
  57.   PJahr = ^Jahr;
  58.  
  59.   Header_des_kalenderfiles = RECORD
  60.               cor                           : STRING[Length(Copyright)];
  61.               Kennung                       : CHAR;
  62.               Anzahl_der_Wochentage         : BYTE;
  63.               Anzahl_der_Monate             : BYTE;
  64.               Anzahl_der_Feiertage          : WORD;
  65.               SamstagsNr                    : BYTE;
  66.               SamstagFrei                   : BOOLEAN;
  67.               SonntagsNr                    : BYTE;
  68.               SonntagFrei                   : BOOLEAN;
  69.   END;
  70.  
  71. (********************************************************)
  72.   PKalender = ^Kalendarium;
  73.   Kalendarium = OBJECT(TObject)
  74.  
  75.     { Falls Sie dem Anwender erlauben, Kalendarien zu ändern }
  76.     Changed                           : BOOLEAN;
  77.  
  78.     Kalender_Parameter                : Header_des_Kalenderfiles;
  79.     Kalenderpfad                      : PathStr;
  80.     Wochen_pro_Monat                  : BYTE;
  81.  
  82.     { Aktuelles Kalenderdatum }
  83.     Akt_Datum                         : LongInt;     
  84.  
  85.     { Liste der Wochentage    }
  86.     Wtag                              : PUnSortedStringCollection;
  87.  
  88.     { Liste der Monate        }
  89.     Monat                             : PUnSortedStringCollection;
  90.  
  91.     { Liste der Feiertage     }
  92.     Ftag                              : PCollection;
  93.  
  94.     { Zeiger auf ein Array, das die Nummern der Feiertage eines }
  95.     { Jahres enthält                                            }
  96.     Feiertage                         : PJahr;
  97.  
  98.     { Lädt Kalenderdefinition aus angegebener Datei }
  99.     CONSTRUCTOR Load(Name: pathstr);  
  100.  
  101.     { Initialisiert keine Kollektionen       }
  102.     CONSTRUCTOR INIT;
  103.  
  104.     DESTRUCTOR DONE; VIRTUAL;
  105.  
  106.     { Speichert das Kalendarium in KALENDERPFAD }
  107.     PROCEDURE Store;
  108.  
  109.     { Setzt das Kalenderdatum auf Rechnerdatum, falls möglich }
  110.     PROCEDURE InitDate; VIRTUAL;      
  111.  
  112.     { Gibt TRUE zurück, wenn Initialisierung erfolgreich }
  113.     FUNCTION Valid: BOOLEAN; VIRTUAL; 
  114.  
  115.     PROCEDURE KGetDate(VAR t,m,j: INTEGER); { Ermittelt Kalenderdatum }
  116.  
  117.     PROCEDURE KSetDate(t,m,j: INTEGER);     { Setzt neues Kalenderdatum }
  118.  
  119.     { Rechnet Tag, Monat, Jahr in julianische Tagnummer um }
  120.     FUNCTION Date_JD(t,m,j: INTEGER): LongInt;           VIRTUAL;
  121.  
  122.     { Rechnet julianische Tagnummer in Tag, Monat, Jahr um }
  123.     PROCEDURE JD_Date(jd: LongInt; VAR t,m,j: INTEGER);  VIRTUAL;
  124.  
  125.     { Ermittlet aus laufender Nummer des Tages im Jahr und Jahreszahl }
  126.     { die julianische Tagnummer                                       }
  127.     FUNCTION MakeJD(nr, j: INTEGER): LongInt;
  128.  
  129.     FUNCTION FirstJ: INTEGER;  VIRTUAL; { Erstes Jahr der Gültigkeit  }
  130.     FUNCTION LastJ : INTEGER;  VIRTUAL; { Letztes Jahr der Gültigkeit }
  131.     FUNCTION FirstJD:LongInt;  VIRTUAL; { Erster JD der Gültigkeit    }
  132.     FUNCTION LastJD: LongInt;  VIRTUAL; { Letzter JD der Gültigkeit   }
  133.  
  134.     { Prüft Datum auf Gültigkeit }
  135.     FUNCTION Check_Date(t,m,j: INTEGER):BOOLEAN;
  136.  
  137.     { Prüft Tag auf Gültigkeit }
  138.     FUNCTION Check_Day(t,m,j: INTEGER): BOOLEAN;
  139.  
  140.     { Prüft Monat auf Gültigkeit }
  141.     FUNCTION Check_Month(m,j: INTEGER): BOOLEAN;
  142.  
  143.     { Prüft Jahr auf Gültigkeit }
  144.     FUNCTION Check_Year(j: INTEGER):    BOOLEAN; VIRTUAL;
  145.  
  146.     { Prüft julianische Tagnummer auf Gültigkeit }
  147.     FUNCTION Check_JD(jd: LongInt):     BOOLEAN;
  148.  
  149.     { Geben TRUE zurück, wenn neues Datum im Gültigkeitsbereich }
  150.  
  151.     { Zählt einen Tag vor/zurück }
  152.     FUNCTION Inc_Tag(VAR t,m,j: INTEGER): BOOLEAN;
  153.     FUNCTION Dec_Tag(VAR t,m,j: INTEGER): BOOLEAN;
  154.  
  155.     { Zählt einen Monat vor/zurück }
  156.     FUNCTION Inc_Monat(VAR m,j: INTEGER): BOOLEAN;
  157.     FUNCTION Dec_Monat(VAR m,j: INTEGER): BOOLEAN;
  158.  
  159.     { Zählt Count Jahre vor/zurück }
  160.     FUNCTION Inc_Jahr(count: INTEGER; VAR j: INTEGER): BOOLEAN; VIRTUAL;
  161.  
  162.     { Gibt Anzahl der Tage des Monats zurück }
  163.     FUNCTION Anz_Tage(m,j: INTEGER):    BYTE;               VIRTUAL;
  164.  
  165.     { Gibt Anzahl der Monate im Jahr J zurück }
  166.     FUNCTION Anz_Monate(j: INTEGER): BYTE;                  VIRTUAL;
  167.  
  168.     { Gibt den Namen des Monats zurück }
  169.     FUNCTION Monatname(m,j: INTEGER): STRING;               VIRTUAL;
  170.  
  171.     { Ermittelt aus Nummer des julianischen Tages die des jul. Jahres }
  172.     FUNCTION Julian_Year(jd: LongInt): INTEGER;
  173.  
  174.     { True in Schaltjahren }
  175.     FUNCTION Schaltjahr(j: INTEGER): BOOLEAN;                VIRTUAL;
  176.  
  177.     FUNCTION Ermittle_Wochentagnummer(t,m,j: INTEGER): BYTE; VIRTUAL;
  178.  
  179.     { Ermittelt Indiktionszahl - JJ = julianische Jahreszahl! }
  180.     FUNCTION RoemerZinsZahl(jj: INTEGER): BYTE;
  181.  
  182.     { Ermittelt die goldene Zahl für das Jahr     }
  183.     { Ist nur definiert für Greg_Kal und Jul_Kal! }
  184.     FUNCTION GOLDENE_ZAHL(j: INTEGER): BYTE;                VIRTUAL;
  185.  
  186.     { Ermittelt die laufende Nummer des Tages im Jahr }
  187.     FUNCTION TAG_IM_JAHR(t,m,j: INTEGER): INTEGER;          VIRTUAL;
  188.  
  189.     { Eingabe: laufende Nummer und Jahr - Ausgabe: Tag und Monat }
  190.     PROCEDURE ERMITTLE_DATUM(nr: INTEGER; VAR t,m: INTEGER; j: INTEGER); VIRTUAL;
  191.  
  192.     {Ermittelt aus dem Datum die Nummer der dazugehörigen Kalenderwoche }
  193.     { Diese Funktion geht davon aus, daß die Woche, in die der erste    }
  194.     { Tag mit der Nummer 0 (Montag) fällt, die erste Kalenderwoche ist. }
  195.     { Eine Funktion nach DIN 1355 ist in G_Kal.PAS implementiert        }
  196.     FUNCTION KAL_WO(t,m,j: INTEGER): BYTE;                   VIRTUAL;
  197.  
  198.     { Ermittelt die laufende Tagnummer von Ostern }
  199.     FUNCTION OSTERN(j: INTEGER): INTEGER;                   VIRTUAL;
  200.  
  201.     { Ermittelt die laufende Tagnummer des 1. Advent }
  202.     FUNCTION ADVENT(j: INTEGER): INTEGER;                   VIRTUAL;
  203.  
  204.     { TRUE, wenn Datum ein Feiertag ist }
  205.     FUNCTION IsFeiertag(tnr,t,m,j: INTEGER): BOOLEAN; VIRTUAL;
  206.  
  207.     { Gibt ein Array mit bis zu vier Feiertagen zurück, die auf den     }
  208.     { gleichen Tag fallen. -1 = ungültig!                               }
  209.     { nr enthält laufende Nummer des Tages im Jahr                      }
  210.     PROCEDURE FTAG_NUMMER(nr, j: INTEGER; VAR FTs: FTagArr);
  211.  
  212.     { Gibt in Mond die Daten der drei am nächsten liegenden Vollmond/   }
  213.     { Neumond - Daten zurück.                                           }
  214.     { 1..3 = Neumond, 4..6 = Vollmond; M = 0 ==> ungültig               }
  215.     PROCEDURE GET_MoonMonth(mm,mj: INTEGER; VAR mond: mondmonat); VIRTUAL;
  216.  
  217.     { Gibt Vollmond bzw. Neumond - Daten als String zurück              }
  218.     FUNCTION MakeMoonString(m: INTEGER; index: BYTE; Mond: MondMonat): STRING;
  219.  
  220.     { Laufende Nummer des Werktages im Monat/Jahr }
  221.     FUNCTION Werktag_im_Monat(tt,mm,jj: INTEGER): INTEGER;
  222.     FUNCTION Werktag_im_Jahr(tt,mm,jj: INTEGER): INTEGER;
  223.  
  224.     { Gibt die Nummer des als String übergebenen Monats zurück, wenn    }
  225.     { Nicht gefunden, dann 0                                            }
  226.     FUNCTION MakeMonat(VAR s: STRING40): INTEGER;
  227.  
  228.     { Ermittlet aus dem übergebenen String das Datum und stellt Kalender}
  229.     { entsprechend ein. Im String darf auch ein Monatsname im Klartext  }
  230.     { (oder ein Teil davon) enthalten sein.                             }
  231.     { Gültig wäre z. B. 1. Ap. 91                                       }
  232.     { Im greg. Kal wird Jahreszahl < 100 als 1980 < j <= 2080 interpret.}
  233.     FUNCTION MakeDatum(altdatum: STRING40): BOOLEAN;
  234.  
  235.     { Füllt die Kollektionen mit Namen und Daten der Feiert. des einge- }
  236.     { stellten Monats                                                   }
  237.     FUNCTION Fuelle_FeiertagsListe(FListe: PUnsortedStringCollection): BOOLEAN;
  238.  
  239.     { Füllt Feiertage^                                                  }
  240.     PROCEDURE InitJahr(j: INTEGER);
  241.  
  242.     { Ermittelt aus der übergebenen Tabelle die Nummer des Tages im Jahr}
  243.     { j, auf den der beschriebene Feiertag fällt                        }
  244.     FUNCTION GetFtDayNumber(Tab: Feiertagstabelle;j: INTEGER): INTEGER; VIRTUAL;
  245.  
  246.     { Trägt die Nummer FTagNum für den Tag tnr in Feiertage^ ein }
  247.     PROCEDURE Trage_ein(tnr: INTEGER; FTagNum: WORD);
  248.  
  249.     { Prüft, ob Feiertag im Jahr j angezeigt werden soll         }
  250.     FUNCTION CheckFTJahr(Jmin, JMax, J: INTEGER): BOOLEAN;
  251.  
  252.     { Setzt einige Parameter in Abhängigkeit des Kalendariums }
  253.     PROCEDURE InitSpecials; VIRTUAL;
  254.  
  255.   PRIVATE
  256.  
  257.     Altjahr                           : INTEGER;
  258.     IsValid                           : BOOLEAN;
  259.  
  260. END;
  261.  
  262. CONST
  263. { Index-Konstanten für MakeMoonString }
  264.   Vollmond = 4;
  265.   Neumond  = 1;
  266.  
  267. { Konstanten für Fehlermeldungen }
  268.   KeinFehler    = 0;
  269.   NichtGefunden = 2;
  270.  
  271. IMPLEMENTATION
  272.  
  273. USES App, Views, MsgBox, Memory, Tabellen, KalDos, Drivers;
  274.  
  275.