DataMuseum.dk

top - download

    Length: 10752 (0x2a00)
    Types: TextFile
    Names: »VAREFIL.PAS«

└─⟦09235ab48⟧ Bits:30003065 Demoprogrammer K-Z til Pascal bog
    └─ ⟦this⟧ »VAREFIL.PAS« 

TextFile

PROGRAM varefil;
  
  CONST
    varemax = 500;
  
  TYPE
    parpost = RECORD
                varenummer, postnummer : INTEGER;
              END;
    indextype = ARRAY(.1 .. varemax.) OF parpost;
    str30 = STRING(.30.);
    varepost = RECORD
                 nr : INTEGER;
                 navn : str30;
                 pris : REAL;
                 beholdning, minimum : INTEGER;
               END;
    
  VAR
    index : indextype;
    indexfil : FILE OF parpost;
    artikelfil : FILE OF varepost;
    postantal, i : INTEGER;
    ch : CHAR;
  
  PROCEDURE sorter;
    
    VAR
      slut : BOOLEAN;
      byt : parpost;
      i, j : INTEGER;
      
    BEGIN (* sorter *)
      i := postantal;
      REPEAT
        i := i - 1;
        slut := TRUE;
        FOR j := 1 TO i DO
          IF index(.j.).varenummer > index(.j + 1.).varenummer
            THEN
              BEGIN
                slut := FALSE;
                byt := index(.j.);
                index(.j.) := index(.j + 1.);
                index(.j + 1.) := byt;
              END;
      UNTIL (i = 1) OR slut;
    END; (* sorter *)
  
  PROCEDURE retur;
  
    VAR
      ch : CHAR;
    
    BEGIN (* retur *)
      WRITE('Tast <RETUR>: ');
      REPEAT
        READ(KBD, ch);
      UNTIL ch = CHR(13);
    END; (* retur*)
  
  PROCEDURE opret;
  
    VAR
      varefilnavn, indexfilnavn : STRING(.14.);
    
    BEGIN (* opret *)
      WRITE(CLRHOM);
      GOTOXY(5, 2); WRITE('Hvad skal det nye varekartotek hedde: ');
      READ(varefilnavn);
      GOTOXY(5, 4); WRITE('Hvad skal indexfilen hedde: ');
      READ(indexfilnavn);
      ASSIGN(artikelfil, varefilnavn);
      ASSIGN(indexfil, indexfilnavn);
      REWRITE(artikelfil);
      REWRITE(indexfil);
      postantal := 0;
      GOTOXY(5, 6); 
      WRITE(varefilnavn, ' og ', indexfilnavn, ' er nu oprettet');
      GOTOXY(5, 8);
      retur;
    END; (* opret *)
  
  PROCEDURE hvilkefiler;
  
    VAR
      varefilnavn, indexfilnavn : STRING(.14.);
      i : INTEGER;
    
    BEGIN (* hvilkefiler *)
      WRITE(CLRHOM);
      GOTOXY(5, 2); WRITE('Hvad hedder varekartoteket: ');
      READLN(varefilnavn);
      GOTOXY(5, 4); WRITE('Hvad hedder dets indexfil: ');
      READLN(indexfilnavn);
      ASSIGN(artikelfil, varefilnavn);
      ASSIGN(indexfil, indexfilnavn);
      RESET(artikelfil);
      RESET(indexfil);
      i := 0;
      WHILE NOT EOF(indexfil) DO
        BEGIN
          i := i + 1;
          READ(indexfil, index(.i.));
        END;
      postantal := i;
      GOTOXY(5, 6);
      retur;
    END; (* hvilkefiler *)
  
  PROCEDURE udskriv;
    
    VAR
      udfil : TEXT;
      udnavn : STRING(.4.);
      vare : varepost;
      ch : CHAR;
      i : INTEGER;
        
    BEGIN (* udskriv *)
      WRITE(CLRHOM);
      GOTOXY(5, 2); WRITE('Ønskes udskrift på skærm eller printer (S/P): ');
      REPEAT
        READ(KBD, ch);
      UNTIL ch IN (.'S', 's', 'P', 'p'.);
      WRITELN(ch);
      WRITELN;
      IF ch IN (.'S', 's'.)
        THEN udnavn := 'CON:'
        ELSE udnavn := 'LST:';
      ASSIGN(udfil, udnavn);
      REWRITE(udfil);
      i := 0;
      WHILE i < postantal DO
        BEGIN
          i := i + 1;
          IF index(.i.).varenummer > 0
            THEN
              BEGIN
                SEEK(artikelfil, index(.i.).postnummer);
                READ(artikelfil, vare);
                WITH vare DO
                  BEGIN
                    WRITELN(udfil, '      Varenummer: ', nr : 7,
                            '   Vare: ', navn);
                    WRITELN(udfil, '      Enhedspris: ', pris : 7 : 2,
                            '   Beholdning: ', beholdning : 6,
                            '   Minimumsbeholdning: ', minimum : 6);
                    WRITELN(udfil);
                  END;
              END;
        END;
      WRITELN;
      retur;
    END; (*udskriv *)
  
  PROCEDURE slet;
    
    VAR
      vare : varepost;
      nummer : INTEGER;
      ch : CHAR;
      i : INTEGER;
      
    BEGIN (* slet *)
      WRITE(CLRHOM);
      GOTOXY(5, 2); WRITE('Tast varenummer: ');
      READ(nummer);
      i := 0;
      REPEAT
        i := i + 1;
      UNTIL (index(.i.).varenummer >= nummer) OR (i = postantal);
      IF index(.i.).varenummer <> nummer
        THEN
          BEGIN
            GOTOXY(5, 4); WRITE('Dette varenummer findes ikke');
          END
        ELSE
          BEGIN
            SEEK(artikelfil, index(.i.).postnummer);
            READ(artikelfil, vare);
            SEEK(artikelfil, index(.i.).postnummer);
            GOTOXY(5, 4); WRITE('Skal ''', vare.navn, ''' slettes (J/N): ');
            REPEAT
              READ(KBD, ch);
            UNTIL ch IN (.'J', 'j', 'N', 'n'.);
            IF ch IN (.'J', 'j'.)
              THEN
                BEGIN
                  vare.nr := -1;
                  WRITE(artikelfil, vare);
                  index(.i.).varenummer := -1;
                END;
          END;
      sorter;
      GOTOXY(5, 6);
      retur;
    END; (* slet *)
  
  PROCEDURE ret;
  
    VAR
      nummer : INTEGER;
      vare : varepost;
      ch : CHAR;
      i : INTEGER;
      
    BEGIN (* ret *)
      WRITE(CLRHOM);
      GOTOXY(5, 2); WRITE('Tast varenummer: ');
      READ(nummer);
      i := 0;
      REPEAT
        i := i + 1;
      UNTIL (index(.i.).varenummer >= nummer) OR (i = postantal);
      IF index(.i.).varenummer <> nummer
        THEN
          BEGIN
            GOTOXY(5, 4); WRITE('Dette varenummer findes ikke');
          END
        ELSE
          BEGIN
            SEEK(artikelfil, index(.i.).postnummer);
            READ(artikelfil, vare);
            SEEK(artikelfil, index(.i.).postnummer);
            WITH vare DO
              BEGIN
                GOTOXY(5, 4); WRITE('N Varenavn: ', navn);
                GOTOXY(5, 6); WRITE('P Enhedspris: ', pris : 7 : 2);
                GOTOXY(5, 8); WRITE('B Varebeholdning: ', beholdning);
                GOTOXY(5, 10); WRITE('M Minimumsbeholdning: ', minimum);
                GOTOXY(5, 12); WRITE('F FÆRDIG');
                REPEAT
                  GOTOXY(0, 14); WRITE(CLREOS);
                  GOTOXY(5, 14); WRITE('Tast kommando (N/P/B/M/F): ');
                  REPEAT
                    READ(KBD, ch);
                  UNTIL ch IN (.'N', 'n', 'P', 'p', 'B', 'b',
                                'M', 'm', 'F', 'f'.);
                  WRITE(ch);
                  IF NOT (ch IN (.'F', 'f'.))
                    THEN
                      BEGIN
                        GOTOXY(5, 16); WRITE('Tast ny værdi: ');
                      END;
                  CASE ch OF
                    'N', 'n' : READ(navn);
                    'P', 'p' : READ(pris);
                    'B', 'b' : READ(beholdning);
                    'M', 'm' : READ(minimum);
                  END;
                  IF NOT (ch IN (.'F', 'f'.))
                    THEN
                      BEGIN
                        GOTOXY(5, 18);
                        retur;
                      END;
                UNTIL ch IN (.'F', 'f'.);
                WRITE(artikelfil, vare);
              END;
          END;
    END; (* ret *)
  
  PROCEDURE indsaet;
  
    VAR
      nyvare : varepost;
      indexnummer, nummer, i : INTEGER;
    
    BEGIN (* indsaet *)
      WRITE(CLRHOM);
      GOTOXY(5, 0); WRITE('NY VARE I LAGERREGISTERET');
      GOTOXY(5, 2); WRITE('Tast varenummer: ');
      READLN(nummer);
      (* Findes varen i forvejen? *)
      i := 1;
      WHILE (index(.i.).varenummer < nummer) AND (i < postantal) DO
        i := i + 1;
      IF index(.i.).varenummer = nummer
        THEN
          BEGIN
            GOTOXY(5, 4); WRITE('Dette varenummer findes allerede');
          END
        ELSE
          BEGIN
            IF postantal = 0 (* Helt tomt register *)
              THEN
                BEGIN
                  postantal := 1;
                  indexnummer := 1;
                  index(.1.).varenummer := nummer;
                  index(.1.).postnummer := 0;
                END
            ELSE IF index(.1.).varenummer < 0 (* Gl post kan bruges *)
              THEN
                BEGIN
                  indexnummer := 1;
                  index(.1.).varenummer := nummer;
                END
            ELSE (* Tilføj ny post *)
              BEGIN
                postantal := postantal + 1;
                indexnummer := postantal;
                index(.indexnummer.).varenummer := nummer;
                index(.indexnummer.).postnummer := postantal - 1;
              END;
            WITH nyvare DO
              BEGIN
                nr := nummer;
                GOTOXY(5, 4); WRITE('Varenavn: ');
                READ(navn);
                GOTOXY(5, 6); WRITE('Enhedspris: ');
                READ(pris);
                GOTOXY(5, 8); WRITE('Varebeholdning: ');
                READ(beholdning);
                GOTOXY(5, 10); WRITE('Minimumsbeholdning: ');
                READ(minimum);
              END;
            SEEK(artikelfil, index(.indexnummer.).postnummer);
            WRITE(artikelfil, nyvare);
            sorter;
          END;
      GOTOXY(5, 12);
      retur;
    END; (* indsaet *)
  
  BEGIN (* varefil *)
    WRITE(CLRHOM);
    GOTOXY(5, 2); WRITE('V A R E R E G I S T E R');
    GOTOXY(5, 4); WRITE('Skal der oprettes et nyt vareregister (J/N): ');
    REPEAT
      READ(KBD, ch);
    UNTIL ch IN (.'J', 'j', 'N', 'n'.);
    IF ch IN (.'J', 'j'.)
      THEN opret
      ELSE hvilkefiler;
    REPEAT
      WRITE(CLRHOM);
      GOTOXY(5, 2); WRITE('V A R E R E G I S T E R');
      GOTOXY(5, 6); WRITE('U Udskrive hele vareregisteret');
      GOTOXY(5, 8); WRITE('L Læse eller rette en varepost');
      GOTOXY(5, 10); WRITE('S Slette en varepost');
      GOTOXY(5, 12); WRITE('I Indsætte en ny varepost');
      GOTOXY(5, 14); WRITE('A Afslutte programkørslen');
      GOTOXY(5, 18); WRITE('Tast kommando (U/L/S/I/A): ');
      REPEAT
        READ(KBD, ch);
      UNTIL ch IN (.'U', 'u', 'L', 'l', 'S', 's', 'I', 'i', 'A', 'a'.);
      WRITE(ch);
      CASE ch OF
        'U', 'u' : udskriv;
        'L', 'l' : ret;
        'S', 's' : slet;
        'I', 'i' : indsaet;
      END;
    UNTIL ch IN (.'A', 'a'.);
    SEEK(indexfil, 0);
    FOR i := 1 TO postantal DO
      WRITE(indexfil, index(.i.));
    CLOSE(artikelfil);
    CLOSE(indexfil);
    WRITELN;
  END. (* varefil *)
«eof»