Benutzer:FbNutzer/FreePascalThemen

Aus Wikibooks
Zur Navigation springen Zur Suche springen

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.