home *** CD-ROM | disk | FTP | other *** search
/ Turbo Toolbox / Turbo_Toolbox.iso / 1987 / 07 / variante.pas < prev   
Encoding:
Pascal/Delphi Source File  |  1987-06-10  |  6.3 KB  |  227 lines
  1. (* ---------------------------------------------------------------------- *)
  2. (*                            VARIANTE.PAS                                *)
  3. (*       Beispielprogramm (Turbo-Pascal) fuer "Variante Records           *)
  4. (* ---------------------------------------------------------------------- *)
  5.  
  6. PROGRAM Varianten_Demo (Input,Output);
  7.  
  8. CONST   Namenslaenge = 20;
  9.         GebLaenge    = 8;
  10.         Datei_Name   = 'Testdat.RM';
  11.  
  12. TYPE NamensTyp       = STRING(.Namenslaenge.);
  13.      GebTyp          = STRING(.GebLaenge.);
  14.      GeschlechtsTyp  = (m,w,x);
  15.      PersonTyp       = RECORD
  16.                          Name : NamensTyp;
  17.                          CASE geschlecht : GeschlechtsTyp OF
  18.                            m: (gebdat : GebTyp;
  19.                                gewicht: REAL;
  20.                                baertig: CHAR;
  21.                                merkmal: STRING(.10.));
  22.                            w: (telefon  : REAL;
  23.                                bemerkung: STRING(.10.));
  24.                            x: (zell: CHAR);
  25.                        END;
  26.  
  27. VAR n, i      : INTEGER;
  28.     abbrechen : BOOLEAN;
  29.     person    : PersonTyp;
  30.     geschl    : CHAR;
  31.     antwort   : CHAR;
  32.     Datei     : FILE OF PersonTyp;
  33.  
  34. (* ---------------------------------------------------------------------- *)
  35.  
  36. PROCEDURE Datei_oeffnen;
  37.  
  38. BEGIN
  39.   Assign(Datei, Datei_Name);
  40.   (*$I-*)         (* I/O-Fehlerbehandlung durch Laufzeitsystem abschalten *)
  41.   ReSet(Datei);
  42.   (*$I+*)                                             (* und wieder an... *)
  43.   IF IOResult = 0 THEN
  44.     ReSet(Datei)                                (* Datei existiert schon! *)
  45.   ELSE
  46.     ReWrite(Datei);                                 (* sonst neu anlegen! *)
  47. END;
  48.  
  49. (* ---------------------------------------------------------------------- *)
  50.  
  51. PROCEDURE Ende;
  52.  
  53. BEGIN
  54.   Close(Datei);
  55.   abbrechen := TRUE;
  56.   ClrScr;
  57. END;
  58.  
  59. (* ---------------------------------------------------------------------- *)
  60.  
  61. PROCEDURE Eintrag;
  62.  
  63. BEGIN
  64.   ClrScr;
  65.   WITH person DO
  66.   BEGIN
  67.     Write('Name : ');
  68.     ReadLn(Name);
  69.     Write('Geschlecht : ');          (* Hilfsvariable fuer CASE-Anweisung *)
  70.     ReadLn(geschl);
  71.     CASE geschl OF
  72.       'w': person.geschlecht := w;
  73.       'm': person.geschlecht := m;
  74.       ELSE person.geschlecht := x;
  75.     END;
  76.     CASE geschlecht OF
  77.       m: BEGIN
  78.            Write('Geburtsdatum :');         ReadLn(gebdat);
  79.            Write('Gewicht : ');             ReadLn(gewicht);
  80.            Write('baertig : ');             ReadLn(baertig);
  81.            Write('Merkmal : ');             ReadLn(merkmal);
  82.          END;
  83.       w: BEGIN
  84.            Write('Telefon : ');             ReadLn(telefon);
  85.            Write('Bemerkung : ');           ReadLn(bemerkung);
  86.          END;
  87.       x: BEGIN
  88.            Write('Fortpflanzung durch Zellteilung : ');
  89.            Read(zell);
  90.          END;
  91.     END;
  92.     ClrScr;
  93.     Seek(Datei, FileSize(Datei));                  (* Dateiende suchen... *)
  94.     Write(Datei,person);                       (* ...und Record anhaengen *)
  95.   END;
  96. END;
  97.  
  98. (* ---------------------------------------------------------------------- *)
  99.  
  100. PROCEDURE Zeige_Satz;
  101.  
  102. BEGIN
  103.   WITH person DO
  104.   BEGIN
  105.     WriteLn(FilePos(Datei),' ',Name);
  106.     CASE geschlecht OF
  107.       m: BEGIN
  108.            WriteLn('Geburtstag : ',gebdat);
  109.            Write('Gewicht : ',gewicht:6:2,' kg');
  110.            Write('  Barttraeger : ',baertig);
  111.            WriteLn('  Merkmal : ',merkmal);
  112.          END;
  113.       w: WriteLn('Telefon   : ',telefon:10:0,'    Bemerkung : ',bemerkung);
  114.       x: WriteLn('Zellteiler : ',zell);
  115.     END;
  116.   END;
  117. END;
  118.  
  119. (* ---------------------------------------------------------------------- *)
  120.  
  121. PROCEDURE Liste;
  122.  
  123. BEGIN
  124.   ClrScr;
  125.   ReSet(Datei);
  126.   i := 1;
  127.   WHILE NOT (Eof(Datei)) DO
  128.   BEGIN
  129.     GotoXY(1,i);
  130.     Read(Datei,person);
  131.     Zeige_Satz;
  132.     WriteLn;
  133.     i := i+4;
  134.     IF i >= 20 THEN
  135.     BEGIN
  136.       i := 1;
  137.       WriteLn; WriteLn('WEITER MIT >>RETURN<<'); Read;
  138.       ClrScr;
  139.     END;
  140.   END;
  141.   WriteLn; WriteLn; WriteLn('Mit <RETURN> geht es weiter!'); Read;
  142.   ClrScr;
  143. END;
  144.  
  145. (* ---------------------------------------------------------------------- *)
  146.  
  147. PROCEDURE Satz;
  148.  
  149. BEGIN
  150.   ReSet(Datei);
  151.   ClrScr;
  152.   Write('Nummer des Eintrags : ');  Read(n);
  153.   WriteLn; WriteLn;
  154.   Seek(Datei,n-1);                   (* Turbo nummeriert die Saetze ab 0! *)
  155.   Read(Datei,person);
  156.   Zeige_Satz;
  157.   WriteLn; WriteLn; WriteLn; WriteLn('Weiter mit <RETURN>'); Read;
  158.   ClrScr;
  159. END;
  160.  
  161. (* ---------------------------------------------------------------------- *)
  162.  
  163. PROCEDURE Suchen;
  164.  
  165. VAR such : GeschlechtsTyp;
  166.  
  167. BEGIN
  168.   ClrScr;
  169.   ReSet(Datei);
  170.   WriteLn('Dateiausgabe nach Geschlechtern');
  171.   WriteLn('-------------------------------');
  172.   WriteLn; WriteLn; Write('Geben Sie m, w oder h ein : '); ReadLn(antwort);
  173.   ClrScr;
  174.   antwort := UpCase(antwort);
  175.   CASE antwort OF
  176.     'M': BEGIN
  177.            such := m;
  178.            WriteLn('A L L E S   M A E N N E R'); WriteLn; WriteLn;
  179.          END;
  180.     'W': BEGIN
  181.            such := w;
  182.            WriteLn('A L L E S  F R A U E N'); WriteLn; WriteLn;
  183.          END;
  184.     'H': BEGIN
  185.            such := x;
  186.            WriteLn('A L L E S  H E R M A P H R O D I T E N');
  187.            WriteLn; WriteLn;
  188.          END;
  189.   END;
  190.   WHILE NOT(Eof(Datei)) DO
  191.   BEGIN
  192.     Read(Datei,person);
  193.     WITH person DO
  194.       IF geschlecht = such THEN WriteLn(Name);
  195.   END;
  196.   WriteLn; WriteLn; Write('Weiter mit <RETURN>'); Read;
  197.   ClrScr;
  198. END;
  199.  
  200. (* ---------------------------------------------------------------------- *)
  201.  
  202. BEGIN
  203.   ClrScr;
  204.   Datei_oeffnen;
  205.   abbrechen := FALSE;
  206.   REPEAT
  207.     WriteLn; WriteLn; WriteLn
  208.      ('Beispiel fuer "Varianter Record als Random_Access_Datei"');
  209.     WriteLn
  210.      ('--------------------------------------------------------');
  211.     WriteLn; WriteLn; WriteLn; WriteLn;
  212.     WriteLn; WriteLn('1.  Neuer Eintrag');
  213.     WriteLn; WriteLn('2.  Liste der Eintraege');
  214.     WriteLn; WriteLn('3.  Lesen eines Satzes');
  215.     WriteLn; WriteLn('4.  Namensliste nach Geschlechter');
  216.     WriteLn; WriteLn('0.  Ende');
  217.     WriteLn; Write('Was ? ');  ReadLn(antwort);
  218.     CASE antwort OF
  219.       '1': Eintrag;
  220.       '2': Liste;
  221.       '3': Satz;
  222.       '4': Suchen;
  223.       '0': Ende;
  224.     END;
  225.   UNTIL abbrechen;
  226. END.
  227.