Compy Shop Magazin 1988 September/Compy_Shop_Magazin_1988_09___de_Side_A.atr/kalender.pas

Pascal/Delphi Source File | 2023-02-26 | 2KB | 1 lines

PROGRAM kalender(input,output);¢¢CONST¢maxlaenge = 10;¢¢TYPE¢¢string10=ARRAY[1..maxlaenge] OF char;¢geburtstag = record¢             tag:integer;¢             monat:integer;¢             jahr:integer¢END;¢¢VAR¢ datum:string10;¢ geb:geburtstag;¢ tagzahl,a:integer;¢ schluss:boolean;¢ warte:char;¢ printer:text;¢¢#i cls.i¢#i datum.i¢¢¢FUNCTION schj(Var ja:integer):boolean;¢BEGIN¢schj:=FALSE;¢IF (ja MOD 4 = 0) AND (ja MOD 100 <> 0) THEN schj:=TRUE;¢IF (ja MOD 400=0) THEN schj:=True;¢END;¢PROCEDURE wochentag(VAR tzahl:integer);¢¢VAR¢  Vjahr:integer;¢¢BEGIN¢vjahr:=1582;¢IF geb.jahr>1700 THEN¢BEGIN¢ vjahr:=1700;¢ tzahl:=4;¢END;¢IF geb.jahr>1800 THEN¢BEGIN¢ vjahr:=1800;¢ tzahl:=2;¢END;¢IF geb.jahr>1900 THEN¢BEGIN¢ vjahr:=1900;¢ tzahl:=0;¢END;¢WHILE geb.jahr>vjahr DO¢ BEGIN¢ tzahl:=tzahl+1;¢ IF tzahl>6 THEN tzahl:=0;¢ IF schj(vjahr)=TRUE THEN tzahl:=tzahl+1;¢ IF tzahl>6 THEN tzahl:=0;¢ vjahr:=vjahr+1;¢END; (* von WHILE *)¢CASE geb.monat OF¢ 1,10:tzahl:=tzahl;¢ 2,3,11: tzahl:=tzahl+3;¢ 4,7: tzahl:=tzahl+6;¢ 5: tzahl:=tzahl+1;¢ 6: tzahl:=tzahl+4;¢ 8: tzahl:=tzahl+2;¢ 9,12:tzahl:=tzahl+5;¢END; (* Case-list *)¢IF (schj(geb.jahr)=TRUE) AND (geb.monat>2) THEN tzahl:=tzahl+1;¢tzahl:=tzahl+geb.tag;¢WHILE tzahl>6 DO¢BEGIN¢ tzahl:=tzahl-7¢END¢END; (* wochentag *)¢BEGIN (* Hauptprogramm *)¢REPEAT¢schluss:=FALSE;¢cls;¢a:=5;¢leer(a);¢writeln('Geben Sie das gewuenschte Datum ein,');¢writeln('fuer das der Wochentag zu ermitteln ist');¢a:=16;¢writeln;¢writeln('beenden mit "#" ');¢writeln;write('>> ':10);¢readln(datum);¢IF datum[1]='#' THEN schluss:=TRUE;¢IF schluss=FALSE THEN¢BEGIN¢machdatum(datum,geb.tag,geb.monat,geb.jahr);¢tagzahl:=4;¢wochentag(tagzahl);¢cls;¢leer(a);¢CASE tagzahl OF¢ 0:write ('Sonntag':15);¢ 1:write ('Montag':15);¢ 2:write ('Dienstag':15);¢ 3:write ('Mittwoch':15);¢ 4:write ('Donnerstag':15);¢ 5:write ('Freitag':15);¢ 6:write ('Samstag':15);¢END; (* CASE-Liste *)¢write('den':4);¢writeln(geb.tag:3,'.',geb.monat:2,'.',geb.jahr);¢a:=2;¢leer(a);¢writeln('Fortsetzung RETURN 2x':30);¢readln(warte)¢END;¢UNTIL schluss¢END.¢¢¢¢¢¢