PROGRAM chartgrafik;
{ written 1989,1990 by Frank Riemenschneider
                       Postfach 730309
                       3000 Hannover 71           }

{$I-}
     {Pr�fung I/O vom Programm, nicht vom Compiler}

{$N+}
     {Coprozessor 8087 - Befehle erzeugen}
{$E+}
     {Emulator einschalten, weil kein Coprozessor
      installiert ist.}

{-------------------------------------------------------------}
{-------------- Beginn des Modifizierteils !!! ---------------}
{-------------------------------------------------------------}

uses dos,printer,portcrt,portgraf;

{$M 10000,5500,5500}
        {10000 Bytes Stack, Heap  5500 Bytes}

CONST
 maxsaetze : word = 50;     {maximal ladbare Zahl Datens„tze}
 maxbloecke : byte = 20;    {maximal ladbare Zahl Datenbl”cke}
 graphpath : string = 'c:\tp\grafik\';    {Pfad zur Grafik-Unit}

TYPE
 datensatz = record
   satz  : array[0..50] of string[5];

   {Untertitel Datens„tze z.B. 'Jan85' f�r Umsatz Januar 1985}

   block : array[0..20] of string[10];

   {Untertitel Datenbl”cke z.B. 'Erdinger' f�r eine
   sehr gut schmeckende Weiábiersorte !}

   zahlen: array[0..20,0..50] of single;

   {Eigentliche Daten, z.B. Umsatzzahlen}
 END;

 blockzahl = array[1..20] of word;
 satzladezahl = array[1..50] of word;

{-------------------------------------------------------------}
{--------------- Ende des Modifizierteils !!! ----------------}
{-------------------------------------------------------------}

CONST
 maxdatablock : word = 100;     {maximale Blockzahl in Datei}
 hardcopy : array[0..1] of string[4] = ('Ja  ','Nein');
 fullstern : string[39] =
  '***************************************';
 randstern : string[1] = '*';
 datenmenue : array[1..3] of string = ('Datei einrichten','Daten laden',
                                       'Daten eingeben');
 grafikmenue : array[1..5] of string = ('Balkengrafik h','Balkengrafik v',
                                        'S„ulengrafik','Tortengrafik 2d',
                                        'Tortengrafik 3d');
 hauptmenue : array[1..4] of string = ('Datenmen�','Grafikmen�',
                                       'Druckstatus','Programmende');

TYPE
 blockdata = array[1..100] of string[10];

VAR
 daten : ^datensatz;            {Insgesamt nur 16 (!) globale
                                 Variablen}
 hpunkt,punkt,druck : byte;
 s : string;
 i,j,k,loadblock : word;
 loadsatz : longint;
 eblo,anzbl,esa,anzsa : word;
 letztpfad : string[25];       {letzter eingegebener Pfad}
 letztname : string[8];   {letzter eingegebener Dateiname}
 input : char;

{-------------------------------------------------------------}
{--------------- U N T E R P R O G R A M M E  ----------------}
{-------------------------------------------------------------}

{--- Texteingabe : Bildschirmeingabe eines Textes          ---}
{--- Eingabe: Stringvariable, Koordinatenpaar              ---}
{---          x,y (0..79,0..24), maximale L„nge,           ---}
{---          Status (0=nur numerische Zeichen,1=alle),    ---}
{---          Voreinstellung                               ---}
{--- Ausgabe : String in Variable ss                       ---}

procedure Eingabe(VAR ss : string ; x,y,maxlaenge,
                  numerisch : byte; vs: string);
VAR taste : byte;
laenge : byte;
i : byte;
flag : boolean;
BEGIN
  GotoXY(x,y);
  write(vs);
  GotoXY(x,y);
  ss := '';
  laenge := 0;
  flag := true;
  REPEAT
    REPEAT
    UNTIL Keypressed;
    taste := Ord(ReadKey);               {ASCII-Code holen}
    IF flag THEN BEGIN
      IF taste <> 13 THEN BEGIN
        FOR i:= 1 to length(vs) DO BEGIN
          write(' ');
        END;
        GotoXY(x,y);
      END
      ELSE BEGIN
        ss := vs;
      END;
    END;
    flag := false;
    CASE taste of

      {Bei numerischen Zeichen (0,..,9, -,+,.) hier beginnen}

      43,46,48..57 : BEGIN
                      IF laenge < maxlaenge THEN BEGIN
                        inc(x);
                        inc(laenge);
                        write(chr(taste));
                        ss := ss + chr(taste);
                      END;
                     END;

      {Bei anderen Zeichen (a,..,z,A,..,Z,\,[,],(,),!,"
       ,$,%,*,Leer) hier beginnen}

      32..47,58..93,97..154 : BEGIN
                      IF ((laenge < maxlaenge) and
                          (numerisch <>0)) THEN BEGIN
                        inc(x);
                        inc(laenge);
                        write(chr(taste));
                        ss := ss + chr(taste);
                      END;
                     END;

    {Hier beginnen, wenn Backspace gedr�ckt. (šber Scan-Code)}

         8   : BEGIN
                 IF laenge > 0 THEN BEGIN
                   dec(x);
                   dec(laenge);
                   GotoXY(x,y);           {Letztes Zeichen l”schen}
                   write(' ');
                   GotoXY(x,y);
                   ss := copy(ss,1,Length(ss)-1);
                 END;
               END;
    END;

  UNTIL taste = 13;         {Abschluá mit RETURN}
  writeln;
END;

{--- Standardbild : Hintergrundbildschirm aufbauen         ---}
{--- Eingabe : Keine                                       ---}
{--- Ausgabe : Keine                                       ---}

procedure Standardbild;
VAR i : byte;
BEGIN
   ClrScr;
   write('******* M & T  C H A R T  V 1.1 *******');
   GotoXY(0,0);
   FOR i := 1 to 6 DO BEGIN
    GotoXY(0,i);
     write(randstern);
     GotoXY(38,i);
     write(randstern);
   END;
   GotoXY(0,7);
   write(fullstern);
END;

{--- Fehler : Fehlermeldung ausgeben                       ---}
{--- Eingabe: Meldung (String)                             ---}
{--- Ausgabe : Keine                                       ---}

procedure fehler(s : string);
BEGIN
   Standardbild;
   GotoXY(2,2);
   write(s);
   GotoXY(2,4);
   write('Weiter mit <RETURN> .....');
   readln;
END;


{--- Einrichten : Datei einrichten (beliebig groá)         ---}
{--- Eingabe: Keine                                        ---}
{--- Ausgabe : Keine                                       ---}

procedure Einrichten;
VAR bloecke: word;
s,laenge : string;
drive : byte;
platz,maxsatz,saetze : longint;
block : blockdata;
i,j,k : longint;
f : file;
code : integer;
CONST
dummyzahl : single = 3006.1965;       {Geburtsdatum des Autors}
dummystring : string[5] = 'FMRIE';    {Initialien desselben   }

