Zeitgemäße Programmierung verwendet anstelle von GOSUB den ähnlich wirkenden Befehl SUB ohne Parameterübergabe.
Beim Aufruf des Programmes wird der gewünschte Name der Ausgabedatei als Parameter mitgegeben. Die Datei sieht z.B. etwa so aus:
Fr 1.JAN 2016 -------- 1.1. Neujahr 1.1.1948 Geb.Peter Meier So 3.JAN 2016 -------- Di 5.JAN 2016 -------- 5.1.1996 Johanna Sievers … usw.Im Laufe des Jahres kann man mit einem normalen Texteditor weitere Termine und Texte in die Ausgabedatei eintragen. Wenn man es möchte, kann man die Datei dabei in ein Tagebuch umwandeln.
Die von Ostern abhängigen Feiertage werden im Programm mit der Feiertagsberechnung nach Gauß ermittelt. Sonstige besondere Tage wie Neujahr, Weihnachten, Geburtstage etc. sind in der der Datei „geb.txt” eingetragen. Diese Datei wird im gleichen Verzeichnis wie das Programm erwartet. Ihr Ende wird durch eine Zeile mit dem Inhalt -99 gekennzeichnet:
1,1,0, "Neujahr" 1,1,1948,"Geb.Peter Meier" 1,5,0, "Maifeiertag" 3,10,0, "Tag der deutschen Einheit" 31,10,0, "Reformationstag" 1,11,0, "Allerheiligen" 24,12,0, "Heiligabend" 25,12,0, "1.Weihnachtstag" 26,12,0, "2.Weihnachtstag" 31,12,0,"Silvester" 5,1,1996,"Johanna Sievers" … usw. -99
Home
Sitemap
Auswahl BASIC
DEFINT A-Z
'Das Programm gibt einen Jahreskalender aus: fuer jeden Tag im Jahr
'eine Zeile
'Compilierung mit z.B. fbc -lang qb test\tageskal.bas
'Datentyp fuer die Namen der Monate und die Anzahl von Tagen in jedem Monat:
TYPE monattyp
Anzahl AS INTEGER 'Anzahl von Tagen im Monat
MName AS STRING * 3 'Name des Monats (Abkuerzung mit 3 Buchstaben)
atag AS INTEGER 'Anfangstag des Monats (-1 bedeutet nicht ermittelt)
END TYPE
'Datentyp fuer Feiertage
TYPE wftagtyp
tag AS INTEGER
monat AS INTEGER
bez AS STRING * 29
END TYPE
CONST A.jahrestag = 200
'Datentyp fuer Jahrestage
TYPE Jahrestag
tag AS INTEGER 'Struktur eines Jahrestag
monat AS INTEGER
jahr AS INTEGER
bez AS STRING * 80
END TYPE
'Prozeduren:
DECLARE FUNCTION IstSchaltJahr% (N%)
DECLARE FUNCTION holeingabe% (Anfrage$, NiedWert%, HoherWert%)
DECLARE SUB BerechnMonat (jahr%, monat%, starttag%, TotalTage%)
'Konstanten fuer die Berechnung der Feiertage
'Anzahl der zu berechnenden Feiertage
CONST A.fei = 9
'Position der Feiertage im Array tftag[]
CONST KARF = 1
CONST OST1 = 2
CONST OST2 = 3
CONST MUTT = 4
CONST CHRI = 5
CONST PFI1 = 6
CONST PFI2 = 7
CONST FRON = 8
CONST BUSS = 9
DIM shared Monatdatum(1 TO 12) AS monattyp
DIM Jahrestag(1 TO A.jahrestag) AS Jahrestag
FILE$ = COMMAND$
IF FILE$ <> "" THEN
OPEN "O", #2, FILE$
ELSE
PRINT "Bitte gebe den Namen der zu erstellenden Kalenderdatei als Aufrufparameter an"
END
END IF
'Initialisiere Monatsdefinitionen
FOR i = 1 TO 12
READ Monatdatum(i).MName, Monatdatum(i).Anzahl
Monatdatum(i).atag = -1
NEXT
'Daten fuer die Monate eines Jahres:
DATA JAN, 31,FEB, 28, MAR, 31
DATA APR, 30, MAY, 31, JUN, 30, JUL, 31, AUG, 31
DATA SEP, 30, OCT, 31, NOV, 30, DEC, 31
DIM wftag(1 TO A.fei) AS wftagtyp
FOR i = 1 TO A.fei
READ wftag(i).tag, wftag(i).monat, wftag(i).bez
NEXT
DATA 0, 0, "Karfreitag"
DATA 0, 0, "Ostersonntag"
DATA 0, 0, "Ostermontag"
DATA 0, 0, "Muttertag"
DATA 0, 0, "Christi Himmelfahrt"
DATA 0, 0, "Pfingstsonntag"
DATA 0, 0, "Pfingstmontag"
DATA 0, 0, "Fronleichnahm"
DATA 0, 0, "Buss- und Bettag"
'Hole Jahr als Eingabe:
jahr = holeingabe("Jahr (1899 to 2099): ", 1899, 2099)
GOSUB feiertage
FOR monat = 1 TO 12
GOSUB SchreibKalender
NEXT
CLOSE #2
END
'Gibt die Feiertage in das Array Jahrestag aus
feiertage:
jj = jahr
i = jj / 100 - jj / 400 + 4 'Ostern nach Gauss
j = i - INT(jj / 300) + 11
A = (((jj MOD 19) * 19) + j) MOD 30
b = (((jj MOD 4) * 2 + (4 * jj) + (6 * A) + i) MOD 7) + A - 9
IF (b < 1) THEN
tt = 31 + b: mm = 3
ELSE
IF ((b = 26) OR ((A = 28) AND (b = 25) AND ((11 * (j + 1) MOD 30) < 19))) THEN
b = b - 7
STOP
END IF
tt = b
mm = 4
END IF
wftag(OST1).monat = mm: wftag(OST1).tag = tt
mmx = mm: ttx = tt + 1: IF ttx > 31 THEN ttx = ttx - 31: mmx = mmx + 1
wftag(OST2).monat = mmx
wftag(OST2).tag = ttx
mmx = mm: ttx = tt - 2: IF ttx < 1 THEN mmx = mmx - 1: ttx = ttx + 31
wftag(KARF).monat = mmx
wftag(KARF).tag = ttx
mmx = mm: ttx = tt + 39 'ueber den April bis Himmelfahrt
IF mmx = 3 THEN mmx = mmx + 1: ttx = ttx - 31'Maerz auf April
mmx = mmx + 1: ttx = ttx - 30'April auf Mai
IF ttx > 31 THEN mmx = mmx + 1: ttx = ttx - 31
wftag(CHRI).monat = mmx
wftag(CHRI).tag = ttx
ttx = ttx + 10 'auf Pfingstsonntag
IF ttx > 31 THEN mmx = mmx + 1: ttx = ttx - 31
wftag(PFI1).monat = mmx
wftag(PFI1).tag = ttx
ttx = ttx + 1: IF ttx > 31 THEN ttx = ttx - 31: mmx = mmx + 1
wftag(PFI2).monat = mmx
wftag(PFI2).tag = ttx
ttx = ttx + 10: IF ttx > 31 THEN ttx = ttx - 31: mmx = mmx + 1
wftag(FRON).monat = mmx
wftag(FRON).tag = ttx
BerechnMonat jahr, 5, starttag, TotalTage
ttx = Monatdatum(5).atag
IF ttx = 0 THEN ttx = 7
wftag(MUTT).monat = 5
wftag(MUTT).tag = 15 - ttx
BerechnMonat jahr, 11, starttag, TotalTage
ttx = Monatdatum(11).atag
IF ttx <= 3 THEN ttx = ttx + 7
'IF ttx = 0 THEN ttx = 7
wftag(BUSS).monat = 11
wftag(BUSS).tag = 25 - ttx
'Feiertage
FOR i = 1 TO A.fei
Jahrestag(i).tag = wftag(i).tag
Jahrestag(i).monat = wftag(i).monat
Jahrestag(i).bez = wftag(i).bez
NEXT
'Jahrestage
OPEN "geb.txt" FOR INPUT AS #1
i = A.fei + 1
DO WHILE NOT EOF(1) AND i < A.jahrestag
INPUT #1, Jahrestag(i).tag
IF Jahrestag(i).tag > 0 THEN
INPUT #1, Jahrestag(i).monat, Jahrestag(i).jahr, Jahrestag(i).bez
'PrINT Jahrestag(i).tag, Jahrestag(i).monat, Jahrestag(i).jahr, Jahrestag(i).bez
i = i + 1
END IF
LOOP
CLOSE #1
anz.jahrestage = i - 1
RETURN
SchreibKalender:
'Berechne den ersten Tag (So Mo Di ...) und die Anzahl der Tage des Monats:
BerechnMonat jahr, monat, starttag, TotalTage
kopf$ = "." + RTRIM$(Monatdatum(monat).MName) + STR$(jahr)
'Gib die Tage des Monats aus:
FOR i = 1 TO TotalTage
wochentag = (starttag + i - 1) MOD 7
PRINT #2, " ": 'Leerzeile
PRINT #2, MID$("SoMoDiMiDoFrSaSo", 2 * wochentag + 1, 2); " ";
PRINT #2, USING " ##"; i;
PRINT #2, kopf$
PRINT #2, "--------"
FOR j = 1 TO anz.jahrestage
IF Jahrestag(j).tag = i AND Jahrestag(j).monat = monat THEN
PRINT #2, RIGHT$(STR$(Jahrestag(j).tag), _
LEN(STR$(Jahrestag(j).tag)) - 1);
PRINT #2, "."; RIGHT$(STR$(Jahrestag(j).monat), _
LEN(STR$(Jahrestag(j).monat)) - 1); ".";
IF Jahrestag(j).jahr <> 0 THEN _
PRINT #2, RIGHT$(STR$(Jahrestag(j).jahr), _
LEN(STR$(Jahrestag(j).jahr)) - 1);
PRINT #2, " "; LTRIM$(RTRIM$(Jahrestag(j).bez))
END IF
NEXT j
NEXT i
RETURN
'BERECHNMONAT
'Berechne den ersten Tag und die Anzahl der Tage eines Monats
'=======
SUB BerechnMonat (jahr%, monat%, starttag%, TotalTage%) STATIC
'SHARED Monatdatum() AS monattyp
CONST SCHALT = 366 MOD 7
CONST NORMAL = 365 MOD 7
'Berechne Gesamtzahl der Tage (AnzTage) seit 1.1.1899.
'Beginne mit den ganzen Jahren:
AnzTage = 0
FOR i = 1899 TO jahr - 1
IF IstSchaltJahr(i) THEN 'Wenn Schaltjahr addiere 366 MOD 7.
AnzTage = AnzTage + SCHALT
ELSE 'Wenn normales Jahr, addiere 365 MOD 7
AnzTage = AnzTage + NORMAL
END IF
NEXT
'Addiere Tage der ganzen Monate:
FOR i = 1 TO monat - 1
AnzTage = AnzTage + Monatdatum(i).Anzahl
NEXT
'Setze die Anzahl von Tagen im Monat:
TotalTage = Monatdatum(monat).Anzahl
'Gleiche aus, wenn Jahr ein Schaltjahr ist:
IF IstSchaltJahr(jahr) THEN 'Wenn nach Februar, addiere 1 auf gesamte Tage:
IF monat > 2 THEN AnzTage = AnzTage + 1
'Wenn Februar, addiere eins zu den Tagen des Monats:
IF monat = 2 THEN TotalTage = TotalTage + 1
END IF
'Der 1.1.1899 war ein Sonntag, daher ergibt
'AnzTage MOD 7 eine 0 fuer Sonntag, 1 fuer Montag, usw.
'fuer den ersten Tag des eingegebenen Monats:
starttag = AnzTage MOD 7
Monatdatum(monat).atag = starttag
END SUB
'HOLEINGABE
'Fordert zur Eingabe auf und testet dann auf gueltigen Bereich
'=======
FUNCTION holeingabe (Anfrage$, NiedWert, HoherWert) STATIC
PRINT Anfrage$;
Spalte = POS(0)
'CR, falls ziemlich unterer Seitenrand
IF CSRLIN > 23 THEN
PRINT : zeile = CSRLIN - 1
ELSE
zeile = CSRLIN
END IF
'Gibt Wert ein, bis er innerhalb des Bereiches liegt:
DO
LOCATE zeile, Spalte 'Positioniere Cursor ans Ende der Anfrage.
PRINT SPACE$(10); 'Loesche alles bereits Vorhandene.
LOCATE zeile, Spalte 'Positioniere Cursor hinter Anfrage.
INPUT "", Wert 'Gib Wert ohne Anfrage ein.
LOOP WHILE (Wert < NiedWert OR Wert > HoherWert)
'Gibt gueltige Eingabe als Wert der Funktion zurueck:
holeingabe = Wert
END FUNCTION
'ISTSCHALTJAHR
'Bestimmt, ob ein Jahr ein Schaltjahr ist oder nicht
'=======
FUNCTION IstSchaltJahr (N) STATIC
'Wenn das Jahr ohne Rest durch vier aber nicht durch 100 teilbar ist, oder wenn
'das Jahr ohne Rest durch 400 teilbar ist, dann ist es ein Schaltjahr:
IstSchaltJahr = (N MOD 4 = 0 AND N MOD 100 <> 0) OR (N MOD 400 = 0)
END FUNCTION