Benutzer:FbNutzer/FreePascalThemen
Programme für FreePascal und TurboPascal
vokabeltrainer.pas
[Bearbeiten]PROGRAM Vokabeltrainer;
{ Vokabeltrainer erstellt 1993 von "wikibooks.de/Benutzer:FbNutzer"}
{ mit TurboPascal 6.0 ; 2012 modif., damit komp. mit FreePascal(Lazarus)}
{ Schriftart wenn möglich im Win32-Konsolenfenster auf TT Lucida }
{ stellen, weil dann das Sonderzeichen œ (wie in sœuer) vorhanden ist }
{$I-} {$S-} {$R+}
USES Dos,Crt;
CONST Zeilenanzahl = 8;
TYPE Worttyp = STRING[53];
Zeigertyp = ^Worttyp;
Sprachenarraytyp = ARRAY[1..1000] OF Zeigertyp;
String30 = STRING[30];
Texttyp = ARRAY[0..Zeilenanzahl] OF String30;
Inhaltstyp = ARRAY[1..105] OF STRING[20];
chFTyp = ARRAY[1..14] OF CHAR;
CONST uekW = 'ü'; aekW = 'ä'; aegW = 'Ä'; oekW = 'ö';
oegW = 'Ö'; uegW = 'Ü'; szettW = 'ß';
uekD = #129; aekD = #132; aegD = #142; oekD = #148;
oegD = #153; uegD = #154 ; szettD = #225;
chFW : chFTyp = {WIN kompatibel}
('é','è','à','â','ç','ê','î','ù','û','ï','ô','ë','É','œ');
chFD : chFTyp = {DOS kompatibel}
(#130,#138,#133,#131,#135,#136,#140,#151,#150,#139,#147,#137,#144,#32);
VAR altes_Textattribut,Punkt : BYTE;
Deutsch,Fremdsprache : Sprachenarraytyp;
Beenden,ch : CHAR;
Laenge,Hintergrundfarbe,
Vordergrundfarbe,i,j : INTEGER;
FT_Anzeige,Dummy : BOOLEAN;
MText : Texttyp;
MaxLaenge : INTEGER;
Pfad : STRING;
hoehe,hoeheKAT : INTEGER;
uek,ueg,aek,aeg,oek,oeg,szett: CHAR;
chF : chFTyp ;
chD_komp : BOOLEAN;
PROCEDURE InitSonderZeichen;
BEGIN
IF chD_komp=true THEN {wenn DOS kompatibel }
BEGIN
chF:=chFD;
uek:=uekD; ueg:=uegD; aek:=aekD; oek:=oekD; oeg:=oegD;
szett:=szettD;
END
ELSE BEGIN {wenn WIN kompatibel }
chF:=chFW;
uek:=uekW; ueg:=uegW; aek:=aekW; oek:=oekW; oeg:=oegW;
szett:=szettW;
END;
MText[0]:=' VOKABELTRAINER ';
MText[1]:=' Info & Einstellung ';
MText[2]:=' Vokabeln eingeben ';
MText[3]:=' Vokabeln abfragen ';
MText[4]:=' Vokabelreferenz ';
MText[5]:=' Vokabeln speichern ';
MText[6]:=' Vokabeln laden ';
MText[7]:=' Vokabeln l'+oek+'schen ';
MText[8]:=' Programmende ';
END;
PROCEDURE Tastaturpuffer_loeschen;
VAR ch : CHAR;
BEGIN
WHILE KeyPressed DO
ch:=ReadKey;
end;
PROCEDURE Konfiguration_speichern;
VAR Datei : FILE OF INTEGER;
ch : CHAR;
Error,Wert : INTEGER;
BEGIN
Assign(Datei,'VKONFIG.DAT');
Rewrite(Datei);
Error:=IOResult;
IF Error=0 THEN
BEGIN
Wert:=hoeheKat*1024;
IF chD_komp THEN
Wert:=Wert+512;
IF FT_Anzeige THEN
Wert:=Wert+256;
Wert:=Wert+16*Hintergrundfarbe+Vordergrundfarbe;
Write(Datei,Wert);
Close(Datei);
END
ELSE
BEGIN
WriteLn(#7,' Fehler beim Schreiben der Datei !');
ch:=ReadKey;
END;
END;
PROCEDURE Pfad_speichern;
VAR Datei : TEXT;
ch : CHAR;
Error : INTEGER;
BEGIN
Assign(Datei,'VPFAD.DAT');
Rewrite(Datei);
Error:=IOResult;
IF Error=0 THEN
BEGIN
WriteLn(Datei,Pfad);
Close(Datei);
END
ELSE BEGIN
WriteLn(#7,' Fehler beim Schreiben des Pfades !');
ch:=ReadKey;
END;
END;
PROCEDURE Pfad_laden;
VAR Datei : TEXT;
Error : INTEGER;
BEGIN
Assign(Datei,'VPFAD.DAT');
Reset(Datei);
Error:=IOResult;
IF Error=0 THEN
BEGIN
ReadLn(Datei,Pfad);
Close(Datei);
END;
END;
PROCEDURE Konfiguration_laden;
VAR Datei : FILE OF INTEGER;
Wert,Wert_h,Error : INTEGER;
BEGIN
Assign(Datei,'VKONFIG.DAT');
Reset(Datei);
Error:=IOResult;
IF Error=0 THEN
BEGIN
Read(Datei,Wert);
CASE Wert div 1024 OF
2 : hoeheKat:=2;
1 : hoeheKat:=1;
ELSE
hoeheKat:=0;
END;
Wert:=Wert mod 1024;
CASE Wert div 512 OF
1 : chD_komp:=true;
0 : chD_komp:=false;
END;
Wert:=Wert mod 512;
CASE Wert div 256 OF
0 : FT_Anzeige:=false;
1 : FT_Anzeige:=true;
END;
Wert:=Wert mod 256;
IF Wert>0 THEN
BEGIN
Hintergrundfarbe:=Wert div 16;
Vordergrundfarbe:=Wert mod 16;
END
ELSE BEGIN
Hintergrundfarbe:=cyan;
Vordergrundfarbe:=black;
END;
Close(Datei);
END;
END;
PROCEDURE Cursor_aus;
BEGIN
IF Vordergrundfarbe<>Hintergrundfarbe THEN
CursorOff;
END;
PROCEDURE Cursor_ein;
BEGIN
CursorOn;
END;
PROCEDURE Funktionstastenanzeige;
VAR d : INTEGER;
BEGIN
IF hoeheKat=0 THEN d:=0 ELSE d:=1;
GotoXY(75,d+1);Write('F1 :',chF[1]);
GotoXY(75,d+3);Write('F2 :',chF[2]);
GotoXY(75,d+5);Write('F3 :',chF[3]);
GotoXY(75,d+7);Write('F4 :',chF[4]);
GotoXY(75,d+9);Write('F5 :',chF[5]);
GotoXY(75,d+11);Write('F6 :',chF[6]);
GotoXY(75,d+13);Write('F7 :',chF[7]);
GotoXY(75,d+15);Write('F8 :',chF[8]);
GotoXY(75,d+17);Write('F9 :',chF[9]);
GotoXY(75,d+19);Write('F10:',chF[10]);
GotoXY(75,d+21);Write('SF1:',chF[11]);
GotoXY(75,d+23);Write('SF2:',chF[12]);
GotoXY(75,2*d+24); Write('SF3:',chF[13]);
GotoXY(75,3*d+25); Write('SF4:',chF[14]);
END;
FUNCTION Input(VAR Zeichenkette:Worttyp;Esc:BOOLEAN):BOOLEAN;forward;
PROCEDURE Esc_Prozedur;
VAR Wort : Worttyp;
Nummer,F : INTEGER;
Nummer_s : STRING;
BEGIN
Window(1,hoehe-2,74,hoehe);
REPEAT
GotoXY(2,1);
Write('<Zahl>:Zeile '+aek+'ndern 0:Abbruch');
GotoXY(2,2);
Write('Nummer:');
ReadLn(Nummer_s);
Val(Nummer_s,Nummer,F);
IF (Nummer>0) and (Nummer<MaxLaenge) THEN
BEGIN
Val(Nummer_s,Nummer,F);
GotoXY(15,2);
Write('Deutsch : ');
Dummy:=Input(Wort,false);
IF Wort<>'' THEN
Deutsch[Nummer]^:=Wort;
GotoXY(15,3);
Write('Fremdsprache : ');
Dummy:=Input(Wort,false);
IF Wort<>'' THEN
Fremdsprache[Nummer]^:=Wort;
ClrScr;
END;
UNTIL (Nummer<=0) or (Nummer>=MaxLaenge);
ClrScr;
Window(1,3,74,hoehe-3);
END;
FUNCTION Input(VAR Zeichenkette:Worttyp;Esc:BOOLEAN):BOOLEAN;
VAR alt_X,alt_Y,i : BYTE;
Abbruch : BOOLEAN;
ch : CHAR;
BEGIN
Abbruch:=false;
Zeichenkette:='';
i:=0;
REPEAT
Inc(i);
ch:=ReadKey;
IF ch>#31 THEN
BEGIN
Write(ch);
Zeichenkette:=Zeichenkette+ch;
END
ELSE
CASE ch OF
#13 : WriteLn;
#8 : BEGIN
Write(#8,#32,#8);
Delete(Zeichenkette,Length(Zeichenkette),1);
END;
#0 : BEGIN
ch:=ReadKey;
CASE ch OF
#59 : ch:=chF[1]; {F1:é }
#60 : ch:=chF[2]; {F2:è }
#61 : ch:=chF[3]; {F3:à }
#62 : ch:=chF[4]; {F4:â }
#63 : ch:=chF[5]; {F5:ç }
#64 : ch:=chF[6]; {F6:ê }
#65 : ch:=chF[7]; {F7:î }
#66 : ch:=chF[8]; {F8:ù }
#67 : ch:=chF[9]; {F9:û }
#68 : ch:=chF[10]; {F10:Ç}
#84 : ch:=chF[11]; {SF1:ï}
#85 : ch:=chF[12]; {SF2:ô}
#86 : ch:=chF[13];
#87 : ch:=chF[14];
ELSE
ch:=#0;
END;
IF ch<>#0 THEN
BEGIN
Write(ch);
Zeichenkette:=Zeichenkette+ch;
END;
END;
#27 : BEGIN
IF Esc THEN
BEGIN
alt_X:=WhereX;
alt_Y:=WhereY;
Esc_Prozedur;
GotoXY(alt_X,alt_Y);
END
ELSE
Abbruch:=true;
END;
END;
UNTIL (ch=#13) or (Length(Zeichenkette)>52) or Abbruch;
IF Length(Zeichenkette)>52 THEN
WriteLn(#7);
Input:=Abbruch;
END;
PROCEDURE Schreibe_invers(Feldz:STRING;Zeile,x:BYTE);
BEGIN
TextColor(Hintergrundfarbe);
TextBackground(Vordergrundfarbe);
GotoXY(x,Zeile);
Write(Feldz);
TextColor(Vordergrundfarbe);
TextBackground(Hintergrundfarbe);
END;
FUNCTION Menue(Feld:Texttyp;Anzahl,akt_Zeile,Kopfzeile,
Zusatz:BYTE;Esc:BOOLEAN):BYTE;
VAR alte_Zeile,i,maxZeichen,x : BYTE;
ch : CHAR;
BEGIN
maxZeichen:=0;
FOR i:=1 TO Anzahl DO
BEGIN
IF Length(Feld[i])>maxZeichen THEN
maxZeichen:=Length(Feld[i]);
Feld[i]:=' '+Feld[i]+' ';
END;
x:=(78-maxZeichen) div 2-1;
FOR i:=1 TO Anzahl DO
WHILE Length(Feld[i])<maxZeichen+2 DO
Feld[i]:=Feld[i]+' ';
Cursor_aus;
TextColor(Vordergrundfarbe);
TextBackground(Hintergrundfarbe);
ClrScr;
GotoXY((78-Length(Feld[0])) div 2,Kopfzeile);Write(Feld[0]);
REPEAT
FOR i:=1 TO Anzahl DO
BEGIN
GotoXY(x,Zusatz+2*i);
Write(Feld[i]);
END;
Schreibe_invers(Feld[akt_Zeile],Zusatz+2*akt_Zeile,x);
ch:=ReadKey;
IF ch=#0 THEN
BEGIN
ch:=ReadKey;
alte_Zeile:=akt_Zeile;
CASE ch OF
#72 : IF akt_Zeile>1 THEN
Dec(akt_Zeile)
ELSE
akt_Zeile:=Anzahl;
#80 : IF akt_Zeile<Anzahl THEN
Inc(akt_Zeile)
ELSE
akt_Zeile:=1;
END;
GotoXY(x,Zusatz+2*alte_Zeile);Write(Feld[alte_Zeile]);
END;
UNTIL (ch=#13) or (Esc and (ch=#27));
Cursor_ein;
IF Esc and (ch=#27) THEN
Menue:=0
ELSE
Menue:=akt_Zeile;
END;
FUNCTION Untermenue(String0,String1,String2:String30):BYTE;
VAR UFeld : Texttyp;
BEGIN
Window(1,1,80,hoehe);
ClrScr;
UFeld[0]:=' '+String0+' ';
UFeld[1]:=' '+String1+' ';
UFeld[2]:=' '+String2+' ';
UFeld[3]:=' Hauptmen'+uek;
Untermenue:=Menue(UFeld,3,1,5,7,true);
ClrScr;
END;
PROCEDURE Loeschen;
VAR i,x,y,
Unterpunkt : INTEGER;
loesche : CHAR;
xs,ys : STRING[4];
BEGIN
Unterpunkt:=Untermenue('L'+oek+'schen','Alles l'+oek+'schen',
'Zeile(n) l'+oek+'schen');
ClrScr;
CASE Unterpunkt OF
1 : BEGIN
Cursor_aus;
GotoXY(20,10);
Write('Wirklich alles l'+oek+'schen (j/n) ?');
loesche:=UpCase(ReadKey);
IF loesche='J' THEN
BEGIN
FOR i:=1 TO MaxLaenge DO
BEGIN
Deutsch[i]^:='';
Fremdsprache[i]^:='';
END;
Laenge:=0;
END;
END;
2 : BEGIN
GotoXY(15,10);
Write('von Zeile : ');
ReadLn(xs);
GotoXY(15,12);
Write('bis Zeile : ');
ReadLn(ys);
Val(xs,x,i);
IF i=0 THEN
Val(ys,y,i);
IF (i=0) and (x>0) and (y<=Laenge) THEN
BEGIN
FOR i:=0 TO Laenge-y-1 DO
BEGIN
Deutsch[x+i]^:=Deutsch[y+i+1]^;
Fremdsprache[x+i]^:=Fremdsprache[y+i+1]^;
Deutsch[y+i+1]^:='';
Fremdsprache[y+i+1]^:='';
END;
Dec(Laenge,y-x+1);
END
ELSE
Write(#7);
END;
END;
Cursor_ein;
END;
PROCEDURE Eingabe(VAR i:INTEGER);
VAR Wort_d,Wort_f : Worttyp;
i_alt,ab,F,
Unterpunkt : INTEGER;
ab_s : STRING;
BEGIN
i_alt:=0;
ab:=0;
Unterpunkt:=Untermenue('Eingabe','Eingabe','Eingabe ab <Zeile>');
IF Unterpunkt=2 THEN
BEGIN
GotoXY(20,11);
Write('Eingabe ab Zeile : ');
ReadLn(ab_s);
Val(ab_s,ab,F);
IF F<>0 THEN
ab:=0;
IF (ab>0) and (ab<=i+1) THEN
BEGIN
i_alt:=i;
i:=ab-1;
END
ELSE
Write(#7);
END;
ClrScr;
IF (Unterpunkt=1) or (Unterpunkt=2) THEN
BEGIN
Write(' Vokabeltrainer : ');
WriteLn('Eingabe Abbruch mit <ENTER>');
IF FT_Anzeige THEN
Funktionstastenanzeige;
Window (1,3,74,hoehe-3);
REPEAT
Inc(i);
Write(i:3,' Deutsch :');
Dummy:=Input(Wort_d,true);
IF Wort_d<>'' THEN
Deutsch[i]^:=Wort_d;
Write(i:3,' Fremdsprache :');
Dummy:=Input(Wort_f,true);
IF Wort_f<>'' THEN
Fremdsprache[i]^:=Wort_f;
WriteLn;
UNTIL (Wort_d='') or (Wort_f='') or (i=MaxLaenge-1);
IF Deutsch[i]^='' THEN
Dec(i);
IF i_alt>i THEN
i:=i_alt;
END;
END;
PROCEDURE Abfrage;
VAR r_Laenge,Fehler,Woerter,
alte_Zufallszahl,Zufallszahl,
Unterpunkt : INTEGER;
L_Wort,e_Wort,Wort : Worttyp;
Hilfszeiger : Zeigertyp;
Sprache,ch : CHAR;
Ueben,Abbruch : BOOLEAN;
BEGIN
Unterpunkt:=Untermenue('Abfrage',''+ueg+'bung','Testen');
IF (Unterpunkt=1) OR (Unterpunkt=2) THEN
BEGIN
IF Unterpunkt=1 THEN
Ueben:=true
ELSE
Ueben:=false;
ClrScr;
Woerter:=0;
Fehler:=0;
Randomize;
r_Laenge:=Laenge;
Write(' Vokabeltrainer : ');
IF not(Ueben) THEN
Write('Abfrage')
ELSE
Write('šben');
IF Laenge>0 THEN
BEGIN
WriteLn(' Abbruch mit <ESC>');
GotoXY(10,10);
Write('Deutsch/Fremdsprache(d/f):');
Cursor_aus;
Sprache:=ReadKey;
WriteLn(Sprache);
Sprache:=UpCase(Sprache);
GotoXY(1,10);
DelLine;
IF FT_Anzeige THEN
Funktionstastenanzeige;
Window(1,10,74,12);
Cursor_ein;
Zufallszahl:=0;
Abbruch:=false;
REPEAT
Inc(Woerter);
ClrScr;
alte_Zufallszahl:=Zufallszahl;
Zufallszahl:=round(Random(r_Laenge));
IF Zufallszahl<r_Laenge THEN
Inc(Zufallszahl);
IF Zufallszahl=alte_Zufallszahl THEN
BEGIN
IF Zufallszahl<r_Laenge THEN
Inc(Zufallszahl)
ELSE IF Zufallszahl>2 THEN
Dec(Zufallszahl);
END;
IF Sprache='D' THEN
BEGIN
L_Wort:=Fremdsprache[Zufallszahl]^;
Wort:=Deutsch[Zufallszahl]^;
END
ELSE
BEGIN
L_Wort:=Deutsch[Zufallszahl]^;
Wort:=Fremdsprache[Zufallszahl]^;
END;
WriteLn(' ',Wort);
WriteLn;
Write(' ? ');
Abbruch:=Input(e_Wort,false);
IF not(Abbruch) THEN
BEGIN
IF L_Wort<>e_Wort THEN
BEGIN
ClrScr;
WriteLn(' Falsch,das Wort hei'+szett+'t: "',L_Wort,'" !');
WriteLn;
Write(' <Taste dr'+uek+'cken>');
ch:=ReadKey;
WriteLn;
Inc(Fehler);
END;
IF (L_Wort=e_Wort) or not(Ueben) THEN
BEGIN
IF L_Wort<>e_Wort THEN
Inc(Fehler);
Hilfszeiger:=Deutsch[r_Laenge];
Deutsch[r_Laenge]:=Deutsch[Zufallszahl];
Deutsch[Zufallszahl]:=Hilfszeiger;
Hilfszeiger:=Fremdsprache[r_Laenge];
Fremdsprache[r_Laenge]:=Fremdsprache[Zufallszahl];
Fremdsprache[Zufallszahl]:=Hilfszeiger;
Dec(r_Laenge);
END;
END;
UNTIL Abbruch or (r_Laenge=0);
Window(1,1,80,hoehe);
ClrScr;
GotoXY(20,10);
Write('Es gab ',Fehler,' Fehler bei ',Woerter,' W'+oek+'rtern!');
GotoXY(20,12);
Write('<Taste dr'+uek+'cken>');
ch:=ReadKey;
END
ELSE
BEGIN
GotoXY(10,10);
Write('Es befinden sich keine Vokabeln im Speicher!');
GotoXY(10,12);
Write('<Taste dr'+uek+'cken>');
ch:=ReadKey;
END;
END;
END;
FUNCTION SuchFunktion(Name:Worttyp;
VAR Vokabeln:Sprachenarraytyp):INTEGER;
VAR i : INTEGER;
BEGIN
i:=0;
REPEAT
Inc(i);
UNTIL (Name=Vokabeln[i]^) or (i>Laenge);
IF i>Laenge THEN
SuchFunktion:=0
ELSE
SuchFunktion:=i;
END;
PROCEDURE Uebersicht;
VAR Nummer : INTEGER;
BEGIN
ClrScr;
Cursor_aus;
WriteLn(' Vokabeltrainer : '+ueg+
'bersicht Abbruch mit <Esc>');
Window(1,3,80,hoehe);
Nummer:=0;
REPEAT
ClrScr;
WHILE (WhereY<=21) and (Nummer<MaxLaenge) DO
BEGIN
Inc(Nummer);
Write(Nummer:3,':',Deutsch[Nummer]^);
GotoXY(42,WhereY);
WriteLn(' ',Fremdsprache[Nummer]^);
END;
WriteLn;
Write(' <Taste dr'+uek+'cken>');
UNTIL (ReadKey=#27) or (Nummer>=Laenge);
Window(1,1,80,hoehe);
Cursor_ein;
END; { Uebersicht }
PROCEDURE Suchen;
VAR Wort : Worttyp;
Stelle,
Unterpunkt : INTEGER;
Sprache,ch : CHAR;
Abbruch : BOOLEAN;
BEGIN
Unterpunkt:=Untermenue(''+ueg+'bersetzen & '+ueg+'bersicht',
''+ueg+'bersetzen','Vokabel'+uek+'bersicht');
CASE Unterpunkt OF
1 : BEGIN
ClrScr;
Write(' Vokabeltrainer : ');
WriteLn(''+ueg+
'bersetzen Abbruch mit <ESC>');
IF FT_Anzeige THEN
Funktionstastenanzeige;
Window(1,3,74,hoehe-3);
Abbruch:=false;
REPEAT
Cursor_aus;
Write(' Wollen Sie einen deutschen oder');
WriteLn(' einen ausl'+aek+'ndischen Namen');
Write(' '+ueg+'bersetzen? (d/a) :');
Sprache:=ReadKey;
Cursor_ein;
IF (Sprache<>#13) and (Sprache<>#27) THEN
BEGIN
WriteLn(Sprache);
Sprache:=UpCase(Sprache);
WriteLn;
Write(' Vokabel:');
Abbruch:=Input(Wort,false);
END;
IF (Sprache<>#13) and (Sprache<>#27) and not(Abbruch) THEN
BEGIN
IF Sprache='F' THEN
Stelle:=SuchFunktion(Wort,Fremdsprache)
ELSE
Stelle:=SuchFunktion(Wort,Deutsch);
IF Stelle=0 THEN
WriteLn(' Wort leider nicht gefunden !')
ELSE
BEGIN
IF Sprache='F' THEN
WriteLn(' Wort:',Deutsch[Stelle]^)
ELSE
WriteLn(' Wort:',Fremdsprache[Stelle]^);
WriteLn;
Write(' '+aek+'ndern (j/n)');
ch:=ReadKey;
WriteLn(ch);
ch:=UpCase(ch);
IF ch='J' THEN
BEGIN
Write(' Deutsch:');
Abbruch:=Input(Wort,false);
IF (Wort<>'') and not(Abbruch) THEN
Deutsch[Stelle]^:=Wort;
Write(' Fremdsprache:');
Abbruch:=Input(Wort,false);
IF (Wort<>'') and not(Abbruch) THEN
Fremdsprache[Stelle]^:=Wort;
END;
END;
WriteLn;
WriteLn;
END;
UNTIL (Wort='') or (Sprache=#13) or (Sprache=#27) or Abbruch;
END;
2 : Uebersicht;
END;
END; { Suchen }
PROCEDURE Error(Speichern:BOOLEAN);
VAR ch : CHAR;
BEGIN
WriteLn;
GotoXY(8,WhereY);
Write(#7,'Fehler beim ');
IF Speichern THEN
Write('Speichern')
ELSE
Write('Laden');
Write(' der Datei!');
Cursor_aus;
ch:=ReadKey;
Cursor_ein;
ClrScr;
END;
FUNCTION LeseVerzeichnis(VAR Inhalt:Inhaltstyp):INTEGER;
VAR Dirdat : SearchRec;
Anzahl : INTEGER;
BEGIN
FOR i:=1 TO 105 DO
Inhalt[i]:='';
FindFirst(Pfad+'*.vok',AnyFile,Dirdat);
Anzahl:=0;
WHILE DosError=0 DO
BEGIN
Inc(Anzahl);
Inhalt[Anzahl]:=' '+Dirdat.Name;
WHILE Length(Inhalt[Anzahl])<14 DO
Inhalt[Anzahl]:=Inhalt[Anzahl]+' ';
FindNext(Dirdat);
END;
Leseverzeichnis:=Anzahl;
END;
FUNCTION Inhaltsmenue(Speichern:BOOLEAN):STRING;
VAR Dateianz,i,f,
akt_Datei,alte_Datei : INTEGER;
Inhalt : Inhaltstyp;
Name : STRING;
ch : CHAR;
BEGIN
Cursor_aus;
Dateianz:=LeseVerzeichnis(Inhalt);
IF Speichern THEN
BEGIN
Inhalt[Dateianz+1]:=Inhalt[1];
Inhalt[1]:=' <Neue Datei> ';
Inc(dateianz);
END
ELSE
BEGIN
Inc(Dateianz);
Inhalt[Dateianz]:='<Andere Datei>';
END;
IF Dateianz>55 THEN
f:=1
ELSE
f:=2;
FOR i:=1 TO Dateianz DO
BEGIN
GotoXY(2+((i-1) mod 5)*16,3+((i-1) div 5)*f);
Write(Inhalt[i]);
END;
akt_Datei:=1;
Schreibe_invers(Inhalt[akt_Datei],3+((akt_Datei-1) div 5)*f,
2+((akt_Datei-1) mod 5)*16);
alte_Datei:=1;
REPEAT
ch:=ReadKey;
IF ch=#0 THEN
BEGIN
ch:=ReadKey;
alte_Datei:=akt_Datei;
CASE ch OF
#72 : IF akt_Datei>5 THEN
Dec(akt_Datei,5);
#75 : IF akt_Datei>1 THEN
Dec(akt_Datei);
#77 : IF akt_Datei<Dateianz THEN
Inc(akt_Datei);
#80 : IF akt_Datei+5<=Dateianz THEN
Inc(akt_Datei,5);
ELSE
ch:=#0;
END;
IF alte_Datei<>akt_Datei THEN
BEGIN
Schreibe_invers(Inhalt[akt_Datei],3+((akt_Datei-1) div 5)*f,
2+((akt_Datei-1) mod 5)*16);
GotoXY(2+((alte_Datei-1) mod 5)*16,3+((alte_Datei-1) div 5)*f);
Write(Inhalt[alte_Datei]);
END;
END;
UNTIL (ch=#13) or (ch=#27);
Name:=Inhalt[akt_Datei];
IF ch=#13 THEN
IF (Name=' <Neue Datei> ') or (Name='<Andere Datei>') THEN
Inhaltsmenue:='@'
ELSE
BEGIN
Delete(Name,1,1);
Delete(Name,Pos('.VOK',Name)+4,12);
Inhaltsmenue:=Name;
END
ELSE
Inhaltsmenue:='';
ClrScr;
END;
PROCEDURE Speichern;
VAR Datei : TEXT;
i,Fehler : INTEGER;
Abbruch : BOOLEAN;
DateiName : STRING;
p : BYTE;
Dateiname2 : Worttyp;
BEGIN
Abbruch:=false;
WriteLn;
Write(' Vokabeltrainer : ');
WriteLn('Speichern Abbruch mit <ESC>');
Window(1,3,80,hoehe);
DateiName:=Inhaltsmenue(true);
IF Dateiname='@' THEN
BEGIN
GotoXY(20,10);
Write('Dateiname : ');
Cursor_ein;
Abbruch:=Input(Dateiname2,false);
Cursor_aus;
Dateiname:=Dateiname2;
p:=Pos('.',Dateiname);
IF p>0 THEN
Delete(Dateiname,p,4);
Dateiname:=Dateiname+'.vok';
END;
IF (Dateiname<>'') and not(Abbruch) THEN
BEGIN
Assign(Datei,Pfad+Dateiname);
Rewrite(Datei);
Fehler:=IOResult;
IF Fehler=0 THEN
BEGIN
FOR i:=1 to Laenge DO
BEGIN
WriteLn(Datei,Deutsch[i]^);
WriteLn(Datei,Fremdsprache[i]^);
END;
Close(Datei);
END
ELSE
BEGIN
Error(true);
END;
END;
Cursor_ein;
END; { Speichern }
PROCEDURE Laden(Var i:INTEGER);
VAR Datei : TEXT;
Dateiname : STRING;
Fehler : INTEGER;
Dateiname2: Worttyp;
Abbruch : BOOLEAN;
BEGIN
Abbruch:=false;
WriteLn;
Write(' Vokabeltrainer : ');
WriteLn('Laden Abbruch mit <ESC>');
Window(1,3,80,hoehe);
ClrScr;
Dateiname:=Inhaltsmenue(false);
IF Dateiname='@' THEN
BEGIN
GotoXY(10,10);
Write('Vollst'+aek+'ndiger Suchweg : ');
Cursor_ein;
Abbruch:=Input(Dateiname2,false);
Cursor_aus;
Dateiname:=Dateiname2;
END
ELSE
IF Dateiname<>'' THEN
Dateiname:=Pfad+Dateiname;
IF (Dateiname<>'') and not(Abbruch) THEN
BEGIN
Assign(Datei,Dateiname);
Reset(Datei);
Fehler:=IOResult;
IF Fehler=0 THEN
BEGIN
WHILE not(EOF(Datei)) and (i<MaxLaenge) DO
BEGIN
Inc(i);
ReadLn(Datei,Deutsch[i]^);
ReadLn(Datei,Fremdsprache[i]^);
END;
Close(Datei);
END
ELSE
Error(false);
END;
Cursor_ein;
END; { Laden }
FUNCTION Farbe_waehlen:INTEGER;
VAR i,h,v,errcode,farbcode : INTEGER;
hstr,vstr : STRING;
BEGIN
TextColor(15);
TextBackground(0);
ClrScr;
FOR i:=0 TO 15 DO
BEGIN
TextColor(15);
TextBackground(i);
Write(' Hintergrund ',i:2,' ');
TextColor(i);
TextBackground(0);
WriteLn(' Vordergrund ',i:2,' ');
END;
WriteLn;
Write('Welche Hintergrundfarbe: ');
Readln(hstr);
WriteLn;
Write('Welche Vordergrundfarbe: ');
Readln(vstr);
WriteLn;
IF hstr='' THEN h:=Hintergrundfarbe
ELSE Val(hstr,h,errcode);
IF vstr='' THEN v:=Vordergrundfarbe
ELSE Val(vstr,v,errcode);
farbcode:=h*16+v;
IF (farbcode<=0) or (farbcode>255) THEN
BEGIN
WriteLn('Fehler.Verwende weiter die bisherigen Farben.');
Write('<Taste dr'+uek+'cken>');
ch:=ReadKey;
Farbe_waehlen:=0 {Fehler}
END
ELSE
Farbe_waehlen:=farbcode;
END;
PROCEDURE Info_Einstellung;
VAR ch,Frage : CHAR;
FarbCode,Fehler,
Unterpunkt : INTEGER;
BEGIN
Fehler:=0;
Unterpunkt:=Untermenue('Info & Einstellung',
'Information','Konfiguration');
ClrScr;
CASE Unterpunkt OF
1 : BEGIN
WriteLn(' Vokabeltrainer : Info');
WriteLn;
WriteLn;
Write(' Der VOKABELTRAINER kann bis zu ',MaxLaenge);
WriteLn(' Vokabel(doppel)felder verwalten.');
WriteLn;
WriteLn(' Derzeit sind ',Laenge,' Felder belegt.');
WriteLn;
Write(' Die K'+uek+'rzel SF1 und SF2 bedeuten, dass');
WriteLn(' man [SHIFT][F1] bzw. [SHIFT][F2]');
WriteLn(' dr'+uek+'cken soll.');
Write(' '+ueg+'brigens, es k'+oek+
'nnen auch im Feld "DEUTSCH"');
WriteLn('die frz. Sonderbuchstaben');
WriteLn(' mit den Funktionstasten eingegeben werden.');
WriteLn;
Write(' <Taste dr'+uek+'cken>');
Cursor_aus;
ch:=ReadKey;
Cursor_ein;
END;
2 : BEGIN
Cursor_ein;
FarbCode:=Farbe_waehlen;
IF FarbCode>0 THEN
BEGIN
Hintergrundfarbe:=FarbCode div 16;
VordergrundFarbe:=FarbCode mod 16;
TextColor(Vordergrundfarbe);
TextBackground(Hintergrundfarbe);
END;
ClrScr;
WriteLn(' Vokabeltrainer : Konfiguration');
GotoXY(3,6);
Write('Funktionstastenanzeige (j/n) :');
Frage:=ReadKey;
WriteLn(Frage);
Frage:=UpCase(Frage);
IF Frage='N' THEN
FT_Anzeige:=false
ELSE
FT_Anzeige:=true;
GotoXY(3,9);
Write('Zeichendarstellung DOS/WIN wechseln (j/n)? :');
Frage:=ReadKey;
Write(Frage);
IF UpCase(Frage)='J' THEN
chD_komp:=not(chD_komp);
InitSonderZeichen; {Sonderzeichen anpassen}
GotoXY(3,12);
Write('Suchweg/Pfad : ');
ReadLn(Pfad);
IF Pfad<>'' THEN
IF Pfad[Length(Pfad)]<>'\' THEN
Pfad:=Pfad+'\';
GotoXY(3,15);
Write('Fensterh'+oek+'he gro'+szett+
'(g), mittel(m) oder klein(k): ');
Frage:=ReadKey;
Write(Frage);
CASE UpCase(Frage) OF
'G' : hoeheKat:=2;
'M' : hoeheKat:=1;
ELSE
hoeheKat:=0;
END;
hoehe:=25+5*hoeheKat;
GotoXY(3,18);
Write('Speichern (j/n): ');
Frage:=UpCase(ReadKey);
IF Frage='J' THEN
BEGIN
Konfiguration_speichern;
Pfad_speichern;
END;
END;
END;
END; { Info_Einstellung }
BEGIN { Hauptprogramm }
hoeheKat:=0; {80x25 Fenster}
chD_komp:=false; {auf WIN komp. voreingestellt}
SetCBreak(true);
Pfad:='';
altes_Textattribut:=TextAttr;
Hintergrundfarbe:=cyan;
Vordergrundfarbe:=black;
FT_Anzeige:=true;
Tastaturpuffer_loeschen;
ClrScr;
Writeln;
Cursor_aus;
WriteLn('Pfad und Konfigration laden (j/n) ? Standard = j');
j:=0;
Cursor_ein;
REPEAT
write('.');
inc(j);
delay(50);
UNTIL KeyPressed or (j>48);
IF KeyPressed THEN
ch:=ReadKey;
IF UpCase(ch)<>'N' THEN
BEGIN
Pfad_laden;
Konfiguration_laden;
END;
hoehe:=25+hoeheKat*5;
InitSonderZeichen;
i:=0;
WHILE i<1000 DO
BEGIN
Inc(i);
New(Deutsch[i]);
New(Fremdsprache[i]);
END;
MaxLaenge:=i;
Laenge:=0;
FOR i:=1 TO MaxLaenge DO
BEGIN
Deutsch[i]^:='';
Fremdsprache[i]^:='';
END;
Punkt:=1;
REPEAT
Window(1,1,80,hoehe);
WHILE KeyPressed DO
ch:=ReadKey;
Punkt:=Menue(MText,Zeilenanzahl,Punkt,3,4,true);
ClrScr;
CASE Punkt OF
1 : Info_Einstellung;
2 : Eingabe(Laenge);
3 : Abfrage;
4 : Suchen;
5 : Speichern;
6 : Laden(Laenge);
7 : Loeschen;
ELSE
Cursor_aus;
Tastaturpuffer_loeschen;
GotoXY(10,12);
Write('Wollen Sie das Programm wirklich beenden (j/n) ?');
Beenden:=UpCase(ReadKey);
IF Beenden<>'J' THEN
Punkt:=1;
Cursor_ein;
END;
UNTIL (Punkt>=Zeilenanzahl) or (Punkt<1);
TextAttr:=altes_TextAttribut;
ClrScr;
END.