BEGIN
  Standardbild;
  GotoXY(2,2);
  write('Datenbl”cke (1-',maxdatablock,') : <     >');
  str(maxdatablock,laenge);
  REPEAT
    Eingabe(s,22+length(laenge),2,5,0,'');
    val(s,bloecke,code);
  UNTIL ((bloecke >=1) and (bloecke <=maxdatablock));
  FOR i:= 1 to bloecke DO BEGIN
    GotoXY(2,4);
    write('Datenblock Nummer ',i);
    GotoXY(2,5);
    write('Untertitel : <          >');
    Eingabe(s,16,5,10,1,'');
    block[i] := s;
  END;
  Standardbild;
  GotoXY(2,2);
  write('Laufwerk und Pfadname :');
  GotoXY(2,3);
  write('<                         >');
  Eingabe(s,3,3,25,1,letztpfad);
  IF copy(s,length(s),1) <> '\' THEN s := s + '\';
  drive := ord(UpCASE(s[1]))-64;
  platz := DiskFree(drive);
  platz := platz - Round(platz/100);            {1 % Reserve}
  IF platz > ((bloecke*11)+6) THEN BEGIN            {Zeile 1}

  {Anzahl Datens„tze berechnen : Vorhandene Speicherkapazit„t
  insgesamt : platz. In der Info-Datei belegt jeder Datenblock
  11 Bytes (Stringl„nge = 10 plus 1 Byte L„nge des Strings).
  Weiterhin je 6 Bytes f�r die Anzahl der Datenbl”cke und
  Datens„tze (word+longint = 6 Bytes) = 12 Bytes. Der Rest
  des Speichers steht f�r die Hauptdatei zur Verf�gung und wird
  durch die Anzahl der Datenbl”cke geteilt, wobei pro Datensatz
  noch 6 Bytes f�r den Untertitel (5 plus 1 L„ngenbyte)
  reserviert werden m�ssen.}

    letztpfad := s;
    maxsatz := Trunc((platz-bloecke*11-6)/(6+bloecke*4));
    GotoXY(2,5);
    write('Datens„tze (1-',maxsatz,') : <          >');
    str(maxsatz,laenge);
    REPEAT
      Eingabe(s,21+length(laenge),5,10,0,'');
      val(s,saetze,code);
    UNTIL ((saetze >=1) and (saetze <=maxsatz));
    Standardbild;
    GotoXY(2,2);
    write('Dateiname : <        >');
    Eingabe(s,15,2,8,1,letztname);
    letztname := s;

    {Ab hier wird die Info-Datei erstellt}

    Assign(f,chr(drive+64)+':'+s+'.inf');
    rewrite(f,1);
    IF IOResult = 0 THEN BEGIN                        {Zeile 2}
      GotoXY(2,4);
      write('Info-Datei');
      blockwrite(f,bloecke,2);   {Anzahl Datenbl”cke schreiben}
      k := IOResult;
      IF k = 0 THEN BEGIN
        blockwrite(f,saetze,4);   {Anzahl Datens„tze schreiben}
        k := IOResult;
      END;
      i := 1;
      WHILE ((k = 0) and (i<= bloecke)) DO BEGIN
        GotoXY(15,4);
        write('Block ',i);
        blockwrite(f,block[i],11);
        k := IOResult;             {Block-Untertitel schreiben}
        inc(i);
      END;
      close(f);
      IF k=0 THEN BEGIN                              {Zeile 3}

      {Ab hier wird die Hauptdatei erstellt}

        Assign(f,chr(drive+64)+':'+s+'.dat');
        rewrite(f,1);
        k := IOResult;
        If k = 0 THEN BEGIN                           {Zeile 4}
          GotoXY(2,4);
          write('Haupt-Datei');
          i := 1;
          WHILE ((k = 0) and (i<= saetze)) DO BEGIN
            GotoXY(15,4);
            write('Datensatz : ',i);
            blockwrite(f,dummystring,6);
            k := IOResult;
            inc(i);                {Dummy-Untertitel schreiben}
            j := 1;
            WHILE ((k = 0) and (j <= bloecke)) DO BEGIN
              str(j,s);
              GotoXY(15,5);
              write('Datenblock :     ');
              GotoXY(31-length(s),5);
              write(j);
              blockwrite(f,dummyzahl,4);
              k := IOResult;
              inc(j);                  {Dummy-Zahlen schreiben}
            END;
          END;
          close(f);
          IF k<>0 THEN fehler('Fehler beim Schreiben der Hauptdatei !');
        END                                       {von Zeile 4}
        ELSE BEGIN
          fehler('Fehler beim ™ffnen der Hauptdatei !');
        END;
      END                                         {von Zeile 3}
      ELSE BEGIN
        fehler('Fehler beim Schreiben der Info-Datei !');
      END;
    END                                           {von Zeile 2}
    ELSE BEGIN
      fehler('Fehler beim ™ffnen der Info-Datei !');
    END;
  END                                             {von Zeile 1}
  ELSE BEGIN
    fehler('Kein Platz auf Laufwerk '+s[1]+':  !');
  END;
END;

{--- Scroll : Bildschirmausschnitt nach oben/unten rollen  ---}
{--- Eingabe: Interruptnummer,Zeile f�r Ausgabe,           ---}
{---          nachr�ckende Ausgabe, Zeile f�r Pfeil        ---}
{--- Ausgabe : Keine                                       ---}

procedure scroll(Intnr,zeile : byte; block : string;
                 pfeil : byte);
VAR reg : registers;
BEGIN
  reg.ch := 2;         {Zeile linke,obere Ecke}
  reg.cl := 3;         {Spalte linke,obere Ecke}
  reg.dh := 5;         {Zeile untere,rechte Ecke}
  reg.dl := 20;        {Spalte untere,rechte Ecke}
  reg.bh := 7;         {Leerzeilen in Hintergrundfarbe}
  reg.al := 1;         {Anzahl Zeilen, um die gesrollt wird}
  reg.ah := Intnr;     {nach oben = 6, nach unten = 7}
  Intr(16,reg);        {Interrupt hex. 10, Funktion 6/7,
                        im PC INTERN auf Seite 925/926}
  GotoXY(3,zeile);     {Nachr�ckende Zeile ausgeben}
  write(block);
  GotoXY(2,pfeil);
  write('>');
END;

{--- waehlen : Datenbl”cke aus Liste ausw„hlen             ---}
{--- Eingabe:  Anzahl vorhandener Datenbl”cke,             ---}
{---           Datenblocknamen, gewaehlte Bl”cke,          ---}
{---           maximale Anzahl waehlbare Datenbloecke      ---}
{--- Ausgabe : Anzahl gewaehlter Datenbloecke              ---}
function waehlen(bloecke : word; block : blockdata;
         VAR blocknummer : blockzahl; maxblock : word) : word;
