REM  *********************************
REM  *       Tagefinder V1.10          *
REM  * © 1992 (26.2.94) by Henry König *
REM  *   Bornheide 71, 22549 Hamburg   *
REM  ***********************************
init                            !  Variable vorbesetzen
info
y$="J"
WHILE y$="J"
  start:
  programmkopf
  PRINT AT(1,5);""
  t=0                           !  Eingangswert fuer die Schleife
  WHILE t<1 OR t>31             !  nur Tage zwischen 1 und 31 erlaubt
    INPUT " Tag (zweistellig): ";t
  WEND
  m=0                           !  Eingangswert fuer die Schleife
  WHILE m<1 OR m>12             !  nur die Monate 1 bis 12 erlauben
    INPUT "Monat (zweistellig): ";m
  WEND
  j=0                           !  Eingangswert fuer die Schleife
  WHILE j<1700                  !  richtiges Ergebnis nur ab 1700 möglich
    INPUT " Jahr (vierstellig): ";j
  WEND
  z=j-1                         !  Jahr minus 1
  c=INT(z/4)-INT(z/100)+INT(z/400)
  x=(j+t+c)-1                   !  Anzahl der Tage
  x=x+VAL(MID$(ausg$,m,1))      !
  IF m>2 AND j=4*INT(j/4) AND j<>100*INT(j/100) OR j=400*INT(j/400) THEN
    x=x+1                       !  Schaltjahr, dann plus 1 Tag
  ENDIF
  x=x-7*INT(x/7)                !  Tag von 1 bis 7 berechnen
  PRINT "Der ";t;".";m;".";j;" war ein ";tag$(x+1)
  programmfuss
  PRINT AT(4,28);"Noch ein Tag suchen (j/n) ";
  INPUT x$
  IF UPPER$(x$)<>"J" THEN
    CLOSEW #1                   ! Fenster schließen
    CLOSES 1                    ! Bildschirm schließen
    END                         ! und Ende
  ENDIF
WEND
PROCEDURE programmkopf
  CLS                           ! Bildschirm löschen
  COLOR 2                       ! schwarz
  PBOX 1,1,639,22               ! Box zeichnen
  COLOR 0                       ! grau
  PBOX 4,3,636,20               ! Box zeichnen
  COLOR 4                       ! hellgrau
  LINE 8,18,632,18              ! untere Lichtlinien
  LINE 632,4,632,18             ! rechte Lichtlinie
  LINE 631,5,631,18             ! rechte Lichtlinie
  COLOR 2                       ! schwarz
  LINE 8,4,631,4                ! obere Schatttenlinie
  LINE 6,4,6,18                 ! linke Schattenlinie
  LINE 7,4,7,17                 ! linke Schattenlinie
  PCOLOR 5,0                    ! gelbe Schrift
  PRINT AT(28,2);"T a g e f i n d e r  1.10"
  PCOLOR 1,0                    ! weiße Schrift
  programmfuss
  PRINT AT(4,28);"© 1992 (26.2.1994) by Henry König, Bornheide 71, 22549 Hamburg"
RETURN
PROCEDURE programmfuss          ! Anweisungsboxen zeichnen
  COLOR 2                       ! schwarz
  PBOX 1,(27*8)-10,639,(32*8)   ! schwarze Box
  COLOR 0                       ! grau
  PBOX 6,(27*8)-7,633,(28*8)+4  ! graue Box
  PBOX 6,(29*8)+2,633,(32*8)-4  ! 2. graue Box
  COLOR 4                       ! hellgrau
  BOX 7,(27*8)-7,633,(32*8)-3
  LINE 7,(29*8)+2,633,(29*8)+2
  LINE 16,(29*8)-6,639-16,(29*8)-6
  LINE 16,(29*8)+5,639-16,(29*8)+5
  LINE 639-16,(29*8)-6,639-16,(26*8)+4  ! senkrechter Strich
  LINE 16,(29*8)+5,16,(31*8)+2  ! senkrechter Strich
  COLOR 2                       ! schwarz
  LINE 7,(32*8)-3,633,(32*8)-3  ! schwarze Linie
  LINE 633,(27*8)-7,633,(32*8)-3
  LINE 16,(27*8)-4,639-16,(27*8)-4
  LINE 16,(31*8)+2,639-16,(31*8)+2
  LINE 16,(29*8)-6,16,(26*8)+4  ! senkrechter Strich
  LINE 639-16,(29*8)+5,639-16,(31*8)+2    ! senkrechter Strich
