Code-Beispiel

Wochentag selbst berechnen

Lizenz:	Erster Autor:	Letzte Bearbeitung:
Freeware (proprietär)	Sundboy60	10.05.2023

Ich benötigte zum Aufbau einer Digitaluhr, den Wochentag und den Monat in Textform.
Zwar läßt sich beides auch mit einer FREE-BASIC Formel erreichen, aber ich wollte
den Wochentag selbst errechnen lassen.

Hier nun die überarbeitete Version, die durch eine Funktion den Wochentag
errechnet. Zusätzlich zeigt es nun auch an, ob es sich um ein Schaljahr oder
Kalenderjahr handelt.

'' -------------------------------------------------------------------

'' Programm: Wochentag aus Funktion (2).bas

'' letztes Datum: 02.05.2023 - Sundboy60 - lauffaehiges DEMO

'' -------------------------------------------------------------------

    WIDTH 190, 62

    DECLARE FUNCTION Wochentag (D AS INTEGER, M AS INTEGER, _

                            J AS INTEGER, S AS INTEGER) AS INTEGER

    DATA "Montag","Dienstag","Mittwoch","Donnerstag"

    DATA "Freitag","Samstag","Sonntag"

    DATA "Januar","Februar",!"M\132rz","April"

    DATA "Mai","Juni","Juli","August"

    DATA "September","Oktober","November","Dezember"

    DATA "Schaltjahr","Kalenderjahr"

    DIM AS SINGLE D, M, J

    DIM AS INTEGER S, W

    DIM AS STRING WT(7), MT(12), JT(2)

    FOR I AS INTEGER = 1 TO 7 : READ WT(I) : NEXT

    FOR I AS INTEGER = 1 TO 12 : READ MT(I) : NEXT

    READ JT(1) : READ JT(2)

'' ---- ev. manuelle Eingabe der Datumwerte

    D = VAL(MID(DATE, 4, 2))                            '' Tag

    M = VAL(LEFT(DATE, 2))                              '' Monat

    J = VAL(RIGHT(DATE, 4))                             '' Jahr

'' ----- Testaufruf

    S = (J \ 4 = J / 4) - (J \ 100 = J / 100) _

                            + (J \ 400 = J / 400)       '' Schaltjahr

    W = Wochentag (D, M, J, S + 3)                      '' Wochentag

'' ----- Anzeige

    ? !"\10 Der " & D & ". " & MT(M) & " " & J & " ist ein " & WT(W)

    ? " Dieses Jahr ist ein " & JT(S + 2) & "."

    GETKEY

    END

'' --- Rueckgabewert: Wochentag (1=Montag... 7=Sonntag) --------------

    FUNCTION Wochentag (D AS INTEGER, M AS INTEGER, J AS INTEGER, _

                            S AS INTEGER) AS INTEGER

        DIM AS INTEGER G, U, R = 0

        FOR I AS INTEGER = 1 TO M

            G = FIX(30.6 * (I + 2)) - 60

            IF I - 1 THEN G - = S

            U = G - R : R = G

        NEXT

        J - = 1 : R = (J \ 4) - (J \ 100) + (J \ 400) + (J * 365)

        RETURN (G - U + D + R - 578173) MOD 7 + 1

    END FUNCTION

'' -------------------------------------------------------------------

Um weitere Kalenderdaten, zu erhalten, nutze ich ein Unterprogramm (SUB).
So können nun auch noch weitere Werte nutzbar gemacht werden:
"W" Wochentag (1=Mo. 7=So.).
"S" Jahresbezeichner (2=Schaltjahr, 3=Kalenderjahr).
"U" max. Tag im Monat - So kann getestet werden, ob es z.B. einen 29.02. geben kann.
"G-U+D" aktueller Tag im Jahr.

'' -------------------------------------------------------------------

'' Programm: Wochentag aus Unterprogramm.bas

'' letztes Datum: 02.05.2023 - Sundboy60 - lauffaehiges DEMO