VAR
zahl,pos,ya :  word;
wahl : byte;
i,j,k : word;
gewaehlt : blockdata;
BEGIN
   FOR i:= 1 to bloecke DO BEGIN  {Alle Bl”cke nicht gew„hlt}
     gewaehlt[i] := ' ';
   END;
   zahl := 0;
   Standardbild;
   FOR i := 2 to 5 DO BEGIN
     GotoXY(34,i);
     write('[  ]');
   END;
   IF bloecke < 4 THEN BEGIN
      k := bloecke;
   END
   ELSE BEGIN
      k := 4;
   END;
   j := 1;                 {erster angezeigter Datenblock}
   pos := 0;               {Position des Auswahlpfeiles}
   ya := 2;
   FOR i := j to k DO BEGIN     {erste Bl”cke ausgeben}
     GotoXY(3,1+i);
     writeln(gewaehlt[i]+block[i]);
   END;
   GotoXY(2,2);
   write('>');
   REPEAT
     GotoXY(35,2+Trunc(j/((bloecke-3)/3)));
     write('<>');
     wahl := Ord(ReadKey);

     {Wenn Block gew„hlt, dann als nicht gew„hlt kennzeichnen}

     IF wahl=32 THEN BEGIN
       IF gewaehlt[j+pos] = '*' THEN BEGIN
          gewaehlt[j+pos] := ' ';
          dec(zahl);
       END

      {Wenn Block noch nicht ausgew„hlt, dann ausw„hlen}

       ELSE BEGIN
          IF zahl<maxblock THEN BEGIN
            gewaehlt[j+pos] := '*';
            inc(zahl);
          END;
       END;
       GotoXY(3,ya);
       write(gewaehlt[j+pos]+block[j+pos]);
     END;
     IF wahl = 0 THEN BEGIN
       wahl := Ord(readKey);
       GotoXY(35,2+Trunc(j/((bloecke-3)/3)));
       write('  ');
       CASE wahl of

       {Hier fortfahren, wenn Cursor rauf gedr�ckt wurde}

         $48 : BEGIN
                IF pos > 0 THEN BEGIN
                  GotoXY(2,ya);
                  write(' ');
                  dec(ya);          {kein Scrollen, nur}
                  dec(pos);         {Auswahlpfeil wandert}
                  GotoXY(2,ya);
                  write('>');
                END
                ELSE BEGIN              {Scrollen erforderlich}
                  IF j>1 THEN BEGIN
                    scroll(7,2,gewaehlt[j-1]+block[j-1],ya);
                    dec(j);
                  END;
                END;
               END;

         {Hier fortfahren, wenn Cursor runter gedr�ckt wurde}

         $50 : BEGIN
                IF pos < k-1 THEN BEGIN
                  GotoXY(2,ya);
                  write(' ');
                  inc(ya);                   {Kein Scrollen, nur}
                  inc(pos);                {Auswahlpfeil wandert}
                  GotoXY(2,ya);
                  write('>');
                END
                ELSE BEGIN                {Scrollen erforderlich}
                  IF j+3<bloecke THEN BEGIN
                    scroll(6,5,gewaehlt[j+4]+block[j+4],ya);
                    inc(j);
                  END;
                END;
               END;

         {Hier fortfahren, wenn Bild hoch gedr�ckt wurde}

         $49 : BEGIN
                IF j > 4 THEN BEGIN
                  j := j-4;
                  FOR i := j to j+3 DO BEGIN     {erste Bl”cke ausgeben}
                    GotoXY(3,2+i-j);
                    writeln(gewaehlt[i]+block[i]+'           ');
                  END;
                  GotoXY(2,ya);
                  write('>');
                END;
               END;

         {Hier fortfahren, wenn Bild runter gedr�ckt wurde}

         $51 : BEGIN
                 IF j+3 < bloecke-3 THEN BEGIN
                   j := j+4;
                   FOR i := j to j+3 DO BEGIN     {erste Bl”cke ausgeben}
                      GotoXY(3,2+i-j);
                      writeln(gewaehlt[i]+block[i]+'           ');
                   END;
                   GotoXY(2,ya);
                   write('>');
                 END;
              END;

          END;
     END;

   UNTIL wahl = 13;        {RETURN schlieát Auswahl ab}

 {Hier werden die ausgew„hlten Blocknummern festgelegt}

 IF zahl>0 THEN BEGIN
   j := 1;
   FOR i:= 1 to bloecke DO BEGIN
     IF gewaehlt[i] = '*' THEN BEGIN
       blocknummer[j] := i;
       daten^.block[j] := block[i];
       inc(j);
     END;
   END;
 END;

 Standardbild;
 waehlen := zahl;
END;

{--- Kopf : Miniatur-Men� f�r Procedur 'Eingeben' aufbauen ---}
{--- Eingabe: Keine                                        ---}
{--- Ausgabe : Keine                                       ---}

procedure Kopf(flag : boolean);
CONST s : string[16] = '<N> <V> <+> <-> ';
BEGIN
  Standardbild;
  GotoXY(2,1);
  CASE flag of
    false : write(s+'<E> <A>');
    true  : write(s+'<E> <R> <A>');
  END;
END;

{--- Leerweg : Entfernen von Leerzeichen an Stringanf„ngen ---}
{--- Eingabe : String mit Leerzeichen                      ---}
{--- Ausgabe : String ohne Leerzeichen                     ---}

function Leerweg(s:string) : string;
BEGIN
  WHILE Copy(s,1,1) = ' ' DO BEGIN
    s := Copy(s,2,Length(s)-1);
  END;
  Leerweg := s;
END;

{--- Einladen : Daten eingeben/Daten laden                ---}
{--- Eingabe: Flag eingeben=false,laden=true              ---}
{--- Ausgabe : Keine                                      ---}

procedure Einladen(flag : boolean);
VAR bloecke,anzahl,IO : word;
s,laenge,ss : string;
s1 : char;
saetze,erster,letzter : longint;
block : blockdata;
blocknummer : blockzahl;
geladen : satzladezahl;
i,j,k : longint;
f : file;
code : integer;
dummystring : string[5];
dummyzahl : single;
taste : byte;

