DataMuseum.dk

top - metrics - download

    Length: 1920 (0x780)
    Types: TextFile
    Names: »CPRDATO2.PAS«

└─⟦08ea08c61⟧ Bits:30003924 PolyPascal programmer
    └─⟦this⟧ »CPRDATO2.PAS« 
└─⟦092727b26⟧ Bits:30005927 Demoprogrammer til Pascal bog (Jet-80)
    └─⟦this⟧ »CPRDATO2.PAS« 
└─⟦3702e543b⟧ Bits:30003064 Demoprogrammer A-J til Pascal bog
    └─⟦this⟧ »CPRDATO2.PAS« 

TextFile

PROGRAM cprdato2;

  TYPE
    str6 = STRING(.6.);
    arr = ARRAY(.1 .. 6.) OF INTEGER;
    
  VAR
    str : str6;
    cif : arr;
    g, h, i, datosum, gsum, hsum, isum, check, j : INTEGER;
    dag, maaned, aar : INTEGER;
    ok : BOOLEAN;
    
  BEGIN
    WRITE(CLRHOM);
    REPEAT
      REPEAT
        GOTOXY(10, 5);
        WRITE('Indtast en dato således: DDMMÅÅ');
        GOTOXY(35, 6);
        WRITE(CLREOL);
        BUFLEN := 6;
        READLN(str);
        ok := TRUE;
        IF LEN(str) < 6
          THEN ok := FALSE
          ELSE
            FOR j := 1 TO 6 DO
              IF (str(.j.) < '0') OR ('9' < str(.j.))
                THEN ok := FALSE;
      UNTIL ok;
      FOR j := 1 TO 6 DO
        cif(.j.) := ORD(str(.j.)) - ORD('0');
      dag := cif(.1.) * 10 + cif(.2.);
      maaned := cif(.3.) * 10 + cif(.4.);
      aar := cif(.5.) * 10 + cif(.6.);
      IF (dag = 0) OR (dag > 31) OR (maaned = 0) OR (maaned > 12)
        THEN  ok := FALSE;
      IF ((maaned = 4) OR (maaned = 6) OR (maaned = 9) OR (maaned = 11))
                       AND (dag = 31)
        THEN ok := FALSE;
      IF (dag = 29) AND (maaned = 2) AND ((aar MOD 4 <> 0) OR (aar = 0))
        THEN ok := FALSE
    UNTIL ok;      
    datosum := cif(.1.) * 4 + cif(.2.) * 3 + cif(.3.) * 2 
             + cif(.4.) * 7 + cif(.5.) * 6 + cif(.6.) * 5;
    WRITELN;
    FOR g := 0 TO 9 DO
      BEGIN
        gsum := datosum + g * 4;
        FOR h := 0 TO 9 DO
          BEGIN
            hsum := gsum + h * 3;
            FOR i := 0 TO 9 DO
              BEGIN
                isum := hsum + i * 2;
                FOR check := 0 TO 9 DO
                  IF (isum + check) MOD 11 = 0
                    THEN WRITE(str, '-', g, h, i, check, '     ');
              END;
          END;
      END;
    WRITELN;
  END.
«eof»