RETURN
PROCEDURE info                  ! Programminfo ausgeben
  programmkopf
  PRINT AT(1,5);"Dieses Programm gibt den Wochentag eines Datums ab dem Jahr 1750 aus."
  PRINT AT(1,7);"Angaben von Tagen vor diesem Datum können falsch sein!"
  PRINT AT(1,13);"Das Programm darf privat beliebig benutzt und kopiert werden."
  PRINT AT(1,15);"Jeder andere Vertrieb bedarf meiner schriftlichen Genehmigung. Alle PD-Abieter,"
  PRINT AT(1,17);"die in der Datei 'Vertrieb' aufgeführt sind, dürfen  a l l e  meine Programme"
  PRINT AT(1,19);"o h n e  Rückfrage vertreiben!"
  PRINT AT(1,21);"Sollten Sie mir eine Spende zukommen lassen wollen, werde ich diese nicht"
  PRINT AT(1,23);"ablehnen."
  tastendruck
RETURN
PROCEDURE init
  breite%=640                   ! Screenbreite
  hoehe%=256                    ! Screenhöhe
  ebenen%=3                     ! 3 Bitplanes
  OPENS 1,0,0,breite%,hoehe%,ebenen%,&H8000
  OPENW #1,0,0,breite%,hoehe%,&H18,&H1800,1
  farben.setzen                 ! Farbpalette setzen
  DIM tag$(7)                   !  Tag in Klartext
  FOR j%=1 TO 7                 !  7 Tage
    READ tag$(j%)               !  Tage lesen
  NEXT j%
  ausg$="033614625035"          !  Monatskorrekturzahlen
  DATA "Sonntag"
  DATA "Montag"
  DATA "Dienstag"
  DATA "Mittwoch"
  DATA "Donnerstag"
  DATA "Freitag"
  DATA "Samstag"
RETURN
PROCEDURE farben.setzen
  SETCOLOR 0,5,5,5              ! grau statt blau
  SETCOLOR 1,15,15,15           ! weiß bleibt
  SETCOLOR 2,0,0,0              ! schwarz erhalten
  SETCOLOR 3,15,5,0             ! rot bleibt
  SETCOLOR 4,10,10,10           ! hellgrau inverse Farbe im Filerequester
  SETCOLOR 5,15,15,0            ! gelb
  SETCOLOR 6,0,0,0              ! schwarz = Inverse Farbe im Filerequester
RETURN
PROCEDURE unterbrechung         ! Ausgabe anhalten
  CLR abbruch%                  ! Abbruchflag loeschen
  x$=INKEY$
  IF x$<>"" THEN
    IF x$<>CHR$(27) THEN        ! ESC gedrueckt
      x$=""                     ! nein, dann warten
      WHILE x$=""               ! warte auf Tastendruck
        x$=INKEY$
      WEND
    ELSE
      abbruch%=1                ! Abbruchflag setzen
    ENDIF
  ENDIF
RETURN
PROCEDURE taste                 ! ein Zeichen von der Tastatur holen
  CLR x%                        ! Steuerzeichen löschen
  CLR mausk%
  CLR mausx%                    ! Mausspalte löschen
  CLR mausy%                    ! Mauszeile löschen
  WHILE x%=0 AND MOUSEK=0
    x$=INKEY$                   ! Zeichen von Tastatur
    x%=ASC(x$)                  ! ASCII-Wert für Auswertung
  WEND
  IF MOUSEK<>0 THEN             ! linke Maustaste
    mausx%=INT(MOUSEX/8)+1      ! ja, dann Spalte = mausx
    mausy%=INT(MOUSEY/8)+1      ! Zeile = mausy
    mausk%=MOUSEK               ! Maustaste
  ENDIF
RETURN
PROCEDURE tastendruck
  PRINT AT(4,28);SPACE$(74);
  PCOLOR 5,0
  PRINT AT(18,28);" Weiter mit beliebiger Taste oder Mausklick."
  GOSUB taste
  PCOLOR 1,0
  PRINT AT(4,28);SPACE$(74)
RETURN
REM