BEGIN
    FOR i:= 1 to maxsaetze DO BEGIN
      geladen[i] := 0;
    END;
    Standardbild;
    GotoXY(2,2);
    write('Laufwerk und Pfadname :');
    GotoXY(2,3);
    write('<                         >');
    Eingabe(s,3,3,25,1,letztpfad);
    IF copy(s,length(s),1) <> '\' THEN s := s + '\';
    letztpfad := s;
    GotoXY(2,5);
    write('Dateiname : <        >');
    Eingabe(ss,15,5,8,1,letztname);
    letztname := ss;
    Assign(f,s+ss+'.inf');
    reset(f,1);
    IF IOResult = 0 THEN BEGIN                        {Zeile 1}

    {Info-Datei auslesen}

      blockread(f,bloecke,2);
      k := IOResult;
      IF k=0 THEN BEGIN
        blockread(f,saetze,4);
        k := IOResult;
      END;
      i := 1;
      WHILE ((k=0) and (i <= bloecke)) DO BEGIN
        blockread(f,block[i],11);
        k := IOResult;
        inc(i);
      END;
      close(f);
      Assign(f,s+ss+'.dat');
      IF k = 0 THEN BEGIN                             {Zeile 2}
        loadblock := 0;
        IF flag THEN loadblock := waehlen(bloecke,block,
                                blocknummer,maxbloecke);
        Standardbild;
        GotoXY(2,2);
        write('1. Datensatz (1-',saetze,') :');
        str(saetze,laenge);
        GotoXY(22+length(laenge),2);
        write('<         >');
        REPEAT
          Eingabe(s,23+length(laenge),2,9,0,'1');
          val(s,erster,code);
        UNTIL ((erster >=1) and (erster <=saetze));
        reset(f,1);
        If IOResult = 0 THEN BEGIN
          loadsatz := 0;
          i := erster;
          Kopf(flag);
          REPEAT

   {Position f�r Anfang eines bestimmten Datensatzes der
    Datei berechnen: Pro Datensatz 6 Bytes f�r Untertitel
    und je 4 Bytes pro Wert jedes Datenblocks. Also : Pro
    Datensatz existieren (6+4*Bl”cke) Bytes.}

            seek(f,(6+4*bloecke)*(i-1));
            blockread(f,dummystring,6);
            IO := IOResult;
            IF IO = 0 THEN BEGIN
              IF flag THEN BEGIN
                FOR k:= 1 to loadsatz DO BEGIN
                  IF geladen[k] = i THEN dummystring := 'Load';
                END;
                GotoXY(2,2);
                write('Ladbare Datens„tze :           ');
                GotoXY(25,2);
                write(maxsaetze-loadsatz);
              END;
              GotoXY(2,3);
              write('Datensatz ',i,' : ',dummystring,'        ');
              taste := Ord(ReadKey);
              CASE UpCASE(chr(taste)) of
                '+' : IF i<(saetze-9) THEN i:= i+10;
                '-' : IF i>10 THEN i:= i-10;
                'N' : IF i<saetze THEN inc(i);
                'V' : IF i>1 THEN dec(i);
                'E' : BEGIN
                       IF not flag THEN BEGIN
                         j := 1;
                         WHILE ((j<=bloecke) and (IO=0)) DO BEGIN

   {Position f�r Anfang eines bestimmten Datenblocks eines
    bestimmten Datensatzes der Datei berechnen: Pro Datensatz
    existieren (6+4*Bl”cke) Bytes (s.o.). Zu dem Anfang des
    Datensatzes m�ssen noch f�r jeden Datenblock 4 Bytes
    hinzugez„hlt werden (Single-Zahl), sowie 6 Bytes f�r den
    Untertitel.}

                           seek(f,((6+4*bloecke)*(i-1))+
                                    (6+(j-1)*4));
                           blockread(f,dummyzahl,4);
                           IO := IOResult;
                           IF IO = 0 THEN BEGIN
                             GotoXY(2,4);
                             write('                              ');
                             GotoXY(2,4);
                             write(block[j],' = ',dummyzahl:12:4);
                             GotoXY(2,5);
                             write('Neuer Wert :',
                                 ' <               >');
                             str(dummyzahl :16:4,ss);
                             Eingabe(s,16,5,15,0,Leerweg(ss));
                             val(s,dummyzahl,code);
                             IF s<>'' THEN BEGIN
                                seek(f,((6+4*bloecke)*(i-1))+
                                    (6+(j-1)*4));
                                blockwrite(f,dummyzahl,4);
                                IO := IOResult;
                             END;
                             inc(j);
                           END;
                         END;             {von WHILE}
                         IF IO = 0 THEN BEGIN
                           GotoXY(2,4);
                           write('                              ');
                           GotoXY(2,5);
                           write('Neuer Titel : <     >          ');
                           Eingabe(s,17,5,5,1,dummystring);
                           IF s<>'' THEN BEGIN
                             seek(f,(6+4*bloecke)*(i-1));
                             blockwrite(f,s,6);
                             IO := IOResult;
                           END;
                           GotoXY(2,4);
                           write('                        ');
                           GotoXY(2,5);
                           write('                        ');
                         END;
                         IF IO<>0 THEN BEGIN
                           Standardbild;
                           GotoXY(2,2);
                           write('Fehler bei Zugriff auf Hauptdatei !');
                           taste := Ord('A');
                           readln;
                         END;
                       END     {von Flag}

                       ELSE BEGIN
                         IF ((loadsatz < maxsaetze) and
                          (dummystring <> 'Load')) THEN BEGIN
                           inc(loadsatz);
                           geladen[loadsatz] := i;
                           j := 1;
                           WHILE ((j<=loadblock) and (IO = 0)) DO BEGIN
                             seek(f,((6+4*bloecke)*(i-1))
                                 +(6+((blocknummer[j]-1)*4)));
                             blockread(f,daten^.zahlen
                                       [j,loadsatz],4);
                             IO := IOResult;
                             inc(j);
                           END;
                           IF IO = 0 THEN BEGIN
                             seek(f,((6+4*bloecke)*(i-1)));
                             blockread(f,daten^.satz[loadsatz],6);
                             IO := IOResult;
                           END;
                           IF IO <>0 THEN BEGIN
                              loadblock := 0;
                              GotoXY(2,4);
                              write('Fehler bei Zugriff auf Hauptdatei !');
                              GotoXY(2,5);
                              write('    Weiter mit <RETURN>.');
                              taste := Ord('A');
                              readln;
                           END;
                         END;
                       END;
                      END;
                'R' : IF ((flag) and (loadsatz < maxsaetze)
                      and (dummystring <> 'Load')) THEN BEGIN
                       GotoXY(2,5);
                       letzter := maxsaetze-loadsatz;
                       IF (i + letzter-1) > saetze THEN
                         letzter := saetze-i+1;
                       write('Anzahl (1-',letzter,') :');
                       GotoXY(21,5);
                       write('<         >');
                       REPEAT
                         Eingabe(s,22,5,9,1,'');
                         val(s,anzahl,code);
                       UNTIL ((anzahl >=1) and
                             (anzahl <=letzter));
                       k := i;
                       WHILE ((k <= i+anzahl-1) and (IO=0)) DO BEGIN
                         dummystring := '';
                         FOR j:= 1 to loadsatz DO BEGIN
                           IF geladen[j] = k THEN
                             dummystring := 'Load';
                         END;
                         IF dummystring <> 'Load' THEN BEGIN
                           inc(loadsatz);
                           GotoXY(22,5);
                           write('         ');
                           GotoXY(22,5);
                           write(anzahl+i-k);
                           GotoXY(25,2);
                           write('          ');
                           GotoXY(25,2);
                           write(maxsaetze-loadsatz);
                           geladen[loadsatz] := k;
                           j := 1;
                           WHILE ((j<= loadblock) and (IO = 0)) DO BEGIN
                             seek(f,((6+4*bloecke)*(k-1))
                                 +(6+((blocknummer[j]-1)*4)));
                             blockread(f,daten^.zahlen
                                       [j,loadsatz],4);
                             IO := IOResult;
                             inc(j);
                           END;
                           IF IO = 0 THEN BEGIN
                             seek(f,((6+4*bloecke)*(k-1)));
                             blockread(f,daten^.satz[loadsatz],6);
                             IO := IOresult;
                           END;
                           IF IO <>0 THEN BEGIN
                              loadblock := 0;
                              GotoXY(2,4);
                              write('Fehler beim Lesen aus Hauptdatei !');
                              GotoXY(7,5);
                              write('Weiter mit <RETURN>.           ');
                              taste := Ord('A');
                              readln;
                           END;
                         END;
                         inc(k);
                       END;
                       GotoXY(2,5);
                       write('                                 ');
                      END;
              END;
              IF taste=0 THEN taste := Ord(ReadKey);
           END
           ELSE BEGIN
             loadblock := 0;
             fehler('Fehler bei Zugriff auf Hauptdatei !');
             taste := Ord('A');
           END;

          UNTIL (UpCASE(chr(taste)) = 'A');
          IF IO = 0 THEN close(f);
        END
        ELSE BEGIN
          fehler('Fehler beim ™ffnen der Hauptdatei !');
        END;
      END                                         {von Zeile 2}
      ELSE BEGIN
        fehler('Fehler beim Lesen der Info-Datei !');
      END;
    END                                           {von Zeile 1}
    ELSE BEGIN
      fehler('Fehler beim ™ffnen der Info-Datei !');
    END;
