DataMuseum.dk

top - download

    Length: 2432 (0x980)
    Types: TextFile
    Names: »NAVNSOEG.PAS«

└─⟦09235ab48⟧ Bits:30003065 Demoprogrammer K-Z til Pascal bog
    └─ ⟦this⟧ »NAVNSOEG.PAS« 
└─⟦092727b26⟧ Bits:30005927 Demoprogrammer til Pascal bog (Jet-80)
    └─ ⟦this⟧ »NAVNSOEG.PAS« 
└─⟦f983c2ef3⟧ Bits:30004681 Pascal opgaver (Butler)
    └─ ⟦this⟧ »NAVNSOEG.PAS« 

TextFile

PROGRAM navnsoeg;

  CONST
    max = 200;
  
  TYPE
    str30 = STRING(.30.);
    arraytype = ARRAY(.1 .. max.) OF str30;
  
  VAR
    kartotek : arraytype;
    artikel : str30;
    i, antal : INTEGER;
    
  PROCEDURE indlaes(VAR kartotek : arraytype; VAR n : INTEGER);
  
    VAR
      vare : str30;
      i : INTEGER;
    
    BEGIN (* indlaes *)
      WRITE(CLRHOM);
      i := 0;
      WRITELN('Indtast varer til varekartoteket (0 stopper):');
      REPEAT
        i := i + 1;
        WRITE(': '); READLN(vare);
        IF vare <> '0'
          THEN kartotek(.i.) := vare;
      UNTIL (vare = '0') OR (i = max);
      IF i = max
        THEN n := max
        ELSE n := i - 1;
    END; (* indlaes *)
  
  PROCEDURE sorter(venstre, hoejre : INTEGER; VAR register : arraytype);
  
    VAR
      i, j, midt, v, h : INTEGER;
      naeste : str30;
      
    BEGIN (* sorter *)
      FOR i := venstre + 1 TO hoejre DO
        BEGIN
          naeste := register(.i.);
          v := venstre;
          h := i - 1;
          WHILE v <= h DO
            BEGIN
              midt := (v + h) DIV 2;
              IF naeste < register(.midt.)
                THEN h := midt - 1
                ELSE v := midt + 1;
            END;
          FOR j := i - 1 DOWNTO v DO
            register(.j + 1.) := register(.j.);
          register(.v.) := naeste;
        END;
    END; (* sorter *)
    
  FUNCTION fundet(venstre, hoejre : INTEGER ; artikel : str30;
                  VAR varekartotek : arraytype) : BOOLEAN;
  
    VAR
      midt : INTEGER;
    
    BEGIN (* fundet *)
      REPEAT
        midt := (venstre + hoejre) DIV 2;
        IF artikel > varekartotek(.midt.)
          THEN venstre := midt + 1
          ELSE hoejre := midt - 1;
      UNTIL (artikel = varekartotek(.midt.)) OR (hoejre < venstre);
      IF artikel = varekartotek(.midt.)
        THEN fundet := TRUE
        ELSE fundet := FALSE;
    END; (* fundet *)
  
  BEGIN
    indlaes(kartotek, antal);
    sorter(1, antal, kartotek);
    FOR i := 1 TO antal DO
      WRITELN('*** ', kartotek(.i.));
    WRITE('Hvilken vare skal søges i kartoteket: '); READLN(artikel);
    IF fundet(1, antal, artikel, kartotek)
      THEN WRITELN(artikel, ' findes i varekartoteket')
      ELSE WRITELN(artikel, ' findes ikke i varekartoteket');
  END.
«eof»