{ 1} PROGRAM Kalender;
{ 2} {$N+E+}
{ 3} { Programm zur Berechnung von Julianischem Tag, Amsat- }
{ 4} { Tag und den Umkehrfunktionen wie Amsat-Tag in Datum und }
{ 5} { Jul-Tag in Datum, sowie lfd Tag eines Jahres und Wochen- }
{ 6} { tag. Von M. Maday, DC9ZP,Potsdamer Str. 5, 56235 Ransbach}
{ 7} USES CRT,Kalunit; { Kalenderunit einbinden}
{ 8} { Eingabe des Datums}
{ 9} PROCEDURE Eingabe_dat(VAR tag,monat,jahr:INTEGER);
{ 10} BEGIN
{ 11} wr(8,7, ' Bitte Datum eingeben 1. Tag ');READLN(tag);
{ 12} wr(8,9, ' 2. Monat ');READLN(monat);
{ 13} wr(8,11,' 3. Jahr(JJJJ) ');READLN(Jahr);
{ 14} CLRSCR;
{ 15} END;
{ 16} PROCEDURE Return(y:INTEGER);
{ 17} BEGIN wr(22,y,' Weiter mit Return');READLN;END;
{ 18} { Julianischen Tag berechnen }
{ 19} PROCEDURE Rechne_jultag;
{ 20} VAR t,m,j:INTEGER;
{ 21} BEGIN
{ 22} CLRSCR;
{ 23} eingabe_dat(t,m,j);
{ 24} Julday := jultage(t,m,j);{ Jul-Routine in Kalunit aufrufen}
{ 25} Amsatday := julday-2443509.5; { Amsat-Tag aus Jul-Dat}
{ 26} weekday := wochentag(julday);
{ 27} wr(10,2, ' Ausgabe des Berechnungsergebnisses ');
{ 28} wr(10,4, ' Eingegebenes Datum...............: '+datum(t,m,j));
{ 29} wr(10,6, ' Julianischer Tag (JD)............: '+tv(julday,7,1));
{ 30} wr(10,8, ' Korrespondierender AMSAT-Tag.....: '+tv(amsatday,5,1));
{ 31} wr(10,10,' Wochentag........................: '+weekday);
{ 32} return(13);
{ 33} END;
{ 34} { Julianischen Tag in Datum umwandeln}
{ 35} PROCEDURE Jultag_datum;
{ 36} BEGIN
{ 37} CLRSCR;
{ 38} wr(10,4, ' Bitte Julianischen Tag eingeben ');
{ 39} READLN(julday);
{ 40} jultermin := jul_TO_dat(julday); { Routine in Kalunit aufrufen}
{ 41} weekday := wochentag(julday); { Wochentag ermitteln}
{ 42} CLRSCR;
{ 43} wr(10,2,' Julianischer Tag in Datum ');
{ 44} wr(10,4,' Eingebener Julianischer Tag..........: '+tv(julday,7,1));
{ 45} wr(10,6,' Errechnetes Datum....................: '+jultermin);
{ 46} wr(10,8,' Wochentag............................: '+weekday);
{ 47} return(11);
{ 48} END;
{ 49} { AMSAT-Tag in normales Kalenderdatum umwandeln}
{ 50} PROCEDURE Amsat_datum;
{ 51} BEGIN
{ 52} CLRSCR;
{ 53} wr(10,4, ' Bitte AMSAT-Tag eingeben ');
{ 54} READLN(amsatday);
{ 55} amsat_termin := amsattag_TO_dat(amsatday);
{ 56} julday := amsatday+2443509.5;
{ 57} weekday := wochentag(julday);
{ 58} CLRSCR;
{ 59} wr(10,2,' AMSAT-Tag in Datum umrechnen');
{ 60} wr(10,4,' Eingebener AMSAT-Tag.................: +tv(amsatday,5,1));
{ 61} wr(10,6,' Korrespondierender Julianischer Tag..: '+tv(julday,7,1));
{ 62} wr(10,8,' Errechnetes Datum....................: '+amsat_termin);
{ 63} wr(10,10,' Wochentag............................: '+weekday);
{ 64} return(13);
{ 65} END;
{ 66} { Den laufenden Jahrestag berechnen }
{ 67} PROCEDURE Rechne_jahrestag;
{ 68} VAR t,m,j: INTEGER;
{ 69} BEGIN
{ 70} clrscr;eingabe_dat(t,m,j);
{ 71} lfdtag := Jahrestag(t,m,j); { Routine in KALUNIT aufrufen}
{ 72} Julday := jultage(t,m,j); { Jul-Datum berechnen}
{ 73} weekday := wochentag(julday); { Wochentag berechnen}
{ 74} wr(10,2, ' Ausgabe des Berechnungsergebnisses ');
{ 75} wr(10,4, ' Eingegebenes Datum...................: '+datum(t,m,j));
{ 76} wr(10,6, ' Ermittelter laufender Jahrestag......: +tv(lfdtag,3,0));
{ 77} wr(10,8, ' Wochentag............................: '+weekday);
{ 78} return(11);
{ 79} END;
{ 80} { Datum aus dem laufenden Jahrestag ermitteln}
{ 81} PROCEDURE Jahrestag_datum;
{ 82} var k:integer;
{ 83} BEGIN
{ 84} CLRSCR;
{ 85} wr(10,4, ' Bitte laufenden Jahrestag eingeben (1..366) ');
{ 86} READLN(lfdtag);
{ 87} wr(10,6, ' Bitte das Jahr (JJJJ) eingeben.............: ');
{ 88} READLN(jahr);
{ 89} k := schaltjahr(jahr);
{ 90} if k = 2 then if lfdtag > 365 then lfdtag:=365;
{ 91} jahrtermin := Lfdtag_TO_date(lfdtag,jahr);{KALUNIT aufrufen}
{ 92} CLRSCR;
{ 93} wr(10,2,' Laufender Tag in Datum umrechnen');
{ 94} wr(10,4,' Eingegebener Laufender Tag...........: '+tv(lfdtag,3,0));
{ 95} wr(10,6,' Errechnetes Datum....................: '+jahrtermin);
{ 96} return(9);
{ 97} END;
{ 98} { Tagesdifferenz zwischen zwei Daten ermitteln}
{ 99} PROCEDURE Differenz_tage;
{100} VAR t,m,j,t1,m1,j1 : INTEGER;
{101} jul1,jul2,diff : REAL;
{102} BEGIN
{103} CLRSCR;
{104} wr(5,5,' Bitte erstes Datum eingeben');
{105} eingabe_dat(t,m,j);
{106} CLRSCR;
{107} wr(5,5,' Bitte zweites Datum eingeben ');
{108} eingabe_dat(t1,m1,j1);
{109} jul1:=jultage(t,m,j); { Zweimal Jul-Tag berechnen }
{110} jul2:=jultage(t1,m1,j1);
{111} diff:=abs(jul2-jul1); { und die Differenz bilden }
{112} CLRSCR;
{113} wr(10,2,'Tagesdifferenzen zwischen zwei Daten berechnen');
{114} wr(10,4,'Erstes Datum.........................: '+datum(t,m,j));
{115} wr(10,6,'Zweites Datum........................: '+datum(t1,m1,j1));
{116} wr(10,8,'Tagesdifferenz.......................: '+tv(diff,0,1));
{117} return(11);
{118} END;
{119} { Kirchliche Ereignisse im laufenden Jahr berechnen }
{120} PROCEDURE Rechne_feiertage;
{121} VAR jahr:INTEGER;
{122} BEGIN
{123} CLRSCR;
{124} wr(10,4,' Bitte gewünschtes Jahr (JJJJ) eingeben ');
{125} READLN(jahr);
{126} osterdatum(jahr); { Routinen in der KALUNIT aufrufen }
{127} jahrestermine(jahr);
{128} CLRSCR;
{129} wr(10,2,' Kirchliche Feiertage im gewählten Jahr ');
{130} wr(10,4,'Datum des Rosenmontags........: '+ rosenmontag);
{131} wr(10,5,'Datum des Ostersonntags.......: '+ ostertag);
{132} wr(10,6,'Datum des Himmelfahrtstages...: '+ himmelfahrt);
{133} wr(10,7,'Datum des Pfingstsonntags.....: '+ pfingsten);
{134} wr(10,8,'Datum des Fronleichnamstages..: '+ fronleichnam);
{135} wr(10,9,'Datum des 1.Advent............: '+ advent1);
{136} wr(10,10,'Datum des 4.Advent............: '+ advent4);
{137} wr(10,11,'Datum des Totensonntags.......: '+ totensonntag);
{138} wr(10,12,'Datum des Buß & Bettags.......: '+ busstag);
{139} return(15);
{140} END;
{141} { Das Hauptmenü des Programms }
{142} PROCEDURE Kalendermenue;
{143} VAR wahl:CHAR;
{144} BEGIN
{145} REPEAT
{146} CLRSCR;
{147} wr(10,2,' Kalenderberechnungen von DC9ZP ');
{148} wr(10,4,'Datum in Julianischen Tag und AMSAT-Tag umrechnen..: A');
{149} wr(10,5,'Julianischen Tag in Datum umrechnen................: B');
{150} wr(10,6,'AMSAT-Tag in Datum umrechnen.......................: C');
{151} wr(10,7,'Den laufenden Tag des Jahres berechnen.............: D');
{152} wr(10,8,'Datum aus laufendem Tag des Jahres.................: E');
{153} wr(10,9,'Tagesdifferenzen zwischen zwei Daten...............: F');
{154} wr(10,10,'Feiertage im Jahr berechnen........................: G');
{155} wr(10,11,'Programmende.......................................: Q');
{156} wahl:=READKEY;
{157} case UPCASE(wahl) of
{158} 'A': rechne_jultag; { Aufruf der entsprechenden Routinen}
{159} 'B': jultag_datum;
{160} 'C': amsat_datum;
{161} 'D': rechne_jahrestag;
{162} 'E': jahrestag_datum;
{163} 'F': differenz_tage;
{164} 'G': rechne_feiertage;
{165} 'Q': EXIT;
{166} END;
{167} UNTIL wahl in ['A'..'G','Q'];{ Ende wenn Buchstabe = Q (uit)}
{168} END;
{169} BEGIN { Hier beginnt das Programm}
{170} Textattr := 31;
{171} kalendermenue; { Nur noch Menü aufrufen }
{172} END.