END;

{--- Grafinit : Initialisiert Pixelgrafik                  ---}
{--- Eingabe : Keine                                       ---}
{--- Ausgabe : X-Koordinate Bildschirmmitte                ---}

function Grafinit : word;
VAR
  GraphDriver, GraphMode : Integer;
BEGIN
 GraphDriver := 4;                   {EGA-Karte mit 64 KB RAM}
 GraphMode := 1;                     {640 * 350 Grafikpunkte}
 Grafinit := 120;
 InitGraph(graphdriver,graphmode,graphpath);
 SetColor(15);
END;

{--- BeschrTorte : Beschriftung der Tortendiagramme        ---}
{--- Eingabe: Ausgabetext, Zaehler, Tortenst�ckanteil      ---}
{--- Ausgabe : Keine                                       ---}

procedure beschrtorte(ss : string; zaehler : word; anteil : single);
VAR xm,ym : integer;
s : string;
BEGIN
     ym := 4+16*(zaehler-Trunc(zaehler/4)*4);
     xm := 75*(Trunc(zaehler/4));
     s := Copy(ss,1,10);
     OutTextXY(xm+12,ym-4,s);
     str(zaehler+1,s);
     OutTextXY(xm,ym,s+'=');
     str(Trunc((anteil/3.6)*10+0.5)/10:4:1,s);
     s := Leerweg(s);
     OutTextXY(xm+12,ym+4,s+' %');
END;

{--- Kuchendiagramm : Aufbau der 2-D-Tortengrafik          ---}
{--- Eingabe: erster Datensatz,letzter Datensatz,          ---}
{---          erster Datenblock, letzter Datenblock        ---}
{--- Ausgabe : Keine                                       ---}

procedure Kuchendiagramm(edb,ldb : word; eds,lds : byte);
VAR xmitte : word;
anteil,summe,halbierende : single;
startwinkel,endwinkel,mittelwinkel,xm,ym : Integer;
s : string;
zaehler,i,j,k : word;
CONST
 ymitte : word = 32;      {Mittelpunkt y-Koordinate}
 xradius : word = 35;     {X-Radius EGA-Grafik}
 verh : single = 0.70;    {Verh„ltnis Y-Radius zu X-Radius}
 expl : word = 8;         {Um soviel Punkte werden die
                           Tortenst�cke rausgezgen}
BEGIN
 xmitte := Grafinit+75;
 summe := 0;
 FOR i:= edb to ldb DO BEGIN
   FOR j := eds to lds DO BEGIN
    summe := daten^.zahlen[i,j] + summe;
   END;
 END;
 startwinkel := 0;
 SetFillStyle(1,15);
 zaehler := 0;

 FOR i:= edb to ldb DO BEGIN
   FOR j := eds to lds DO BEGIN
     anteil := (daten^.zahlen[i,j]/summe)*360;
     endwinkel := startwinkel + Round(anteil);
     IF endwinkel > 360 THEN endwinkel := 360;
     mittelwinkel := Round((startwinkel+endwinkel)/2);
     xm := Round (xmitte+expl*cos(mittelwinkel*PI/180));
     ym := Round(ymitte - expl*verh*sin(mittelwinkel*PI/180));

     sector(xm,ym,Startwinkel,Endwinkel,xradius,Round(verh*xradius));

     halbierende := ((endwinkel+startwinkel)/2)*PI/180;
     IF eds = lds THEN BEGIN
       s := daten^.block[i];
     END
     ELSE BEGIN
       s := daten^.satz[j];
     END;
     beschrtorte(s,zaehler,anteil);
     inc(zaehler);
     startwinkel := endwinkel;
   END;
 startwinkel := endwinkel;
 END;
END;

{--- Tortendiagramm : Aufbau der 3-D-Tortengrafik          ---}
{--- Eingabe: erster Datensatz,letzter Datensatz,          ---}
{---          erster Datenblock, letzter Datenblock        ---}
{--- Ausgabe : Keine                                       ---}

procedure Tortendiagramm(edb,ldb : word; eds,lds : byte);
VAR xmitte : word;
anteil,summe,halbierende : single;
zaehler,startwinkel,endwinkel,untenwinkel,xm,ym : word;
i,j,k : word;
CONST
 ymitte : word = 23;     {Mittelpunkt y-Koordinate}
 xradius : word = 40;    {X-Radius EGA-Grafik}
 verh : single = 0.60;   {Verh„ltnis Y-Radius zu X-Radius EGA}
 offset : word = 15;     {Dicke der Torte}
BEGIN
 xmitte := Grafinit+75;
 summe := 0;
 FOR i:= edb to ldb DO BEGIN
   FOR j := eds to lds DO BEGIN
    summe := daten^.zahlen[i,j] + summe;
   END;
 END;
 startwinkel := 0;
 zaehler := 0;
 ellipse(xmitte,ymitte,0,180,xradius,Round(xradius*verh));
 ellipse(xmitte,ymitte+offset,180,360,xradius,Round(xradius*verh));
 line(xmitte+xradius,ymitte,xmitte+xradius,ymitte+offset);
 line(xmitte-xradius,ymitte,xmitte-xradius,ymitte+offset);
 line(xmitte,ymitte,xmitte+xradius,ymitte);
 SetFillStyle(1,15);
 zaehler := 0;

 FOR i:= edb to ldb DO BEGIN
   FOR j := eds to lds DO BEGIN
     anteil := (daten^.zahlen[i,j]/summe)*360;
     endwinkel := startwinkel + Round(anteil);
     IF ((i <>ldb) or (j<>lds)) THEN BEGIN
       xm := xmitte+Round(xradius*cos(endwinkel*PI/180));
       ym := ymitte-Round(verh*xradius*sin(endwinkel*PI/180));
       line (xmitte,ymitte,xm,ym);
       IF (endwinkel >180) THEN line (xm,ym,xm,ym+offset);
     END;
     halbierende := ((endwinkel+startwinkel)/2)*PI/180;
     IF eds = lds THEN BEGIN
       s := daten^.block[i];
     END
     ELSE BEGIN
       s := daten^.satz[j];
     END;
     beschrtorte(s,zaehler,anteil);
     inc(zaehler);
     IF Round((i+j-eds-edb+1)/2) = (i+j-eds-edb+1)/2 THEN BEGIN
       FloodFill(xmitte+Round(xradius*cos(halbierende)/2),
               ymitte-Round(verh*xradius*sin(halbierende)/2),15);
       IF endwinkel > 180 THEN BEGIN
          SetColor(0);
          IF startwinkel < 180 THEN startwinkel := 180;
          ellipse(xmitte,ymitte,startwinkel,endwinkel,
                  xradius,Round(xradius*verh));
          SetColor(15);
       END;
     END
     ELSE BEGIN
       IF endwinkel > 180 THEN ellipse(xmitte,ymitte,
            startwinkel,endwinkel,xradius,Round(xradius*verh));
     END;
     startwinkel := endwinkel;
   END;
 startwinkel := endwinkel;
 END;