'' -------------------------------------------------------------------

    WIDTH 190, 62

    DECLARE SUB DatumJahr

    DATA "Montag","Dienstag","Mittwoch","Donnerstag"

    DATA "Freitag","Samstag","Sonntag"

    DATA "Januar","Februar",!"M\132rz","April"

    DATA "Mai","Juni","Juli","August"

    DATA "September","Oktober","November","Dezember"

    DATA "Schaltjahr","Kalenderjahr"

    DIM AS STRING WT(7), MT(12), JT(2)

    DIM SHARED AS SINGLE D, M, J

    DIM SHARED AS INTEGER R, S, G, U, W

    FOR I AS INTEGER = 1 TO 7 : READ WT(I) : NEXT

    FOR I AS INTEGER = 1 TO 12 : READ MT(I) : NEXT

    READ JT(1) : READ JT(2)

'' --- ev. manuelle Eingabe der Datumwerte

    D = VAL(MID(DATE, 4, 2))                                '' Tag

    M = VAL(LEFT(DATE, 2))                                  '' Monat

    J = VAL(RIGHT(DATE, 4))                                 '' Jahr

'' ---- Testaufruf

    DatumJahr

'' ---- Temp. Anzeige

    ? !"\10 Der " & D & ". " & MT(M) & " " & J & " ist ein " & WT(W)

    ? " Dieses Jahr ist ein " & JT(S - 1)

    ? " Es ist der " & (G - U + D) & ". Tag im Jahr"

    ? " Im Monat gibt es max. " & U & " Tage"

'' --- Programmende

    GETKEY : END

'' --- Datumwerte berechnen

    SUB DatumJahr

        R = 0

        S = 3 + (J \ 4 = J / 4) - (J \ 100 = J / 100) _

                            + (J \ 400 = J / 400)

        FOR I AS INTEGER = 1 TO M

            G = FIX(30.6 * (I + 2)) - 60

            IF I - 1 THEN G - = S

            U = G - R : R = G

        NEXT

        J - = 1 : R = (J \ 4) - (J \ 100) + (J \ 400) + (J *365)

        J + = 1 : W = (G - U + D + R - 578173) MOD 7 + 1

    END SUB

'' -------------------------------------------------------------------

Passend zur Unterprogramm-Variante eine "manuelle" Eingabe mit Kontrolle der Eingabewerte.
HINWEIS: Der erste Tag im Gregorianischen Kalender ist der 15.10.1582! Hier ist es
der 01.01.1583. Das max. Jahr wurde auf das Jahr 2500 festgelegt.

'' ------------------------------------------------------------------

'' Beispiel fuer die manuelle Eingabe von Datumwerten

'' ------------------------------------------------------------------

    ? !"\10 Bitte nur g\129ltige Eingaben:\10"

    DO

        LOCATE CSRLIN - 1 : ? SPACE (30)

        LOCATE CSRLIN - 1 : INPUT " Jahr  = ", J

    LOOP UNTIL (NOT (J < 1583 OR J > 2500)) AND J = ABS(J) _

                            AND J = FIX(J)

    ?

    DO

        LOCATE CSRLIN - 1 : ? SPACE (30)

        LOCATE CSRLIN - 1 : INPUT " Monat = ", M

    LOOP UNTIL (NOT (M < 1 OR M > 12)) AND M = ABS(M) AND M = FIX(M)

    LOCATE CSRLIN - 1 : ? " Monat = " & MT(M) & !"\10"

    D = 1 : DatumJahr

    DO

        LOCATE CSRLIN - 1 : ? SPACE (30)

        LOCATE CSRLIN - 1 : INPUT " Tag   = ", D

    LOOP UNTIL (NOT (D < 1 OR D > U)) AND D = ABS(D) AND D = FIX(D)

Zusätzliche Informationen und Funktionen

Das Code-Beispiel wurde am 22.03.2020 von Sundboy60 angelegt.
Die aktuellste Version wurde am 10.05.2023 von Sundboy60 gespeichert.

Bearbeiten

Versionen