DataMuseum.dk

top - download

    Length: 7296 (0x1c80)
    Types: TextFile
    Names: »MENUFIL.PAS«

└─⟦092727b26⟧ Bits:30005927 Demoprogrammer til Pascal bog (Jet-80)
    └─ ⟦this⟧ »MENUFIL.PAS« 

TextFile

PROGRAM menufil;

  TYPE
    str30 = STRING(.30.);
    medlemspost = RECORD
                    navn, adresse, by, info : str30;
                  END;
  
  VAR
    fil : FILE OF medlemspost;
    medlem : medlemspost;
    ch : CHAR;
  
  PROCEDURE retur;
    
    VAR
      ch : CHAR;
    
    BEGIN (* retur *)
      WRITE('Tast <RETURN>: ');
      REPEAT
        READ(KBD, ch);
      UNTIL ch = CHR(13);
    END; (* retur *)
  
  PROCEDURE opret;
    
    VAR
      filnavn : STRING(.14.);
      
    BEGIN (* opret *)
      WRITE(CLRHOM);
      GOTOXY(10, 5);
      WRITE('Hvad skal kartoteket hedde: ');
      READLN(filnavn);
      ASSIGN(fil, filnavn);
      REWRITE(fil);
      GOTOXY(10, 7);
      WRITE(filnavn, ' er nu oprettet');
      GOTOXY(10, 9);
      retur;
    END; (* opret *)
  
  PROCEDURE hvilkenfil;
    
    VAR
      filnavn : STRING(.14.);
    
    BEGIN (* hvilkenfil *)
      WRITE(CLRHOM);
      GOTOXY(10, 5);
      WRITE('Hvad hedder den eksisterende fil: ');
      READLN(filnavn);
      ASSIGN(fil, filnavn);
      RESET(fil);
      GOTOXY(10, 7);
      retur;
    END; (* hvilkenfil *)
  
  PROCEDURE udskriv;
  
    VAR
      i : INTEGER;
      ch : CHAR;
      udfil : TEXT;
      udnavn : STRING(.4.);
    
    BEGIN (* udskriv *)
      WRITE(CLRHOM);
      WRITE('Ønskes udskrift på skærm eller printer (s/p): ');
      REPEAT
        READ(KBD, ch);
      UNTIL ch IN (. 'S', 's', 'P', 'p'.);
      WRITELN(ch);
      IF ch IN (. 'S', 's'.)
        THEN udnavn := 'CON:'
        ELSE udnavn := 'LST:';
      ASSIGN(udfil, udnavn);
      RESET(fil);
      REWRITE(udfil);
      i := 0;
      WHILE NOT EOF(fil) DO
        BEGIN
          i := i + 1;
          READ(fil, medlem);
          WITH medlem DO
            BEGIN
              IF navn <> ''
                THEN
                  BEGIN
                    WRITELN('Medlem nr. ', i, ': ');
                    WRITELN(navn);
                    WRITELN(adresse);
                    WRITELN(by);
                    WRITELN(info);
                    WRITELN;
                  END;
            END;
        END;
      WRITELN;
      retur;
    END; (* udskriv *)
  
  PROCEDURE slet;
  
    VAR
      medlemsnr : INTEGER;
      ch : CHAR;
    
    BEGIN (* slet *)
      WRITE(CLRHOM);
      GOTOXY(10, 5);
      WRITE('Hvem skal slettes? Tast medlemsnummer: ');
      READLN(medlemsnr);
      GOTOXY(10, 7);
      IF medlemsnr > LENGTH(fil)
        THEN WRITE('Medlemsnummeret er for stort')
        ELSE
          BEGIN
            SEEK(fil, medlemsnr - 1);
            READ(fil, medlem);
            WITH medlem DO
              BEGIN
                IF navn = ''
                  THEN WRITELN('Der er intet medlem med dette nummer')
                  ELSE
                    BEGIN
                      WRITE('Skal ', navn, ' slettes (j/n): ');
                      REPEAT
                        READ(KBD, ch);
                      UNTIL ch IN (. 'J', 'j', 'N', 'n'.);
                      WRITELN(ch);
                      IF ch IN (. 'J', 'j'.)
                        THEN navn := '';
                      SEEK(fil, medlemsnr - 1);
                      WRITE(fil, medlem);
                    END;
              END;
          END;
          GOTOXY(10, 9);
          retur;
          END; (* slet *)
  
  PROCEDURE ret;
  
    VAR
      medlemsnr : INTEGER;
      ch : CHAR;
      
    BEGIN (* ret *)
      WRITE(CLRHOM);
      GOTOXY(10, 0); WRITE('Tast medlemsnummer: '); READLN(medlemsnr);
      SEEK(fil, medlemsnr - 1);
      READ(fil, medlem);
      SEEK(fil, medlemsnr - 1);
      WITH medlem DO
        BEGIN
          GOTOXY(10, 2); WRITE('Navn: ', navn);
          GOTOXY(10, 3); WRITE('Adresse: ', adresse);
          GOTOXY(10, 4); WRITE('By: ', by);
          GOTOXY(10, 5); WRITE('Info: ', info);
          GOTOXY(10, 7); WRITE('Hvad skal rettes:');
          GOTOXY(10, 8); WRITE('N Navn');
          GOTOXY(10, 9); WRITE('A Adresse');
          GOTOXY(10, 10); WRITE('B By');
          GOTOXY(10, 11); WRITE('I Info');
          GOTOXY(10, 12); WRITE('F FÆRDIG');
          REPEAT
            GOTOXY(0, 14); WRITE(CLREOS);
            GOTOXY(10, 14); WRITE('Tast kommando (N/A/B/I/F): ');
            REPEAT
              READ(KBD, ch);
            UNTIL ch IN (. 'N', 'n', 'A', 'a', 'B', 'b', 'I', 'i', 'F', 'f'.);
            WRITE(ch);
            GOTOXY(10, 16); WRITE('Tast ændring: ');
            CASE ch OF
              'N', 'n' : READ(navn);
              'A', 'a' : READ(adresse);
              'B', 'b' : READ(by);
              'I', 'i' : READ(info);
            END;
            IF NOT (ch IN (.'F', 'f'.))
              THEN
                BEGIN
                  GOTOXY(10, 18); 
                  retur;
                END;
          UNTIL ch IN (.'F', 'f'.);
          WRITE(fil, medlem);
        END;
    END; (* ret *)

  PROCEDURE tilfoej;
  
    VAR
      filpointer : INTEGER;
      nytmedlem : medlemspost;
      
    BEGIN (* tilfoej *)
      WRITE(CLRHOM);
      RESET(fil);
      filpointer := 0;
      IF LENGTH(fil) > 0
        THEN 
          BEGIN
          READ(fil, medlem);
          filpointer := 1;
          WHILE (medlem.navn <> '') AND NOT EOF(fil) DO
            BEGIN
              READ(fil, medlem);
              filpointer := filpointer + 1;
            END;
          IF medlem.navn = ''
            THEN filpointer := filpointer - 1;
        END;
      WITH nytmedlem DO
        BEGIN
          GOTOXY(10, 5); WRITE('Nyt medlem nr: ', filpointer + 1);
          GOTOXY(10, 7); WRITE('Navn: '); READ(navn);
          GOTOXY(10, 9); WRITE('Adresse: '); READ(adresse);
          GOTOXY(10, 11); WRITE('By: '); READ(by);
          GOTOXY(10, 13); WRITE('Info: '); READ(info);
        END;
      SEEK(fil, filpointer);
      WRITE(fil, nytmedlem);
      GOTOXY(10, 15);
      retur;
    END; (* tilfoej *)
  
  BEGIN (* menufil *)
    WRITE(CLRHOM);
    GOTOXY(10, 5); WRITE('M E D L E M S K A R T O T E K');
    GOTOXY(10, 7); WRITE('Skal du arbejde med et nyt eller et allerede');
    GOTOXY(10, 8); WRITE('eksisterende kartotek (N/E): ');
    REPEAT
      READ(KBD, ch);
    UNTIL ch IN (. 'N', 'n', 'E', 'e'.);
    IF ch IN (. 'N', 'n'.)
      THEN opret
      ELSE hvilkenfil;
    REPEAT
      WRITE(CLRHOM);
      GOTOXY(10, 7); WRITE('M E D L E M S K A R T O T E K');
      GOTOXY(10, 9); WRITE('Udskrive kartoteket');
      GOTOXY(10, 11); WRITE('Slette medlem');
      GOTOXY(10, 13); WRITE('Rette i medlemspost');
      GOTOXY(10, 15); WRITE('Indsætte nyt medlem i kartotek');
      GOTOXY(10, 17); WRITE('AFSLUTTE programkørslen');
      GOTOXY(10, 19); WRITE('Tast kommando: (U/S/R/I/A): ');
      REPEAT
        READ(KBD, ch);
      UNTIL ch IN (. 'U', 'u', 'S', 's', 'R', 'r', 'I', 'i', 'A', 'a'.);
      WRITELN(ch);
      CASE ch OF
        'U', 'u' : udskriv;
        'S', 's' : slet;
        'R', 'r' : ret;
        'I', 'i' : tilfoej;
      END;
    UNTIL ch IN (. 'A', 'a'.);
    WRITELN;
    CLOSE(fil);
  END. (* menufil *)
«eof»