END;

{--- Balkenplot : Zeichnet die 2-D-Balken                  ---}
{--- Eingabe: Zeichenmasstab,Balkenh”he,Startkoordinaten,  ---}
{---          Balkenbreite,aktueller und erster Datenblock ---}
{--- Ausgabe : Keine                                       ---}

procedure balkenplot(masstab :single; hoehe,xaktuell,yaktuell,
                     saeule,diff : word);
VAR k: word;
BEGIN
  bar(xaktuell,yaktuell-hoehe,xaktuell+saeule,yaktuell);
  IF hoehe > 0 THEN BEGIN
    CASE diff of
      1 :  BEGIN
              SetColor(0);
              FOR k := xaktuell+1 to xaktuell+saeule-1 DO BEGIN
                line(k,yaktuell-hoehe+1,k,yaktuell-1);
              END;
              SetColor(15);
             END;
      2 :    BEGIN
              SetColor(0);
              FOR k := xaktuell+1 to xaktuell+saeule-1 DO BEGIN
                line(k,yaktuell-hoehe+1,k,yaktuell-1);
              END;
              SetColor(15);
              IF saeule >=3 THEN BEGIN
                FOR k:= 1 to Trunc(saeule/3) DO BEGIN
                  line (xaktuell+k*3,yaktuell,xaktuell+k*3,
                        yaktuell-hoehe+1);
                END;
              END;
             END;
      3 :    BEGIN
              SetColor(0);
              FOR k := xaktuell+1 to xaktuell+saeule-1 DO BEGIN
                line(k,yaktuell-hoehe+1,k,yaktuell-1);
              END;
              SetColor(15);
              IF hoehe >= 6 THEN BEGIN
                FOR k:= 0 to Trunc(hoehe/6)-1 DO BEGIN
                  line (xaktuell+1,yaktuell-6*k,
                        xaktuell+saeule-1,yaktuell-6*k-6);
                END;
              END;
             END;
      4 :    BEGIN
              SetColor(0);
              FOR k := xaktuell+1 to xaktuell+saeule-1 DO BEGIN
                line(k,yaktuell-hoehe+1,k,yaktuell-1);
              END;
              SetColor(15);
              IF hoehe >=4 THEN BEGIN
                FOR k:= 1 to Trunc(hoehe/4) DO BEGIN
                  line (xaktuell+1,yaktuell-4*k,xaktuell+
                        saeule-1,yaktuell-4*k);
                END;
              END;
             END;
      5 :    BEGIN
              SetColor(0);
              FOR k := xaktuell+1 to xaktuell+saeule-1 DO BEGIN
                line(k,yaktuell-hoehe+1,k,yaktuell-1);
              END;
              SetColor(15);
              IF hoehe >= 6 THEN BEGIN
                FOR k:= 0 to Trunc(hoehe/6)-1 DO BEGIN
                  line (xaktuell+1,yaktuell-6*k-6,xaktuell+
                        saeule-1,yaktuell-6*k);
                END;
              END;
             END;
    END;
 END;
END;

{--- Grafumgebung : Zeichnen und Beschriften Balkengrafik  ---}
{--- Eingabe: Begrenzungen links,unten,rechts,oben;Maximum ---}
{--- Ausgabe : Keine                                       ---}

procedure grafumgebung(links,unten,rechts,oben : word;
                       max : single);
VAR i : byte;
hoehe : word;
BEGIN
 Line(links,oben,links,unten);
 Line(rechts,oben,rechts,unten);
 FOR i:= 0 to 5 DO BEGIN
   hoehe := Round(i*((unten-oben)/5));
   Line(links-4,unten-hoehe,rechts,unten-hoehe);
   str(Round(max/5)*i,s);
   OutTextXY(links-6-length(s)*8,unten-hoehe,s);
 END;
END;

{--- Beschriftung : Beschriften der Balkengrafiken         ---}
{--- Eingabe: Begrenzungen links,unten,rechts,erster und   ---}
{---       letzter Datenblock,erster und letzter Datensatz ---}
{--- Ausgabe : Keine                                       ---}

procedure beschriftung(links,unten,rechts,edb,ldb,
                       eds,lds : word);
CONST
anz : array[1..6] of byte = (10,10,9,6,4,3);
VAR
i,xaktuell,yaktuell : word;
BEGIN
 xaktuell := links;
 yaktuell := unten+3;
 FOR i:= edb to ldb DO BEGIN
   CASE i-edb of
    0 :  bar(xaktuell,yaktuell,xaktuell+4,yaktuell+8);
    1..5 : BEGIN
            line(xaktuell,yaktuell,xaktuell+4,yaktuell);
            line(xaktuell,yaktuell,xaktuell,yaktuell+8);
            line(xaktuell,yaktuell+8,xaktuell+4,yaktuell+8);
            line(xaktuell+4,yaktuell+8,xaktuell+4,yaktuell);
            CASE i-edb of
             2:line(xaktuell+2,yaktuell,xaktuell+2,yaktuell+8);
             3:line(xaktuell,yaktuell+8,xaktuell+4,yaktuell);
             4:line(xaktuell,yaktuell+4,xaktuell+4,yaktuell+4);
             5:line(xaktuell,yaktuell,xaktuell+4,yaktuell+8);
            END;
           END;
   END;
   s := Copy(daten^.block[i],1,anz[(ldb-edb+1)]);
   OutTextXY(xaktuell+8,yaktuell,s);
   xaktuell := xaktuell + 11 + length(s)*6;
 END;
END;

{--- Balkendiagramm I : Aufbau der Balkengrafik seitlich   ---}
{--- Eingabe: erster Datensatz,letzter Datensatz,erster    ---}
{---          Datenblock, letzter Datenblock               ---}
{--- Ausgabe : Keine                                       ---}

procedure Balkendiagramm1(edb,ldb : word; eds,lds : word);
VAR xmitte : word;
masstab,max : single;
hoehe, xstart, xaktuell, yaktuell, Saeule, Satzbreite,
 Blockbreite : word;
i,j,k : word;
CONST
 oben : word = 2;       {Obere Begrenzung}
 rechts : word = 239;   {Rechte Begrenzung EGA-Grafik}
 unten : word = 52;     {Untere Begrenzung}
 links : word = 45;     {Linke Begrenzung}
BEGIN
 xmitte := Grafinit;
 max := 0;
 FOR i:= edb to ldb DO BEGIN
   FOR j := eds to lds DO BEGIN
    IF daten^.zahlen[i,j] > max THEN max := daten^.zahlen[i,j];
   END;
 END;
 grafumgebung(links,unten,rechts,oben,max);
 masstab := (unten-oben)/max;
 Satzbreite := Trunc((rechts-links)/(lds-eds+1));
 Blockbreite := Trunc((Satzbreite*0.9)/(ldb-edb+1));
 Saeule := Round(Blockbreite*0.8);
 xstart := links+4;
 yaktuell := unten;
 FOR i:= eds to lds DO BEGIN
   xaktuell := xstart;
   FOR j := edb to ldb DO BEGIN
     hoehe := Round(daten^.zahlen[j,i]*masstab);
     balkenplot(masstab,hoehe,xaktuell,yaktuell,saeule,j-edb);
     xaktuell := xaktuell + blockbreite;
   END;
 xstart := xstart + satzbreite;
 END;
