Wer ist online?
Buchempfehlung
FreeBASIC-Chat
FreeBASIC-Nachrichten jetzt auch über Twitter erhalten. Follow us!fb:porticula NoPaste
Trainer
| Uploader: |  JoPa |
| Datum/Zeit: | 12.12.2013 22:04:19 |
Hinweis: Dieser Quelltext ist Bestandteil des Projekts Vokabel Trainer, zu dem es auf FreeBASIC-Portal.de eine Projektseite gibt.
DECLARE SUB warnen ()
DECLARE SUB TimeWatch ()
DECLARE SUB right (W!(), A$, T$, E1$, EE1$, ENDE!)
DECLARE SUB wrong (A$, T$, E1$, EE1$)
DECLARE SUB Vokabelsuchen (Zeit$, D$, DD$, E$, EE$, N$)
DECLARE SUB Seriennummer ()
DECLARE SUB box (Breite!, Y1!, Y!)
DECLARE SUB FeldName (T$)
DECLARE SUB ErweitMenueFelder (T$, Zeit$, Feld!, Pfad$, Spra$)
DECLARE SUB Tastaturabfrage (T$, Zeit$, Feld!, Pfad$, Spra$, D1$, DD1$, MOD$)
DECLARE SUB Vokuebersetzanzeige (XPO!)
DECLARE SUB Menu1dar ()
DECLARE SUB warte ()
DECLARE SUB WortBeispiele (Wort$, Wortb$)
DECLARE SUB WortBuchDochRichtig (WoerterBuch$, Wort$, A$)
DECLARE SUB TestFeldNeuAufbauen (D1$, DD1$)
DECLARE SUB PrOption ()
DECLARE SUB vokiniladen (N$, Zeit$, Pfad$)
DECLARE SUB SPIZHilfe ()
DECLARE SUB VokabelAnzeigen (D1$, DD1$)
DECLARE SUB auseinandernehmen (SATZ$, Wort$, Zeit$, laeq!, loopende!, PU!, LU!, CE!, LaengedS!)
DECLARE SUB HilfeDatei ()
DECLARE SUB Wortbuch (DAT$, Zeit$, Pfad$)
DECLARE SUB NamenEingeben (Name$, Pfad$)
DECLARE SUB ubersetzen (Pfad$)
DECLARE SUB TestMaske ()
DECLARE SUB EndedesProgramms ()
DECLARE SUB Maske2 ()
DECLARE SUB Lob (N$, Zeit$, Name$)
DECLARE SUB Hilfe (HD$)
DECLARE SUB laden (N$, Zeit$)
DECLARE SUB Info ()
DECLARE SUB Test (N$, Zeit$)
DECLARE SUB Erweitern (N$, Zeit$, T$, Pfad$)
DECLARE SUB option1 (N$, Zeit$, Pfad$)
DECLARE SUB Datanlegen (N$, Zeit$)
DECLARE SUB vokinimachen ()
DECLARE SUB Bildaufbau (A$)
DECLARE SUB vollstaendigkeit ()
DECLARE SUB maske (H1!, H2!, A$)
DECLARE SUB vorschlag ()
DECLARE SUB BildAufbau2 ()
DECLARE SUB Menu2 (N$, Zeit$, Name$, Pfad$)
DECLARE SUB Menu1 (N$, Zeit$, Name$, Pfad$)
DECLARE SUB Felduebe (T$, K$, Zeit$, XT!, YT!, D1$, DD1$)
'CALL Seriennummer
'*************************************************************************
'* Information *
'* Programmiert unter Quickbasic 4.5 *
'* Angefangen am 23.02.1996 - Nov.1997 *
'* Programmiert von Jens M(16 Jahre) *
'*************************************************************************
'*Version 4.02*
KEY 1, "^" 'Hilfe anzeigen Taste
RANDOMIZE TIMER
DIM SHARED YYD(200) AS INTEGER, ZD AS INTEGER
DIM SHARED WSS AS INTEGER, X2 AS INTEGER, Y2 AS INTEGER
DIM SHARED Z AS INTEGER, ZA AS INTEGER, ZB AS INTEGER, O AS INTEGER
DIM SHARED Nochmal AS INTEGER, XX AS INTEGER, leg AS INTEGER
DIM SHARED load AS INTEGER, ErweitFehler AS INTEGER
DIM SHARED Aufgabe AS INTEGER, richtig AS DOUBLE, Beenden AS INTEGER
DIM SHARED Fehler AS INTEGER, Zaehler AS INTEGER, S AS INTEGER 'S steht fr Test Sub bei right Sub s=s+1
DIM SHARED loben AS INTEGER, Sprache AS INTEGER, ZEICH AS INTEGER
DIM SHARED Laenge AS INTEGER, Q1 AS INTEGER, Fag AS INTEGER 'Fehleraufgetreten
DIM SHARED HZ AS INTEGER 'Hilfe Zahl (Hilfe Status)
DIM SHARED BLS AS INTEGER 'Bild neu aufbauen
DIM SHARED WoertersG AS INTEGER, VokabelMax, Versuch, BPanz, Punkte AS DOUBLE
DIM SHARED Pfad$, Zeit$
DIM SHARED KM, Start, PrStart
'-------------------------------- Name eingeben ------------------------------
PrStart = TIMER
CLS
'SHELL "wobnigef.exe"
CALL vokiniladen(N$, Zeit$, Pfad$)
'CALL vollstaendigkeit
CALL NamenEingeben(Name$, Pfad$)
'-----------------------------------------------------------------------------
DO
CLS
CLOSE #1
CALL laden(N$, Zeit$)
IF Fag <> 1 THEN EXIT DO
LOOP
IF N$ = "load12345" THEN N$ = ""
CALL Menu1(N$, Zeit$, Name$, Pfad$)
'*****************************************************************************
'*****************************************************************************
'************************ F E H L E R - M E L D U N G E N ******************
'*****************************************************************************
'*****************************************************************************
102
CALL vokinimachen
RUN
170
CLS
PRINT "Fehler: Hilfe-Datei nicht gefunden "
PRINT "Fehler NR."; ERR
PRINT: PRINT: PRINT: PRINT " Bitte drcken Sie eine Taste"
DO
LOOP UNTIL INKEY$ <> ""
Fag = 1
RESUME NEXT
100
Fag = 1
RESUME NEXT
223
OPEN "proz.prz" FOR OUTPUT AS #1
PRINT #1, "84"
PRINT #1, "87"
PRINT #1, "88"
PRINT #1, "89"
PRINT #1, "94"
PRINT #1, "98.99"
CLOSE #1
RUN
ENDE:
RESUME NEXT
NAMENBUCHFEHLT:
CLOSE #1
OPEN "namebuch.uch" FOR OUTPUT AS #1
PRINT #1, ""
CLOSE #1
Fag = 1
RESUME NEXT
quatschBuchFehler:
OPEN "quatsch.uch" FOR OUTPUT AS #1
PRINT #1, ""
CLOSE #1
RESUME NEXT
FilesFehler:
Fag = 1
RESUME NEXT
BEENDENFEHLER:
RESUME NEXT
HelpNotFind:
CLS
PRINT "das Programm ist nicht vollst„ndig"
PRINT "es Fehlen die oder nur eine Hilfe Datei!!"
END
Seri:
CLS
PRINT "Vokabel Trainer"
PRINT "keine Nummer"
END
SUB auseinandernehmen (SATZ$, Wort$, Zeit$, laeq, loopende, PU, LU, CE, LaengedS)
P0$ = "0"
P1$ = "1"
P2$ = "2"
P3$ = "3"
P4$ = "4"
P5$ = "5"
P6$ = "6"
P7$ = "7"
P8$ = "8"
P9$ = "9"
l$ = " "
L1$ = "."
L2$ = "-"
L3$ = ":"
L4$ = "?"
L5$ = "!"
l6$ = ","
l7$ = ";"
l8$ = "("
l9$ = ")"
L10$ = "%"
l11$ = "&"
L12$ = "/"
L13$ = "\"
L14$ = "="
L15$ = "_"
l16$ = "*"
l17$ = "<"
l18$ = ">"
DO
IF LU = 1.2 THEN PU = 0: LU = 0
CLOSE #1
ErweitFehler = 0
WoertersG = 0
A = LEN(SATZ$)
I = I + 1
IF I > LEN(SATZ$) THEN loopende = 1: EXIT DO
' IF I > LaengedS - 1 OR I = LaengedS THEN WoertersG = 1
Q$ = LEFT$(SATZ$, I)
IF CHR$(34) = RIGHT$(Q$, 1) OR l8$ = RIGHT$(Q$, 1) OR l7$ = RIGHT$(Q$, 1) OR l6$ = RIGHT$(Q$, 1) OR L2$ = RIGHT$(Q$, 1) OR L10$ = RIGHT$(Q$, 1) OR l$ = RIGHT$(Q$, 1) THEN
SATZ$ = RIGHT$(SATZ$, A - I)
CE = CE + 1
Wort$ = LEFT$(Q$, I - 1)
laeq = LEN(Wort$)
EXIT DO
END IF
CALL warnen
'*****************************************************************************
IF P9$ = RIGHT$(Q$, 1) OR P8$ = RIGHT$(Q$, 1) OR P7$ = RIGHT$(Q$, 1) OR P6$ = RIGHT$(Q$, 1) OR P5$ = RIGHT$(Q$, 1) OR P4$ = RIGHT$(Q$, 1) OR P3$ = RIGHT$(Q$, 1) OR P2$ = RIGHT$(Q$, 1) OR P1$ = RIGHT$(Q$, 1) OR P0$ = RIGHT$(Q$, 1) OR l9$ = _
RIGHT$(Q$, 1) OR l11$ = RIGHT$(Q$, 1) THEN
SATZ$ = RIGHT$(SATZ$, A - I)
CE = CE + 1
Wort$ = LEFT$(Q$, I - 1)
laeq = LEN(Wort$)
EXIT DO
END IF
IF l18$ = RIGHT$(Q$, 1) OR l17$ = RIGHT$(Q$, 1) OR l16$ = RIGHT$(Q$, 1) OR L15$ = RIGHT$(Q$, 1) OR L12$ = RIGHT$(Q$, 1) OR L13$ = RIGHT$(Q$, 1) OR L14$ = RIGHT$(Q$, 1) THEN
SATZ$ = RIGHT$(SATZ$, A - I)
CE = CE + 1
Wort$ = LEFT$(Q$, I - 1)
laeq = LEN(Wort$)
EXIT DO
END IF
LOOP
IF PU > 0 AND NOT L1$ = RIGHT$(Wort$, 1) THEN PU = 0: LU = 1.2
IF PU > 0 AND NOT L3$ = RIGHT$(Wort$, 1) THEN PU = 0: LU = 1.2
IF PU > 0 AND NOT L4$ = RIGHT$(Wort$, 1) THEN PU = 0: LU = 1.2
IF PU > 0 AND NOT L5$ = RIGHT$(Wort$, 1) THEN PU = 0: LU = 1.2
IF L1$ = RIGHT$(Wort$, 1) THEN
Wort$ = LEFT$(Wort$, laeq - 1)
PU = PU + 1
END IF
IF L3$ = RIGHT$(Wort$, 1) THEN
Wort$ = LEFT$(Wort$, laeq - 1)
PU = PU + 1
END IF
IF L4$ = RIGHT$(Wort$, 1) THEN
Wort$ = LEFT$(Wort$, laeq - 1)
PU = PU + 1
END IF
IF L5$ = RIGHT$(Wort$, 1) THEN
Wort$ = LEFT$(Wort$, laeq - 1)
PU = PU + 1
END IF
IF PU > 0 THEN LU = LU + 1
END SUB
SUB Bildaufbau (A$)
LOCATE 7, 2
PRINT " "
IF Aufgabe > 0 THEN
ZD = ZD + 1
ZWPR = richtig * 100 / (Aufgabe)
YYD(ZD) = ZWPR
LOCATE 25, 20
PRINT USING "###% Richtig beantwortet"; ZWPR
END IF
IF A$ = "Richtig" THEN
FOR I = 12 TO 22
FOR I2 = 2 TO 79
LOCATE I, I2
PRINT " "
NEXT I2
NEXT I
END IF
LOCATE 25, 3
PRINT USING "###. Aufgabe"; Aufgabe
LOCATE 9, 3
PRINT A$
LOCATE 26, 3
PRINT USING "###"; richtig
LOCATE 27, 3
PRINT USING "###"; Fehler
END SUB
SUB BildAufbau2
CLS
SCREEN 12
WINDOW SCREEN(1, 1)-(700, 300)
CALL TestMaske
LOCATE 2, 3
PRINT DATE$
LOCATE 27, 8: PRINT "Fehler"
A$ = "Vokabeln Abfragen"
LOCATE 2, 40 - (LEN(A$) / 2)
PRINT A$
LOCATE 26, 8
PRINT "Richtig"
END SUB
SUB box (Breite, Y1, Y)
X1 = 320 - Breite
XA = 320 + Breite
COLOR 7
LINE (XA, Y)-(X1, Y)
LINE (XA, Y)-(XA, Y1)
LINE (XA, Y1)-(X1, Y1)
LINE (X1, Y1)-(X1, Y)
COLOR 8
LINE (XA - 1, Y - 1)-(X1 - 1, Y - 1)
LINE (XA - 1, Y - 1)-(XA - 1, Y1 - 1)
COLOR 15
LINE (XA - 2, Y1 - 1)-(X1 - 1, Y1 - 1)
LINE (X1 - 1, Y1 - 1)-(X1 - 1, Y - 2)
COLOR 8
LINE (XA - 2, Y - 2)-(X1 - 2, Y - 2)
LINE (XA - 2, Y - 2)-(XA - 2, Y1 - 2)
LINE (XA - 2, Y1 - 2)-(X1 - 2, Y1 - 2)
LINE (X1 - 2, Y1 - 2)-(X1 - 2, Y - 2)
END SUB
SUB Datanlegen (N$, Zeit$)
Z = 0
N$ = ""
SCREEN 0
PRINT
DO
INPUT "Wie soll die Datei heiáen(nur 8 Buchstaben bitte)"; N$
EN$ = ".vok": EN2$ = ".VOK"
N$ = LEFT$(N$, 8)
IF EN$ = RIGHT$(N$, 4) OR EN2$ = RIGHT$(N$, 4) THEN 19
IF N$ <> "" THEN N$ = N$ + EN$: GOTO 19
LOOP
19
END SUB
SUB EndedesProgramms
PCOPY 0, 2
COLOR 15, 3
CALL maske(9, 12, " Wollen Sie wirklich das Programm verlassen ")
LOCATE 11, 18
PRINT " (J/N) "
DO
P$ = INPUT$(1)
IF P$ = "n" OR P$ = "N" THEN
PCOPY 2, 0
COLOR 7, 0
EXIT SUB
END IF
LOOP UNTIL P$ = "J" OR P$ = "j"
COLOR 7, 0
'***********************************Programm Ende**************************
ON ERROR GOTO BEENDENFEHLER
KILL "DAT.DAT"
CLS
PRINT USING "Sie haben ####.# Minuten gebt"; (TIMER - PrStart) / 60
END
END SUB
SUB Erweitern (N$, Zeit$, T$, Pfad$)
ON ERROR GOTO ENDE:
CLS
PRINT: PRINT: PRINT
PRINT "Erweitern:"
PRINT: PRINT
PRINT "Welche Fremdsprache werden Sie eingeben(z.B. Englisch, Griechisch,...)? "
LINE INPUT Spra$
Beenden = 0
11
DO
CLS
LOCATE 1, 1
PRINT "Dateiname : "; N$; " erweitern!!"
IF N$ = "" OR N$ = " " THEN CLS: PRINT "Dateiname :"
PRINT "Die "; Z; ". Vokabel"
LOCATE 4, 1
IF N$ = " " OR N$ = "" THEN leg = 2: CALL Datanlegen(N$, Zeit$): GOTO 11
Z = Z + 1
DO
Feld = Feld + 1
IF Feld = 5 THEN Feld = 0: EXIT DO
T$ = ""
CALL Tastaturabfrage(T$, Zeit$, Feld, Pfad$, Spra$, D1$, DD1$, "Erweitern")
IF Beenden = 1 THEN 24
Beenden = 0
IF Feld = 1 THEN
E1$ = T$
END IF
IF Feld = 2 THEN
EE1$ = T$
END IF
IF Feld = 3 THEN
D1$ = T$
END IF
IF Feld = 4 THEN
DD1$ = T$
END IF
LOOP
'**********************TEST OB DIE VOKABEL SCHON EXESTIERT*****************
IF Z > 1 THEN
OPEN N$ FOR INPUT AS #1
DO
LINE INPUT #1, D$
IF EOF(1) THEN 78
LINE INPUT #1, DD$
IF EOF(1) THEN 78
LINE INPUT #1, E$
IF EOF(1) THEN 78
LINE INPUT #1, EE$
IF D$ = D1$ AND E$ = E1$ THEN
LOCATE 8, 1
PRINT " Die Vokabel existiert bereits"
PRINT " N eingeben wenn sie nicht"
PRINT " nochmal geschrieben werden soll!"
END IF
LOOP UNTIL EOF(1)
END IF
78
CLOSE #1
LOCATE 21, 1
PRINT "Q = aufh”ren/N = nicht speichern/ Enter = Speichern>"
DO
CALL TimeWatch
CALL warnen
K$ = INPUT$(1)
IF K$ = CHR$(13) THEN 1005
IF K$ = CHR$(27) THEN CLS: GOTO 24
IF K$ = "q" OR K$ = "Q" THEN 24
IF K$ = "n" OR K$ = "N" THEN Z = Z - 1: GOTO 11
IF K$ = "^" OR K$ = "ø" THEN HZ = 3: CALL HilfeDatei
LOOP
1005
OPEN N$ FOR APPEND AS #1
PRINT #1, D1$
PRINT #1, DD1$
PRINT #1, E1$
PRINT #1, EE1$
CLOSE #1
VokabelMax = VokabelMax + 1
DATEI$ = "Wortbuch.uch"
OPEN Pfad$ + DATEI$ FOR APPEND AS #1
PRINT #1, D1$
PRINT #1, "Deutsch"
PRINT #1, DD1$
PRINT #1, "o. Deutsch"
PRINT #1, E1$
PRINT #1, Spra$
PRINT #1, EE1$
PRINT #1, "o. "; Spra$
CLOSE #1
D1$ = ""
DD1$ = ""
E1$ = ""
EE1$ = ""
LOOP
24
Beenden = 0
Z = Z - 1
CLS
CLOSE #2
END SUB
SUB ErweitMenueFelder (T$, Zeit$, Feld, Pfad$, Spra$)
IF Feld = 1 THEN
LOCATE 4, 1
PRINT ""; LEFT$(Spra$, 7); ".1>"; T$; "_ "; ZE$
Sprache = 1
END IF
IF Feld = 2 THEN
LOCATE 6, 1
PRINT ""; LEFT$(Spra$, 7); ".2>"; T$; "_ "; ZE$
Sprache = 1
END IF
IF Feld = 3 THEN
LOCATE 12, 1
PRINT "Deutsch 1>"; T$; "_ "; ZE$
Sprache = 0
END IF
IF Feld = 4 THEN
LOCATE 14, 1
PRINT "Deutsch 2>"; T$; "_ "; ZE$
Sprache = 0
END IF
END SUB
SUB FeldName (T$)
LOCATE 11, (80 / 2) - LEN(T$) / 2 - 1
COLOR 12, 9
PRINT " ";
COLOR 11, 2
PRINT T$;
COLOR 12, 9
PRINT "_ "
END SUB
SUB Felduebe (T$, K$, Zeit$, XT, YT, D1$, DD1$)
LOCATE YT, XT: PRINT ""; T$; "_ "
LOCATE 2, 70
PRINT TIME$
END SUB
SUB Hilfe (HD$)
PCOPY 0, 3
IF HD$ = "" THEN HD$ = "HILFE"
CLS
ON ERROR GOTO 170: OPEN HD$ + ".HLP" FOR INPUT AS #1
IF Fag = 1 THEN CLS: Fag = 0: EXIT SUB
DO
ZH = ZH + 1
IF ZH > 16 THEN
LOCATE 22, 30
PRINT "Bitte eine Taste drcken"
DO
LOOP UNTIL INKEY$ <> ""
CLS
ZH = 1
END IF
CALL maske(1, 20, " ")
LINE INPUT #1, Help$
LOCATE ZH + 2, 3: PRINT Help$
LOOP UNTIL EOF(1)
CLOSE #1
LOCATE 22, 26
PRINT "Bitte drcken sie eine Taste"
DO
LOOP UNTIL INKEY$ <> ""
BLS = 1
PCOPY 3, 0
END SUB
SUB HilfeDatei
PCOPY 0, 3
IF HZ = 0 THEN HD$ = "HILFEM1"
IF HZ = 1 THEN HD$ = "HILFE2"
IF HZ = 2 THEN HD$ = "HILFE3"
IF HZ = 3 THEN HD$ = "HILFE4"
IF HZ = 4 THEN HD$ = "HILFE5"
IF HZ = 5 THEN HD$ = "HILFE6"
IF HZ = 6 THEN HD$ = "HILFE7"
IF HZ = 7 THEN HD$ = "HILFE8"
CALL Hilfe(HD$)
PCOPY 3, 0
END SUB
SUB Info
SCREEN 9
COLOR 15, 8
A$ = "Information"
LOCATE 3, 40 - LEN(A$) / 2
PRINT A$
A$ = "Vokabel Programm Version 1.0"
LOCATE 5, 40 - LEN(A$) / 2
PRINT A$
A$ = "Programmiert unter Quickbasic 4.5"
LOCATE 7, 40 - LEN(A$) / 2
PRINT A$
A$ = "Angefangen am 23.02.1996 - Nov.1997"
LOCATE 8, 40 - LEN(A$) / 2
PRINT A$
COLOR 2
PRINT: PRINT: PRINT
PRINT " von: Jens M(16J)"
PRINT " "
PRINT " "
PRINT " "
PRINT: PRINT: PRINT
COLOR 15
PRINT: PRINT "Bitte drcken sie eine Taste"
CALL box(220, 5, 230)
DO
LOOP UNTIL INKEY$ <> ""
SCREEN 0
END SUB
SUB laden (N$, Zeit$)
IF Fag = 1 THEN Fag = 0: GOTO 16
IF load = 2 THEN 16
IF N$ = "load12345" THEN 16
IF N$ <> "" THEN 104
16
CLS
PRINT: PRINT
'*******************************DOS BEFEHL***************************
ON ERROR GOTO FilesFehler
IF Fag = 1 THEN Fag = 0: GOTO Weiter
FILES "*.vok"
Weiter:
PRINT: PRINT
PRINT "Vokabeldatei eingeben(ENTER = neue Datei anlegen)"
LINE INPUT "> "; N$
IF N$ = "" THEN Z = 0: N$ = "": Fag = 0: GOTO 13
IF ".vok" <> RIGHT$(N$, 4) THEN N$ = N$ + ".vok"
104
CLOSE #1
'******************************LADEN DER VOKABELN***************************
Z = 0
CLS
ON ERROR GOTO 100
OPEN N$ FOR INPUT AS #1
Fag = 0
LOCATE 12, 1
PRINT " Bitte Warten !!!!!"
DO
LINE INPUT #1, D$
IF EOF(1) THEN 13
LINE INPUT #1, DD$
IF EOF(1) THEN 13
LINE INPUT #1, E$
IF EOF(1) THEN 13
LINE INPUT #1, EE$
Z = Z + 1
LOOP UNTIL EOF(1)
13
CLOSE
CLS
END SUB
SUB Lob (N$, Zeit$, Name$)
Aufgabe = Aufgabe - 1
IF Aufgabe < 2 THEN GOTO EndeLob
ZD = 0
OPEN "proz.prz" FOR INPUT AS #1
INPUT #1, PrOption1
INPUT #1, PrOption2
INPUT #1, PrOption3
INPUT #1, PrOption4
INPUT #1, PrOption5
INPUT #1, PrOption6
CLOSE #1
ENDE$ = ".lob"
A$ = ".Vok"
End2$ = N$
A = LEN(End2$)
A$ = LEFT$(End2$, A - 4)
IF Aufgabe < 1 THEN Aufgabe = 1
CLS
IF Beenden <> 1 THEN
CALL maske(1, 3, "Es wurde alles Abgefragt")
END IF
IF Beenden = 1 THEN
CALL maske(1, 3, "Sie haben das Lernen beendet")
END IF
REM ********************************** Prozent ************************
Prozent = richtig * 100 / (Aufgabe + 1)
Prozent = INT(Prozent * 10) / 10
IF Aufgabe > 1 THEN
LOCATE 6, 1
PRINT Prozent; "% wurden von "; Aufgabe + 1; " Aufgaben richtig beantwortet!"
PRINT
END IF
IF Aufgabe > 1 THEN
OPEN A$ + ENDE$ FOR APPEND AS #1
PRINT #1, ""; Name$; ", "; Aufgabe; ", "; Prozent
CLOSE #1
END IF
IF Aufgabe > 100 AND Prozent < 90 THEN
CALL vorschlag
END IF
IF Prozent < PrOption1 AND Aufgaben < 100 THEN
CALL vorschlag
END IF
IF Prozent < PrOption2 AND Aufgaben < 80 THEN
CALL vorschlag
END IF
IF Aufgabe < 60 AND Prozent < PrOption3 THEN
CALL vorschlag
END IF
IF Aufgabe < 50 AND Prozent < PrOption4 THEN
CALL vorschlag
END IF
IF Aufgabe < 30 AND Prozent < PrOption5 THEN
CALL vorschlag
END IF
IF Aufgabe < 20 AND Prozent < PrOption6 THEN
CALL vorschlag
END IF
PRINT "Bitte drcken sie die Leertaste"
DO
K$ = INKEY$
IF K$ = CHR$(27) THEN CALL PrOption: K = 1
IF K$ = " " THEN K = 1
LOOP UNTIL K = 1
EndeLob:
Fehler = 0
Aufgabe = 0
richtig = 0
Zaehler = 0
S = 0
CLS
Beenden = 0
END SUB
SUB maske (H1, H2, A$)
LOCATE H1 + 1, 40 - (LEN(A$) / 2)
PRINT A$ + " "
B1 = 40 - (LEN(A$) / 2) - 1
B2 = 40 - (LEN(A$) / 2) + (LEN(A$)) + 1
FOR I = H1 + 1 TO H2 - 1
LOCATE I, B1: PRINT "º"
LOCATE I, B2: PRINT "º"
NEXT I
FOR I = 1 TO B2 - B1 - 1
LOCATE H1, B1 + I: PRINT "Í"
LOCATE H2, B1 + I: PRINT "Í"
NEXT I
LOCATE H1, B1: PRINT "É"
LOCATE H1, B2: PRINT "»"
LOCATE H2, B1: PRINT "È"
LOCATE H2, B2: PRINT "Œ"
END SUB
SUB Maske2
FOR I = 10 TO 16
LOCATE I, 1
PRINT "º º"
NEXT I
LOCATE 9, 1
PRINT "É"
FOR I = 2 TO 79
LOCATE 9, I
PRINT "Í"
LOCATE 17, I
PRINT "Í"
NEXT I
LOCATE 9, 80
PRINT "»"
LOCATE 17, 1
PRINT "È"
LOCATE 17, 80
PRINT "Œ"
END SUB
SUB Menu1 (N$, Zeit$, Name$, Pfad$)
CLS
CALL maske(1, 3, " M E N U E ")
StartTimer = TIMER
DO
HZ = 0 'Hilfe Status welche Hilfedatei er lesen muss wenn ^ø Taste gedrckt wird
IF TIMER - StartTimer > WSS THEN SHELL "schoner.exe": StartTimer = TIMER: BLS = 1
CALL Menu1dar
AN$ = N$
K$ = INKEY$
IF K$ <> "" THEN StartTimer = TIMER
IF K$ = "1" THEN
CALL Menu2(N$, Zeit$, Name$, Pfad$)
END IF
CALL warnen
IF K$ = "2" THEN CALL option1(N$, Zeit$, Pfad$)
'***************************************************************************
IF K$ = "5" THEN CALL Info
IF K$ = "4" THEN
CALL HilfeDatei
END IF
IF K$ = "^" THEN CALL HilfeDatei
IF K$ = "6" OR K$ = CHR$(27) THEN
CALL EndedesProgramms
END IF
IF K$ = "3" THEN
OPEN "DAT.DAT" FOR OUTPUT AS #1
PRINT #1, AN$
CLOSE #1
SHELL "lobtab.exe": CLS
StartTimer = TIMER
END IF
IF K$ = "1" OR K$ = "5" OR K$ = "2" OR K$ = "3" OR K$ = "4" OR BLS = 1 THEN
BLS = 0
CLS
CALL maske(1, 3, " M E N U E ")
END IF
LOOP
END SUB
SUB Menu1dar
COLOR 2
LOCATE 12, 1
PRINT "ÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ"
mPos = 29
CALL warnen
COLOR 12
LOCATE 5 + 1, mPos
PRINT "1. Vokabelmenue"
COLOR 2
LOCATE 7 + 1, mPos
PRINT "2. Option"
COLOR 3
LOCATE 9 + 1, mPos
PRINT "3. Ergebnis Tabelle"
COLOR 6
LOCATE 11 + 3, mPos
PRINT "4. Hilfe(F1 Taste)"
COLOR 11
LOCATE 13 + 3, mPos
PRINT "5. Programm Informationen"
COLOR 7
LOCATE 15 + 3, mPos
PRINT "6. Beenden"
END SUB
SUB Menu2 (N$, Zeit$, Name$, Pfad$)
StartTimer = TIMER
CLS
CALL maske(1, 3, " V o k a b e l M e n u e ")
DO
mPos = 27
HZ = 1
IF TIMER - StartTimer > WSS THEN SHELL "schoner.exe": StartTimer = TIMER: BBS = 1
'---------------------------------------------------------------------------
COLOR 2
LOCATE 12, 1
PRINT "ÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ"
COLOR 14
LOCATE 6, mPos
PRINT "1. Vokabeln Lernen"
COLOR 2
LOCATE 8, mPos
PRINT "2. Vokabeln(Datei) erweitern<"; N$; ">"
COLOR 5
LOCATE 10, mPos
PRINT "3. Vokabeln berichtigen"
COLOR 6
LOCATE 14, mPos
PRINT "4. šbersetzen"
COLOR 3
LOCATE 16, mPos
PRINT "5. Vokabeln laden"
COLOR 7
LOCATE 18, mPos
PRINT "0. Zurck ins Hauptmenue(ESC)"
'---------------------------------------------------------------------------
K$ = INKEY$
IF K$ <> "" THEN StartTimer = TIMER
IF K$ = "^" THEN CALL HilfeDatei: BBS = 1
IF K$ = "1" AND Z > 1 THEN
CALL Test(N$, Zeit$)
SCREEN 0
CALL Lob(N$, Zeit$, Name$)
Punkte = 0
END IF
IF K$ = "4" THEN CALL ubersetzen(Pfad$)
CALL warnen
IF K$ = "2" THEN CALL Erweitern(N$, Zeit$, T$, Pfad$)
IF K$ = "3" THEN
SCREEN 0
I$ = "edit "
I$ = I$ + N$
SHELL I$
CLS
load = 0
CALL laden(N$, Zeit$)
END IF
'***************************************************************************
IF K$ = "5" THEN
DO
load = 2: CALL laden(N$, Zeit$)
IF Fag <> 1 THEN EXIT DO
LOOP
END IF
IF K$ = "0" OR K$ = CHR$(27) THEN EXIT DO
IF K$ = "1" AND Z > 1 OR K$ = "2" OR K$ = "3" OR K$ = "4" OR K$ = "5" OR BBS = 1 THEN
CLS
CALL maske(1, 3, " V o k a b e l M e n u e")
BBS = 0
END IF
LOOP
CLS
END SUB
SUB NamenEingeben (Name$, Pfad$)
ANFANG:
CLS
COLOR 6
LOCATE 4, 26
PRINT "V o k a b e l - T r a i n e r"
LOCATE 5, 24
COLOR 2
PRINT "-----------------------------------"
COLOR 12
LOCATE 21, 20
PRINT "Weiter mit ENTER(RETURN) oder Escape(ESC)"
' CALL maske(1, 3, " Name eingeben")
COLOR 12, 9
CALL maske(10, 12, " ")
COLOR 11, 1
LOCATE 10, 33: PRINT "Namen eingeben"
CALL Tastaturabfrage(T$, Zeit$, Feld, Pfad$, Spra$, D1$, DD1$, "Name")
Name$ = T$
COLOR 7, 0
END SUB
SUB option1 (N$, Zeit$, Pfad$)
OPEN "dat.dat" FOR OUTPUT AS #1
PRINT #1, Z
PRINT #1, N$
PRINT #1, Zeit$
PRINT #1, Pfad$
CLOSE #1
SHELL "option.exe"
KILL "DAT.DAT"
CALL vokiniladen(N$, Zeit$, Pfad$)
CALL laden(N$, Zeit$)
CLS
END SUB
SUB PrOption
CLS
CALL maske(1, 3, " Einstellung ")
PRINT: PRINT
PRINT " Bei wieviel Prozent soll vorgeschlagen werden, das sie noch mal šben?"
PRINT: PRINT
INPUT "Bei 100 Aufgaben"; PrOption1
INPUT "Bei 80 Aufgaben"; PrOption2
INPUT "Bei 60 Aufgaben"; PrOption3
INPUT "Bei 50 Aufgaben"; PrOption4
INPUT "Bei 30 Aufgaben"; PrOption5
INPUT "Bei 20 Aufgaben"; PrOption6
OPEN "Proz.prz" FOR OUTPUT AS #1
PRINT #1, PrOption1
PRINT #1, PrOption2
PRINT #1, PrOption3
PRINT #1, PrOption4
PRINT #1, PrOption5
PRINT #1, PrOption6
CLOSE #1
IF PrOption1 = 0 AND PrOption2 = 0 AND PrOption3 = 0 AND PrOption4 = 0 AND PrOption5 = 0 AND PrOption6 = 0 THEN KILL "proz.prz"
OPEN "proz.prz" FOR OUTPUT AS #1
PRINT #1, "84"
PRINT #1, "87"
PRINT #1, "88"
PRINT #1, "89"
PRINT #1, "94"
PRINT #1, "98.99"
CLOSE #1
END SUB
SUB right (W(), A$, T$, E1$, EE1$, ENDE)
IF T$ = "" THEN 6
IF T$ = E1$ OR T$ = EE1$ THEN
A$ = "Richtig"
Zaehler = Zaehler + 1
S = S + 1
IF ZB = S AND Nochmal = 2 THEN ENDE = 1: Aufgabe = Aufgabe + 1
IF S > 1999 THEN S = 1
IF ZB = S AND Nochmal <> 2 THEN S = 1
W(S) = Q1
richtig = richtig + 1
IF Versuch > 0 AND Versuch < 2 THEN richtig = richtig - .5
Versuch = 3
END IF
6
END SUB
SUB Seriennummer
SHELL ("dir >Sern.dat")
CLOSE #1
OPEN "Sern.dat" FOR INPUT AS #1
INPUT #1, A$
INPUT #1, A$
CLOSE #1
KILL "Sern.dat"
eSern1 = ASC(RIGHT$(A$, 1))
eSern2 = ASC(RIGHT$(A$, 2))
esern3 = ASC(RIGHT$(A$, 3))
esern4 = ASC(RIGHT$(A$, 4))
esern5 = ASC(RIGHT$(A$, 5))
esern6 = ASC(RIGHT$(A$, 6))
ON ERROR GOTO Seri
OPEN "Snummer.nmr" FOR INPUT AS #1
INPUT #1, S1
INPUT #1, S2
INPUT #1, s3
INPUT #1, s4
INPUT #1, s5
INPUT #1, s6
CLOSE #1
CLS
IF S1 + 10 <> eSern1 THEN END
'IF S2 - 15.1346 <> eSern2 THEN END
IF s3 - 99.993 <> esern3 THEN END
'IF s4 * 2.139 <> esern4 THEN END
'IF s5 / 5.677 <> esern5 THEN END
IF s6 + 2 <> esern6 THEN END
END SUB
SUB SPIZHilfe
Fag = 0
CLS
SCREEN 0
HD$ = "HILFE7"
ON ERROR GOTO 170
CLOSE #1
OPEN HD$ + ".hlp" FOR INPUT AS #1
IF Fag = 1 THEN CLOSE #1: CLS: Fag = 0: EXIT SUB
CLS
VIEW PRINT 3 TO 18
DO
ZH = ZH + 1
IF ZH > 15 THEN
VIEW PRINT 1 TO 24
LOCATE 22, 26
PRINT "Bitte eine Taste drcken"
CALL maske(1, 19, " ")
DO
K$ = INKEY$
IF K$ = CHR$(27) THEN EXIT SUB
IF K$ <> "" THEN EXIT DO
LOOP
VIEW PRINT 3 TO 18
LOCATE 18, 1
END IF
LINE INPUT #1, Help$
PRINT Help$
LOOP UNTIL EOF(1)
CLOSE #1
VIEW PRINT 1 TO 24
CALL maske(1, 19, " ")
LOCATE 22, 26
PRINT "Bitte eine Taste drcken"
DO
LOOP UNTIL INKEY$ <> ""
BLS = 1
CLS
END SUB
SUB Tastaturabfrage (T$, Zeit$, Feld, Pfad$, Spra$, D1$, DD1$, MOD$)
T$ = ""
IF MOD$ = "Erweitern" THEN Weite = 67
IF MOD$ = "Name" THEN Weite = 20
IF MOD$ = "be" THEN Weite = 67
DO
ZE$ = "_ "
eing$ = ""
IF MOD$ <> "be" THEN CALL TimeWatch
CALL warnen
K$ = INKEY$
IF K$ = "^" AND MOD$ = "Erweitern" THEN HZ = 2: CALL HilfeDatei
IF K$ = "^" AND MOD$ = "Name" THEN HZ = 7: CALL HilfeDatei
IF K$ = "^" AND MOD$ = "be" THEN
CALL SPIZHilfe
CALL BildAufbau2
CALL TestFeldNeuAufbauen(D1$, DD1$)
MOD$ = "be"
END IF
IF K$ = CHR$(13) THEN 'Wenn ENTER dann
IF T$ = "" THEN Beenden = 2: GOTO erweittasteende
DAT$ = T$
IF MOD$ <> "be" THEN CALL Wortbuch(DAT$, Zeit$, Pfad$)
IF ErweitFehler <> 1 THEN ZE$ = " ": NFSE = 1: GOTO Felder
END IF
TasteNB = 0
FOR NK = 0 TO 32
IF K$ = CHR$(NK) OR K$ = "^" THEN TasteNB = 1
NEXT NK
IF TasteNB <> 1 OR K$ = " " THEN T$ = T$ + K$
IF ZEICH > Weite THEN
ZEICH = Weite
T$ = LEFT$(T$, Weite)
END IF
ZEICH = LEN(T$)
IF K$ = CHR$(8) THEN
BACKTASTE = BACKTASTE + 1
IF BACKTASTE < 2 THEN
TSpeicher$ = T$
END IF
ZEICH = ZEICH - 1
IF ZEICH < 0 THEN ZEICH = 0
Laenge = LEN(T$)
Laenge = Laenge - 1
IF Laenge < 0 THEN Laenge = 0
T$ = LEFT$(T$, Laenge)
END IF
TSpeicherl = LEN(TSpeicher$)
TL = LEN(T$)
IF TL > TSpeicherl THEN TSpeicher$ = T$: BACKTASTE = 0
IF K$ = CHR$(9) THEN
TSpeicherl = LEN(TSpeicher$)
TL = LEN(T$)
GSP = TSpeicherl - TL
T$ = T$ + RIGHT$(TSpeicher$, GSP)
END IF
IF K$ = CHR$(27) THEN Beenden = 1: EXIT DO
Felder:
IF MOD$ = "Erweitern" THEN CALL ErweitMenueFelder(T$, Zeit$, Feld, Pfad$, Spra$)
IF MOD$ = "Name" THEN CALL FeldName(T$)
IF MOD$ = "be" THEN CALL Felduebe(T$, K$, Zeit$, 3, 7, D1$, DD1$)
IF NFSE = 1 THEN EXIT DO
LOOP UNTIL Beenden = 1 OR Beenden = 2
erweittasteende:
ZEICH = 0
END SUB
SUB Test (N$, Zeit$)
DIM W(2000)
CLS
'**********************Wenn die Option = null ist dann**********************
CALL BildAufbau2
IF ZA > Z THEN ZA = 1
IF ZB > Z THEN ZB = Z
IF ZA = 0 THEN ZA = 1
IF ZB = 0 THEN ZB = Z
IF XX = 0 THEN XX = 1
IF O < 1 THEN O = 10000
'***********************************der-Test********************************
2
DO
CALL Bildaufbau(A$)
CALL warnen
LOCATE 2, 70
PRINT TIME$
'*************fragt-nicht-mehr-ab-als-o-(0 = wieviele-Aufgaben)*************
IF Aufgabe > O - 1 AND Nochmal <> 3 THEN 3
7
'********************nimmt-Vokabeln-nicht-in-Reihenfolge*******************
Q1 = INT(RND(1) * Z + 1)
'**************************************************************************
LOCATE 2, 70
PRINT "SUCHE "
FOR I = 1 TO S
CALL warnen
IF Q1 = W(I) THEN 7
NEXT I
REM IF S >= ZB - ZA - 1 THEN 3 '''als fehler gefunden am 1.09.03
IF Q1 < ZA THEN 7
IF Q1 > ZB THEN 7
CALL Vokabelsuchen(Zeit$, D$, DD$, E$, EE$, N$)
'****schtzen-vor-wiederholten-Fragen-einer-richtig-bersetzten-Vokabel****
CLOSE #1
Auf = 0
'**************************Deutsch-auf-Fremdsprache*************************
IF XX = 1 THEN D1$ = D$: DD1$ = DD$: E1$ = E$: EE1$ = EE$
'**************************Fremdsprache-auf-Deutsch*************************
IF XX = 2 THEN D1$ = E$: E1$ = D$: DD1$ = EE$: EE1$ = DD$
'****************************durcheinander-fragen***************************
IF XX = 3 THEN
aus = INT(RND(1) * 2)
IF aus = 0 THEN D1$ = D$: DD1$ = DD$: E1$ = E$: EE1$ = EE$
IF aus = 1 THEN D1$ = E$: E1$ = D$: DD1$ = EE$: EE1$ = DD$
IF aus <> 0 AND aus <> 1 THEN D1$ = D$: DD1$ = DD$: E1$ = E$: EE1$ = EE$
END IF
'**************************Fremdsprache1-auf-Fremdsprache2*************************
IF XX = 4 THEN D1$ = E$: DD1$ = DD$: EE1$ = EE$: E1$ = D$
'************************Vokabel-anzeigen-und-abfragen**********************
CALL VokabelAnzeigen(D1$, DD1$)
T$ = ""
XT = 3
YT = 7
NeuTaste:
LOCATE 6, 27
PRINT " j e t z t e i n g e b e n "
Beenden = 0
CALL Tastaturabfrage(T$, Zeit$, Feld, Pfad$, Spra$, D1$, DD1$, "be")
LOCATE 6, 27
PRINT "ÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ"
IF Beenden = 1 THEN
CALL maske(9, 12, " Wollen Sie wirklich das šben abbrechen")
LOCATE 11, 25
PRINT " (J/N) "
DO
P$ = INPUT$(1)
IF P$ = "J" OR P$ = "j" THEN 3
IF P$ = "n" OR P$ = "N" THEN
CALL TestFeldNeuAufbauen(D1$, DD1$)
FOR I = 9 TO 12
FOR I2 = 19 TO 61
LOCATE I, I2
PRINT " "
NEXT I2
NEXT I
END IF
LOOP UNTIL P$ = "n" OR P$ = "N"
Beenden = 0
END IF
'********************Wenn-es-richtig-gemacht-worden-ist-dann****************
CALL right(W(), A$, T$, E1$, EE1$, ENDE)
IF ENDE = 1 THEN 3
'**********************Wenn-es-falsch-gemacht-worden-ist-dann***************
CALL wrong(A$, T$, E1$, EE1$)
IF Versuch > 0 AND Versuch < 2 THEN CALL Bildaufbau(A$): GOTO NeuTaste
CALL warnen
Aufgabe = Aufgabe + 1
LOOP
3
CLOSE #1
CLS
loben = 1
Versuch = 0
END SUB
SUB TestFeldNeuAufbauen (D1$, DD1$)
CALL VokabelAnzeigen(D1$, DD1$)
LOCATE 25, 3
PRINT USING "###. Aufgabe"; Aufgabe
LOCATE 26, 3
PRINT USING "###"; richtig
LOCATE 27, 3
PRINT USING "###"; Fehler
IF Aufgabe > 0 THEN
ZWPR = richtig * 100 / Aufgabe
LOCATE 25, 20
PRINT USING "###% Richtig beantwortet"; ZWPR
END IF
END SUB
SUB TestMaske
COLOR 7
H1 = 1
H2 = 28
B1 = 1
B2 = 80
FOR I = H1 + 1 TO H2 - 1
LOCATE I, B1: PRINT "º"
LOCATE I, B2: PRINT "º"
NEXT I
FOR I = 1 TO B2 - B1 - 1
LOCATE H1, B1 + I: PRINT "Í"
LOCATE H2, B1 + I: PRINT "Í"
NEXT I
LOCATE H1, B1: PRINT "É"
LOCATE H1, B2: PRINT "»"
LOCATE H2, B1: PRINT "È"
LOCATE H2, B2: PRINT "Œ"
FOR I = 2 TO 79
LOCATE 24, I
PRINT "Í"
LOCATE 3, I
PRINT "Í"
LOCATE 6, I
PRINT "Í"
LOCATE 8, I
PRINT "Í"
NEXT I
LOCATE 3, 1
PRINT "Ì"
LOCATE 3, 80
PRINT "¹"
LOCATE 6, 1
PRINT "Ì"
LOCATE 8, 1
PRINT "Ì"
LOCATE 24, 1
PRINT "Ì"
LOCATE 6, 80
PRINT "¹"
LOCATE 24, 80
PRINT "¹"
LOCATE 8, 80
PRINT "¹"
END SUB
SUB TimeWatch
COLOR 7, 0
LOCATE 2, 70
PRINT TIME$
END SUB
SUB ubersetzen (Pfad$)
KM = 0
VokabelMax = 0
DName$ = Pfad$ + "Wortbuch.uch"
OPEN DName$ FOR INPUT AS #1
DO
VokabelMax = VokabelMax + 1
LINE INPUT #1, Deutsch1$
IF EOF(1) THEN EXIT DO
LINE INPUT #1, DVon1$
IF EOF(1) THEN EXIT DO
LINE INPUT #1, Deutsch2$
IF EOF(1) THEN EXIT DO
LINE INPUT #1, DVon2$
IF EOF(1) THEN EXIT DO
LINE INPUT #1, Fremd1$
IF EOF(1) THEN EXIT DO
LINE INPUT #1, FVon1$
IF EOF(1) THEN EXIT DO
LINE INPUT #1, Fremd2$
IF EOF(1) THEN EXIT DO
LINE INPUT #1, FVon2$
LOOP UNTIL EOF(1)
CLOSE #1
CLS
CALL maske(1, 3, "Eingegebene Vokabel bersetzen")
DName$ = Pfad$ + "Wortbuch.uch"
LOCATE 7, 2
PRINT " hier eingeben:"
'______________________________________Tasteneingabe___________________________________________________
DO
K$ = INKEY$
IF K$ = CHR$(27) THEN EXIT SUB
IF K$ <> "" AND X2 < 63 AND K$ <> CHR$(8) AND K$ <> CHR$(9) AND K$ <> CHR$(13) THEN N$ = N$ + K$: X2 = X2 + 1
IF Y2 > 22 THEN Y2 = 0: X2 = 0: CLS
IF K$ = CHR$(13) THEN 'wenn ENTER dann
X2 = 0
GOSUB ENTER
KM = 0
N$ = ""
LOCATE 7, 2
PRINT " hier eingeben:"
END IF
IF K$ = CHR$(8) THEN
X2 = X2 - 1
IF X2 < 0 THEN X2 = 0
Laenge = LEN(N$)
Laenge = Laenge - 1
IF Laenge < 0 THEN Laenge = 0
N$ = LEFT$(N$, Laenge)
LOCATE 8, 3: PRINT N$
END IF
LOCATE 8, 3: PRINT N$; "_ "
LOOP
'_____________schluss______________Tasteneingabe_________________________________________
ENTER:
N$ = LCASE$(N$)
LOCATE 7, 1
PRINT " "
PRINT " "
PCOPY 0, 1
OPEN DName$ FOR INPUT AS #1
Start = TIMER
DO
COLOR 1, 3
IF KM < 1 THEN KM = KM + 1: CALL maske(10, 12, " ")
CALL warte
COLOR 7, 0
LINE INPUT #1, Deutsch1$
IF EOF(1) THEN EXIT DO
LINE INPUT #1, DVon1$
LINE INPUT #1, Deutsch2$
LINE INPUT #1, DVon2$
LINE INPUT #1, Fremd1$
LINE INPUT #1, FVon1$
LINE INPUT #1, Fremd2$
LINE INPUT #1, FVon2$
GOSUB Auswerten
LOOP UNTIL EOF(1)
CLOSE #1
PCOPY 1, 0
RETURN
Auswerten:
Deu1$ = "?" + LCASE$(Deutsch1$) + "?"
Deu2$ = "?" + LCASE$(Deutsch2$) + "?"
Fre1$ = "?" + LCASE$(Fremd1$) + "?"
Fre2$ = "?" + LCASE$(Fremd2$) + "?"
XPO = 7
XPo2 = 10
FOR I = 1 TO 100
IF N$ = MID$(Deu1$, I, LEN(N$)) OR N$ = MID$(Deu2$, I, LEN(N$)) THEN
CALL Vokuebersetzanzeige(XPO)
LOCATE XPO, 3
PRINT DVon1$; ":"
XPO = XPO + 1
LOCATE XPO, 3
PRINT Deutsch1$
XPO = XPO + 1
LOCATE XPO, 3
PRINT Deutsch2$
XPo2 = XPo2 + 2
LOCATE XPo2, 3
PRINT "in "; FVon1$; ":"
XPo2 = XPo2 + 1
LOCATE XPo2, 3
PRINT Fremd1$
XPo2 = XPo2 + 1
LOCATE XPo2, 3
PRINT Fremd2$
GOTO 30
END IF
XPO = 7
XPo2 = 10
IF N$ = MID$(Fre1$, I, LEN(N$)) OR N$ = MID$(Fre2$, I, LEN(N$)) THEN
CALL Vokuebersetzanzeige(XPO)
LOCATE XPO, 3
PRINT FVon1$; ":"
XPO = XPO + 1
LOCATE XPO, 3
PRINT Fremd1$
XPO = XPO + 1
LOCATE XPO, 3
PRINT Fremd2$
XPo2 = XPo2 + 2
LOCATE XPo2, 3
PRINT "in "; DVon1$; ":"
XPo2 = XPo2 + 1
LOCATE XPo2, 3
PRINT Deutsch1$
XPo2 = XPo2 + 1
LOCATE XPo2, 3
PRINT Deutsch2$
GOTO 30
END IF
NEXT I
GOTO 40
'---------------------------------------------------------------------------
30
LOCATE 22, 27
PRINT "Bitte eine Taste drcken"
DO
K$ = INKEY$
IF K$ = CHR$(27) THEN KM = 0: RESET: GOTO 40
LOOP UNTIL K$ <> ""
KM = 0
'---------------------------------------------------------------------------
40
COLOR 7, 0
RETURN
END SUB
SUB VokabelAnzeigen (D1$, DD1$)
LOCATE 4, 3
PRINT " "
LOCATE 4, 3
PRINT ""; D1$; ""
LOCATE 5, 3
PRINT " "
LOCATE 5, 3
PRINT ""; DD1$; ""
END SUB
SUB Vokabelsuchen (Zeit$, D$, DD$, E$, EE$, N$)
LOCATE 26, 26
PRINT "Aufgabe NR."; Q1; " "
LOCATE 2, 70
PRINT "SUCHE "
CLOSE #1
ON ERROR GOTO 100
OPEN N$ FOR INPUT AS #1
DO
CALL warnen
Auf = Auf + 1
LINE INPUT #1, D$
IF EOF(1) THEN 33
LINE INPUT #1, DD$
IF EOF(1) THEN 33
LINE INPUT #1, E$
IF EOF(1) THEN 33
LINE INPUT #1, EE$
IF EOF(1) THEN 33
IF Auf = Q1 THEN 33
LOOP UNTIL INKEY$ = CHR$(27)
33
CLOSE #1
END SUB
SUB vokiniladen (N$, Zeit$, Pfad$)
ON ERROR GOTO 102
OPEN "vok.ini" FOR INPUT AS #1
LOCATE 12, 1
PRINT " Bitte Warten !!!!!"
INPUT #1, N$
INPUT #1, ZA
INPUT #1, ZB
INPUT #1, XX
INPUT #1, O
INPUT #1, Nochmal
INPUT #1, Zeit$
INPUT #1, WSS
INPUT #1, Pfad$
INPUT #1, BPanz
CLOSE #1
IF ".vok" <> RIGHT$(N$, 4) THEN N$ = N$ + ".vok"
END SUB
SUB vokinimachen
N$ = "load12345"
CLOSE #1
OPEN "vok.ini" FOR OUTPUT AS #1
PRINT #1, N$
PRINT #1, ZA
PRINT #1, ZB
PRINT #1, XX
PRINT #1, O
PRINT #1, Nochmal
PRINT #1, "00:00:00"
PRINT #1, "120"
PRINT #1, "c:\vokabel\wortbuch\"
PRINT #1, "50"
CLOSE #1
END SUB
SUB Vokuebersetzanzeige (XPO)
COLOR 11, 5
FOR K = 6 TO 15
FOR K2 = 2 TO 78
LOCATE K, K2
PRINT " "
NEXT K2
NEXT K
CALL maske(4, 16, " Ich bersetze von: ")
LOCATE 5, 60
PRINT "("; VokabelMax; "Vokabeln )"
LOCATE XPO, 3
PRINT " "
LOCATE XPO + 1, 3
PRINT " "
LOCATE XPO + 2, 3
PRINT " "
LOCATE XPO + 4, 3
PRINT " "
LOCATE XPO + 5, 3
PRINT " "
LOCATE XPO + 6, 3
PRINT " "
LOCATE XPO + 7, 3
PRINT " "
END SUB
SUB vollstaendigkeit
CLS
LOCATE 12, 1
PRINT " Programm wird nach Volst„ndigkeit getestet"
ON ERROR GOTO 223: OPEN "proz.prz" FOR INPUT AS #1
CLOSE #1
ON ERROR GOTO HelpNotFind
HD$ = "HILFEM1"
OPEN HD$ + ".hlp" FOR INPUT AS #1
CLOSE #1
HD$ = "HILFE2"
OPEN HD$ + ".hlp" FOR INPUT AS #1
CLOSE #1
HD$ = "HILFE3"
OPEN HD$ + ".hlp" FOR INPUT AS #1
CLOSE #1
HD$ = "HILFE4"
OPEN HD$ + ".hlp" FOR INPUT AS #1
CLOSE #1
HD$ = "HILFE5"
OPEN HD$ + ".hlp" FOR INPUT AS #1
CLOSE #1
HD$ = "HILFE6"
OPEN HD$ + ".hlp" FOR INPUT AS #1
CLOSE #1
HD$ = "HILFE7"
OPEN HD$ + ".hlp" FOR INPUT AS #1
CLOSE #1
END SUB
SUB vorschlag
LOCATE 10, 18
PRINT "Ich wrde vorschlagen Sie ben nochmal!"
PRINT
PRINT
END SUB
SUB warnen
IF TIME$ = Zeit$ THEN BEEP: BEEP: BEEP: BEEP: BEEP: BEEP
END SUB
SUB warte
Start = Start + 1
IF KM < 1 THEN KM = KM + 1: CALL maske(10, 12, " ")
IF Start > 0 THEN LOCATE 11, 34: PRINT "Bitte warten "; CHR$(15); " "
IF Start > 1 THEN LOCATE 11, 34: PRINT "Bitte warten ³ "
IF Start > 2 THEN LOCATE 11, 34: PRINT "Bitte warten / "
IF Start > 3 THEN LOCATE 11, 34: PRINT "Bitte warten - "
IF Start > 4 THEN LOCATE 11, 34: PRINT "Bitte warten \ ": Start = 0
END SUB
SUB WortBeispiele (Wort$, Wortb$)
WortSP$ = Wort$
IF LEN(Wort$) < 3 THEN EXIT SUB
KM = 0
PCOPY 0, 2
OPEN Pfad$ + "wortbei.wbi" FOR OUTPUT AS #2
FOR ABz = 97 TO 122
COLOR 15, 1
CALL warte
COLOR 7, 0
OPEN Pfad$ + Wortb$ + CHR$(ABz) + "ch" FOR INPUT SHARED AS #1
DO
K$ = INKEY$
IF K$ = CHR$(27) THEN GOTO ENDE2
LINE INPUT #1, X$
X3$ = LCASE$(X$)
Wort$ = LCASE$(Wort$)
FOR I1 = LEN(Wort$) + 1 TO Gro1 STEP -1 'umgekerhrt nicht step -1
Tex$ = ""
FOR I2 = 1 TO LEN(Wort$) - I1
FOR AZ = LEN(X$) TO 1 STEP -1 'das muss umgekehrt nicht step-1
IF MID$(X3$, AZ, I1) = MID$(Wort$, I2, I1) AND LEN(X$) < LEN(Wort$) + 3 AND Tex$ <> X$ THEN
IF INKEY$ = CHR$(27) THEN GOTO ENDE2
Tex$ = X$
PRINT #2, I1, X$
IF I1 > Gro1 THEN Gro1 = I1: WG = 0
EXIT FOR
END IF
NEXT AZ
NEXT I2
NEXT I1
LOOP UNTIL EOF(1)
CLOSE #1
NEXT ABz
CLOSE #2
'----------------------------------------------------------------------------
44
COLOR 15, 3
FOR I = 22 TO 59
FOR I2 = 7 TO 15
LOCATE I2, I
PRINT " "
NEXT I2
NEXT I
VIEW PRINT 7 TO 17
COLOR 15, 3
CALL maske(7, 16, " ")
OPEN Pfad$ + "wortbei.wbi" FOR INPUT AS #2
DO
INPUT #2, I1
IF EOF(2) THEN EXIT DO
INPUT #2, X$
IF I1 = Gro1 AND X$ <> Tex$ THEN
TX = TX + 1
IF TX > 5 THEN
TX = 1
LOCATE 15, 28
PRINT "Bitte drcke Leer-Taste"
DO
K$ = INKEY$
IF K$ = CHR$(27) THEN GOTO ENDE2
LOOP UNTIL K$ = " "
FOR I = 22 TO 59
FOR I2 = 7 TO 15
LOCATE I2, I
COLOR 15, 3
PRINT " "
NEXT I2
NEXT I
COLOR 15, 3
CALL maske(7, 16, " ")
END IF
LOCATE 8 + TX, 35
COLOR 15, 3
PRINT X$
LOCATE 15, 35
END IF
LOOP UNTIL EOF(2)
CLOSE #2
VIEW PRINT 1 TO 24
LOCATE 15, 28
PRINT "Bitte drcke Leer-Taste"
DO
LOOP UNTIL INKEY$ = " "
ENDE2:
PCOPY 2, 0
COLOR 7, 0
Wort$ = WortSP$
VIEW PRINT 1 TO 24
END SUB
SUB Wortbuch (DAT$, Zeit$, Pfad$)
IF DAT$ = "" THEN 2000
l$ = " "
SATZ$ = DAT$ + " "
LaengedS = LEN(SATZ$)
DO
'--------------------------Satz auseinander nehmen---------------------------
997
CALL auseinandernehmen(SATZ$, Wort$, Zeit$, laeq, loopende, PU, LU, CE, LaengedS)
IF loopende = 1 THEN 2000
'----------------------------Wort testen-------------------------------------
IF Wort$ = l$ THEN 997
CALL TimeWatch
CALL warnen
'----------------------------------Wort nach Fehlern suchen------------------
ON ERROR GOTO NAMENBUCHFEHLT
OPEN Pfad$ + "Namebuch.uch" FOR INPUT AS #1
DO
CALL TimeWatch
CALL warnen
LINE INPUT #1, GLW$
IF EOF(1) THEN ErweitFehler = 1
IF Wort$ = GLW$ THEN ErweitFehler = 0: GOTO 997
LOOP UNTIL ErweitFehler = 1
CLOSE #1
ErweitFehler = 0
ON ERROR GOTO quatschBuchFehler
OPEN Pfad$ + "quatsch.uch" FOR INPUT AS #1
DO
CALL TimeWatch
CALL warnen
LINE INPUT #1, GLW$
IF EOF(1) THEN ErweitFehler = 1
IF Wort$ = GLW$ THEN ErweitFehler = 0: GOTO 997
LOOP UNTIL ErweitFehler = 1
CLOSE #1
ErweitFehler = 0
IF Sprache = 0 THEN
T$ = LEFT$(Wort$, 1)
Woert1$ = "deutbuch."
Woert3$ = "ch"
END IF
IF Sprache = 1 THEN
T$ = LEFT$(Wort$, 1)
Woert1$ = "frembuch."
Woert3$ = "ch"
END IF
IF "„" = T$ OR "Ž" = T$ THEN Wo$ = "a"
IF "™" = T$ OR "”" = T$ THEN Wo$ = "o"
IF "á" = T$ THEN Wo$ = "s"
IF "š" = T$ OR "" = T$ THEN Wo$ = "u"
FOR BuchZ = 65 TO 90
IF T$ = CHR$(BuchZ) THEN Wo$ = CHR$(BuchZ)
NEXT BuchZ
FOR BuchZ = 97 TO 122
IF T$ = CHR$(BuchZ) THEN Wo$ = CHR$(BuchZ)
NEXT BuchZ
'------------------Teste ob Wort im W”rterbuch enthalten ist--------------------
WoerterBuch$ = Pfad$ + Woert1$ + Wo$ + Woert3$
ON ERROR GOTO ENDE
OPEN WoerterBuch$ FOR INPUT AS #1
DO
CALL TimeWatch
CALL warnen
LINE INPUT #1, GLW$
lae2 = LEN(GLW$)
IF lae2 <> 0 THEN G2$ = RIGHT$(GLW$, lae2 - 1)
G$ = LEFT$(GLW$, 1)
G$ = UCASE$(G$)
GK$ = LEFT$(GLW$, 1)
GK$ = LCASE$(G$)
IF Wort$ = GLW$ AND CE = 1 THEN
ErweitFehler = 0: GOTO 997
END IF
IF LU < 1.2 THEN
IF G$ + G2$ = Wort$ THEN ErweitFehler = 0: GOTO 997
END IF
IF LU > 1 OR CE = 1 THEN 'Wenn nach : . ? groá oder erstes Wort
IF Wort$ = GLW$ THEN
IF GLW$ = G$ + G2$ THEN ErweitFehler = 0: GOTO 997
FehlerSatz$ = " Klein- und Groárechtschreibfehler"
ErweitFehler = 1
EXIT DO
END IF
GLW$ = G$ + G2$
END IF
IF Wort$ = GLW$ THEN
ErweitFehler = 0: GOTO 997
END IF
IF Wort$ = GK$ + G2$ THEN 'wenn das Wort klein geschri. wurde
FehlerSatz$ = " Klein- und Groárechtschreibfehler"
ErweitFehler = 1
EXIT DO
END IF
IF EOF(1) THEN ErweitFehler = 1
LOOP UNTIL ErweitFehler = 1
CLOSE #1
IF ErweitFehler = 1 THEN
PCOPY 0, 1
COLOR 15, 4
CALL Maske2
LOCATE 10, 35
PRINT USING "Das ##. Wort"; CE
A$ = Wort$
LOCATE 12, 40 - (LEN(A$) / 2)
PRINT "("; A$; ")"
IF FehlerSatz$ <> "" THEN 'gross und klein schreibfehler
laedwort = LEN(Wort$)
GWORT$ = RIGHT$(Wort$, laedwort - 1)
X$ = LEFT$(Wort$, 1)
X$ = UCASE$(X$) + GWORT$
LOCATE 14, 19
PRINT FehlerSatz$
A$ = X$
LOCATE 13, 40 - (LEN(A$) / 2)
PRINT "("; A$; ")û"
LOCATE 15, 9
PRINT "Bitte eine Taste drcken, Taste (D) wenn es doch richtig ist!"
LOCATE 16, 5
PRINT "Taste (A) wenn das Wort hiervor, eine Abkrzung war, zum Beispiel z.B."
DO
K$ = INKEY$
IF K$ = "d" OR K$ = "D" THEN CALL WortBuchDochRichtig(WoerterBuch$, Wort$, A$)
IF K$ = "A" OR K$ = "a" THEN ErweitFehler = 0
LOOP UNTIL K$ <> ""
END IF
IF FehlerSatz$ = "" THEN
LOCATE 13, 28
FehlerSatz$ = "ist Falsch geschrieben bzw."
PRINT FehlerSatz$
LOCATE 14, 31
PRINT "nicht im W”rter- oder"
LOCATE 15, 13
PRINT "Namenbuch<A> / Quatschbuch<Q> / Beispiele<B> / Hilfe<^>"
LOCATE 16, 9
PRINT "Hinzufgen(J=JA im W”rterbuch speichern/N=NEIN nich speichern)";
5
DO
FR$ = INPUT$(1)
IF FR$ = "ø" OR FR$ = "^" THEN HZ = 5: CALL HilfeDatei: GOTO 5
IF FR$ = "" OR FR$ = "n" OR FR$ = "N" OR FR$ = CHR$(27) THEN ErweitFehler = 1: EXIT DO
IF FR$ = "b" OR FR$ = "B" THEN CALL WortBeispiele(Wort$, Woert1$)
IF FR$ = "Q" OR FR$ = "q" THEN
CALL TimeWatch
CALL warnen
OPEN Pfad$ + "quatsch.uch" FOR APPEND AS #1
PRINT #1, Wort$
CLOSE #1
ErweitFehler = 0
EXIT DO
END IF
IF FR$ = "A" OR FR$ = "a" THEN
CALL TimeWatch
CALL warnen
OPEN Pfad$ + "namebuch.uch" FOR APPEND AS #1
PRINT #1, Wort$
CLOSE #1
ErweitFehler = 0
EXIT DO
END IF
IF FR$ = "j" OR FR$ = "J" THEN
laedwort = LEN(Wort$)
GWORT$ = RIGHT$(Wort$, laedwort - 1)
'Wort in gross
Wort1$ = LEFT$(Wort$, 1)
Wort1$ = UCASE$(Wort1$) + GWORT$
'Wort in klein
Wort2$ = LEFT$(Wort$, 1)
Wort2$ = LCASE$(Wort2$) + GWORT$
IF Wort$ = Wort1$ THEN Wot2$ = Wort2$ 'wenn Wort gross
IF Wort2$ = Wort$ THEN 'Wenn das Wort klein geschr. ist
OPEN WoerterBuch$ FOR APPEND AS #1
PRINT #1, Wort$
CLOSE #1
ErweitFehler = 0
Beenden = 1
EXIT DO
END IF
CALL Maske2
LOCATE 12, 18
PRINT "1. Eigenschaftswort(Nomen)/ 2. Adjektiv oder Verb"
LOCATE 10, 15
PRINT "Wie wird das Wort geschrieben, wenn es alleine steht?"
LOCATE 14, 3
PRINT "1. "; Wort$
LOCATE 15, 3
PRINT "2. "; Wot2$
DO
K$ = INKEY$
IF K$ = "1" THEN
OPEN WoerterBuch$ FOR APPEND AS #1
PRINT #1, Wort$
CLOSE #1
ErweitFehler = 0
Beenden = 1
EXIT DO
END IF
IF K$ = "2" THEN
OPEN WoerterBuch$ FOR APPEND AS #1
PRINT #1, Wot2$
CLOSE #1
ErweitFehler = 0
Beenden = 1
EXIT DO
END IF
IF K$ = "ø" OR K$ = "^" THEN HZ = 4: CALL HilfeDatei
LOOP
END IF
LOOP UNTIL Beenden = 1
Beenden = 0
END IF
PCOPY 1, 0
END IF
FehlerSatz$ = ""
LOOP UNTIL ErweitFehler = 1
2000
END SUB
SUB WortBuchDochRichtig (WoerterBuch$, Wort$, A$)
'Wort im W”rterbuch berichtigen durch Taste (D)
OPEN WoerterBuch$ FOR INPUT AS #1
OPEN LEFT$(WoerterBuch$, LEN(WoerterBuch$) - 3) + "xxx" FOR OUTPUT AS #2
DO
LINE INPUT #1, X$
IF X$ <> A$ THEN PRINT #2, X$
LOOP UNTIL EOF(1)
CLOSE #1
PRINT #2, Wort$
CLOSE #2
KILL WoerterBuch$
NAME LEFT$(WoerterBuch$, LEN(WoerterBuch$) - 3) + "xxx" AS WoerterBuch$
KILL LEFT$(WoerterBuch$, LEN(WoerterBuch$) - 3) + "xxx"
END SUB
SUB wrong (A$, T$, E1$, EE1$)
Versuch = Versuch + 1
IF Versuch < 2 THEN
A$ = "Falsch "
FOR I = 13 TO 22
FOR I2 = 2 TO 79
LOCATE I, I2
PRINT " "
NEXT I2
NEXT I
LOCATE 12, 3
PRINT "Hilfe:"
A = LEN(E1$)
BLaenge = (A * BPanz) / 100
B = LEN(EE1$)
BLaenge1 = (B * BPanz) / 100
TEXT$ = LEFT$(E1$, BLaenge)
Text1$ = LEFT$(EE1$, BLaenge1)
LOCATE 13, 3
PRINT TEXT$; "..."
LOCATE 14, 3
PRINT Text1$; "..."
EXIT SUB
END IF
IF Versuch > 1 THEN Versuch = 0
IF T$ <> E1$ AND T$ <> EE1$ OR T$ = "" THEN
Fehler = Fehler + 1
Zaehler = 0
A$ = "Falsch "
FOR I = 16 TO 18
FOR I2 = 2 TO 79
LOCATE I, I2
PRINT " "
NEXT I2
NEXT I
COLOR 3
LOCATE 16, 3
PRINT "Berichtigt:"
COLOR 7
LOCATE 17, 3
PRINT E1$
LOCATE 18, 3
PRINT EE1$
LOCATE 22, 3
PRINT " "
LOCATE 21, 3
COLOR 3
PRINT "Sie haben eingegeben :"
LOCATE 22, 3
COLOR 7
PRINT T$
END IF
END SUB