beschriftung(links,unten,rechts,edb,ldb,eds,lds);
END;

{--- Balkendiagramm II : Aufbau der Balkengrafik vertikel  ---}
{--- Eingabe: erster Datensatz,letzter Datensatz,erster    ---}
{---          Datenblock, letzter Datenblock               ---}
{--- Ausgabe : Keine                                       ---}

procedure Balkendiagramm2(edb,ldb : word; eds,lds : word);
VAR xmitte : word;
masstab,max,summe : single;
hoehe, xstart, xaktuell, yaktuell, Saeule, Satzbreite : word;
i,j,k : word;
CONST
 oben : word = 2;       {Obere Begrenzung}
 rechts : word = 239;   {Rechte Begrenzung EGA-Grafik}
 unten : word = 52;     {Untere Begrenzung}
 links : word = 45;     {Linke Begrenzung}
BEGIN
 xmitte := Grafinit;
 max := 0;
 FOR j := eds to lds DO BEGIN
   summe := 0;
   FOR i:= edb to ldb DO BEGIN
     summe := summe + daten^.zahlen[i,j];
   END;
   IF summe > max THEN max := summe;
 END;
 masstab := (unten-oben)/max;
 grafumgebung(links,unten,rechts,oben,max);
 Satzbreite := Trunc((rechts-links)/(lds-eds+1));
 Saeule := Trunc(Satzbreite*0.80);
 xaktuell := links+4;
 FOR i:= eds to lds DO BEGIN
   yaktuell := unten;
   FOR j := edb to ldb DO BEGIN
     hoehe := Trunc(daten^.zahlen[j,i]*masstab);
     balkenplot(masstab,hoehe,xaktuell,yaktuell,saeule,j-edb);
     yaktuell := yaktuell -hoehe;
   END;
 xaktuell := xaktuell + satzbreite;
 END;
beschriftung(links,unten,rechts,edb,ldb,eds,lds);
END;

{--- Saeulendiagramm : Aufbau der 3-D-Saeulengrafik        ---}
{--- Eingabe: erster Datensatz,letzter Datensatz,erster    ---}
{---          Datenblock, letzter Datenblock               ---}
{--- Ausgabe : Keine                                       ---}

procedure Saeulendiagramm(edb,ldb : word; eds,lds : byte);
VAR xmitte,zahl,xoff,unt : word;
s : string;
masstab,max : single;
hoehe, xstart, xaktuell, yaktuell, Saeule,
 Satzbreite : Integer;
i,j,k : word;
CONST
 oben : word = 2;        {Obere Begrenzung}
 rechts : word = 200;    {Rechte Begrenzung EGA-Grafik}
 unten : word = 50;     {Untere Begrenzung}
 hinten : word = 20;    {Hintere Begrenzung}
 diff : word = 10;     {y-Offset f�r Datenblock}
 verh   : single = 0.7;    {Verh„ltnis Tiefe S„ulen - y-Offset}

BEGIN
 xmitte := Grafinit;
 max := 0;
 FOR i:= edb to ldb DO BEGIN
   FOR j := eds to lds DO BEGIN
    IF daten^.zahlen[i,j] > max THEN max := daten^.zahlen[i,j];
   END;
 END;
 masstab := (unten-oben)/max;
 Line(hinten,unten,rechts,unten);
 Line(hinten,oben,rechts,oben);
 Line(hinten,unten,hinten,oben);
 Line(rechts,unten,rechts,oben);
 Line(hinten,oben,hinten-diff,oben+diff);
 Line(hinten-diff,oben+diff,hinten-diff,
      unten+diff);
 Line(hinten-diff,unten+diff,hinten,unten);
 Line(hinten-diff,unten+diff,rechts-diff,
      unten+diff);
 Line(rechts-diff,unten+diff,rechts,unten);
 FOR i:= 0 to 5 DO BEGIN
   hoehe := Trunc(i*((unten-oben)/5));
   Line(rechts+4,unten-hoehe,hinten,unten-hoehe);
   Line(hinten,unten-hoehe,hinten-diff,
        unten+diff-hoehe);
   str(Round(max/5)*i,s);
   IF i<> 0 THEN OutTextXY(rechts+6,unten-hoehe,s);
 END;

 IF eds = lds THEN BEGIN
   unt := (ldb-edb+1);
 END
 ELSE BEGIN
   unt := (lds-eds+1);
 END;
 Satzbreite := Trunc((rechts-hinten-10)/unt);
 Saeule := Trunc(Satzbreite*0.7);
 xstart := hinten+10;
 xoff := Trunc(Verh*diff);

 xaktuell := xstart-diff;
 unt := unten+diff;
 FOR i := edb to ldb DO BEGIN
   FOR j := eds to lds DO BEGIN
     hoehe := Trunc(daten^.zahlen[i,j]*masstab);
     bar(xaktuell,unt-hoehe,xaktuell+saeule,unt);
     SetColor(0);
     FOR k := 1 to xoff-1 DO BEGIN
      line (xaktuell+saeule+k,unt-k,xaktuell+saeule+k,
            unt-hoehe-k);
     END;
     FOR k := 1 to saeule DO BEGIN
      line (xaktuell+k,unt-hoehe,xaktuell+k+xoff,
            unt-hoehe-xoff);
     END;
     SetColor(15);
     line(xaktuell+saeule,unt,xaktuell+saeule+xoff,unt-xoff);
     line(xaktuell+saeule,unt-hoehe,xaktuell+saeule+xoff,
          unt-hoehe-xoff);
     line(xaktuell,unt-hoehe,xaktuell+xoff,unt-hoehe-xoff);
     line(xaktuell+saeule+xoff,unt-xoff,xaktuell+saeule+xoff,
          unt-hoehe-xoff);
     line(xaktuell+xoff,unt-hoehe-xoff,xaktuell+saeule+xoff,
          unt-hoehe-xoff);

     xaktuell := xaktuell + satzbreite;
   END;
 END;
 xaktuell := rechts+4;
 yaktuell := unten+5;
 IF eds = lds THEN BEGIN
    s := daten^.block[eds];
 END
 ELSE BEGIN
    s := daten^.satz[edb];
 END;
 OutTextXY(xaktuell,yaktuell,Copy(s,1,5));
END;

{--- Mini : Berechnet Minimum zweier Zahlen                ---}
{--- Eingabe: Zu vergleichende Zahlen                      ---}
{--- Ausgabe : Minimum dieser Zahlen                       ---}

function mini(erste,zweite : word) : word;
BEGIN
 IF erste <= zweite THEN BEGIN
   mini := erste;
 END
 ELSE BEGIN
   mini := zweite;
 END;
END;

{--- Auswahlblsa : Auswahl der darzustellenden             ---}
{---               Datenbl”cke/S„tze                       ---}
{--- Eingabe: Maximal zul„ssige Anzahl Datenbl”cke/s„tze,  ---}
{---          Typ (Bl”cke/S„tze) mit entsp. Textausgaben   ---}
{--- Ausgabe : Setzt globale Variablen eblo,anzbl/esa,anzsa---}

procedure auswahlblsa(max : byte; art,leer : string;
                     loadart : word; VAR erster,anzahl : word);
VAR code : integer;
s1 : string;
BEGIN
  Standardbild;
  GotoXY(2,2);
  write('Erster Daten',art,' (1-',loadart,') : <',leer,'>');
  str(loadart,s1);
  REPEAT
    Eingabe(s,23+length(art)+length(s1),2,length(leer),1,'1');
    val(s,erster,code);
  UNTIL ((erster >= 1) and (erster <= loadart));
  IF max > 1 THEN BEGIN
    IF erster < loadart THEN BEGIN
      GotoXY(2,4);
      str(erster,s1);
      str(Mini(erster+max-1,loadart),s);
      s1 := s1 + '-' + s;
      write('Letzter Daten',art,' (',s1,') : <',leer,'>');
      REPEAT
        Eingabe(s,22+length(art)+length(s1),4,length(leer),1,'');
        val(s,anzahl,code);
      UNTIL ((anzahl >=erster) and
            (anzahl <=Mini(erster+max-1,loadart)));
    END
    ELSE BEGIN
      anzahl := loadart;
    END;
  END
  ELSE BEGIN
    anzahl := erster;
  END;
  anzahl := anzahl - erster+1;
END;

{--- Auswahlblock : Auswahl der darzustellenden Datenbl”cke---}
{--- Eingabe: Maximal zul„ssige Anzahl Datenbl”cke         ---}
{--- Ausgabe : Setzt globale Variablen eblo,anzbl          ---}

procedure auswahlblock(max : byte);
BEGIN
 auswahlblsa(max,'block','  ',loadblock,eblo,anzbl);
END;

{--- Auswahlsatz : Auswahl der darzustellenden Datens„tze ---}
{--- Eingabe: Maximal zul„ssige Anzahl Datens„tze         ---}
{--- Ausgabe : Setzt globale Variablen esa,anzsa          ---}

procedure auswahlsatz(max : byte);
BEGIN
 auswahlblsa(max,'satz','   ',loadsatz,esa,anzsa);
END;

{--- ausdruck : Hardcopy der Grafik auf Matrixdrucker    ---}
{--- Eingabe : Keine                                     ---}
{--- Ausgabe : Keine                                     ---}

procedure ausdruck;
CONST
 ret : char = chr(13);
 druckinit = #$0D#$1B#$6C#$08#$1B#$41#$07;
 neuezeile = #$0D#$0A;
 grafikzeile = #$1B#$4C#$80#$00;
VAR
 f : file of char;
 grafikbyte : array[0..63] of byte;
 i,j : integer;
BEGIN
  Assign(f,'prn');
  Rewrite(f);
  write(f,ret);
  IF IOResult = 0 THEN BEGIN
     close(f);
     write(lst,druckinit);
     FOR i:= 0 to 29 DO BEGIN
      write(lst,grafikzeile);
      FOR j:= 0 to 63 DO BEGIN
        grafikbyte[j] := Mem[$B000:1890-j*30+i];
      END;
      FOR j:= 0 to 63 DO BEGIN
        write(lst,chr(grafikbyte[j]));
        write(lst,chr(grafikbyte[j]));
      END;
      write(lst,neuezeile);
    END;
    write(lst,neuezeile);
  END;
END;

{-------------------------------------------------------------}
{---------------  P R O G R A M M S T A R T  -----------------}
{-------------------------------------------------------------}

BEGIN
   New(daten);
   letztpfad := '';
   letztname := '';
   loadsatz := 0;              {Anzahl geladene Datens„tze}
   loadblock := 0;             {Anzahl geladene Datenbl”cke}
   druck := 1;                 {Keine Hardcopy nach Bildaufbau}

{----------------- Hauptmen� aufbauen ------------------------}

  Textmode(portfolio);
  Standardbild;
  REPEAT
   GotoXY(2,2);
   write('ATARI-Portfolio-Version 1.1');
   GotoXY(2,3);
   write('Juli 1990 von Frank Riemenschneider');
   GotoXY(2,4);
   write('(C) 1990 Markt & Technik Verlag AG');
   GotoXY(2,6);
   write('Hauptmen� mit <F1>  Ausdruck : ',hardcopy[druck]);
   REPEAT
     input := ReadKey;
     IF input = chr(0) THEN input := ReadKey;
   UNTIL Input = chr(59);
   hpunkt := portmenue(' Hauptmen� ',12,2,4,16,hauptmenue);
   CASE hpunkt of
     1 : BEGIN
           punkt := portmenue(' Datenmen� ',10,2,3,20,datenmenue);
           CASE punkt of
                1 : einrichten;
                3 : einladen(false);
                2 : einladen(true);
           END;
           IF punkt <>0 THEN Standardbild;
         END;
     2 : BEGIN
           IF ((loadblock >0) and (loadsatz > 0)) THEN BEGIN
             punkt := portmenue(' Grafikmen� ',10,1,5,19,grafikmenue);
             CASE punkt of
                 1 : BEGIN
                       auswahlblock(6);
                       auswahlsatz(Trunc(20/anzbl));
                       balkendiagramm1(eblo,eblo+anzbl-1,
                                       esa,esa+anzsa-1);
                     END;
                 3 : BEGIN
                       auswahlblock(20);
                       IF anzbl > 1 THEN BEGIN
                         auswahlsatz(1);
                       END
                       ELSE BEGIN
                         auswahlsatz(20);
                       END;
                       saeulendiagramm(eblo,eblo+anzbl-1,
                                    esa,esa+anzsa-1);
                     END;
                 2 : BEGIN
                       auswahlblock(6);
                       auswahlsatz(20);
                       balkendiagramm2(eblo,eblo+anzbl-1,
                                     esa,esa+anzsa-1);
                     END;
                 4 : BEGIN
                       auswahlblock(8);
                       IF anzbl > 1 THEN BEGIN
                          auswahlsatz(1);
                       END
                       ELSE BEGIN
                          auswahlsatz(8);
                       END;
                       kuchendiagramm(eblo,eblo+anzbl-1,
                                    esa,esa+anzsa-1);
                     END;
                 5 : BEGIN
                       auswahlblock(8);
                       IF anzbl > 1 THEN BEGIN
                         auswahlsatz(1);
                       END
                       ELSE BEGIN
                         auswahlsatz(8);
                       END;
                       tortendiagramm(eblo,eblo+anzbl-1,
                                    esa,esa+anzsa-1);
                     END;
             END;
             IF ((punkt >0) and (punkt<6)) THEN BEGIN
               IF druck = 0 THEN ausdruck;
               REPEAT;
               UNTIL KeyPressed;
               s[1] := ReadKey;
               CloseGraph;
               Standardbild;
             END;
           END;
         END;
     3 : druck := 1-druck;
   END;
  UNTIL hpunkt = 4;
  ClrScr;
  Dispose(daten);
END.