home *** CD-ROM | disk | FTP | other *** search
/ Power-Programmierung / CD1.mdf / pascal / library / dos / sampler / 03 / diverse / tp40tips.pas < prev   
Encoding:
Pascal/Delphi Source File  |  1988-09-09  |  4.6 KB  |  214 lines
  1. { TP40TIPS.PAS }
  2. {
  3. Description:  Routines for "bulletproof" entry of integer and real values
  4.               without using the modified READ/READLN of Turbo Pascal 4.0.
  5.  
  6. Author:       Stephen Lowens
  7. Date:         1/3/88
  8. Application:  IBM PC or compatible, Turbo Pascal 4.0
  9.  
  10. }
  11.  
  12.  
  13. USES CRT;
  14.  
  15. PROCEDURE BEEP;
  16. BEGIN
  17. SOUND(440);
  18. DELAY(200);
  19. NOSOUND;
  20. END;
  21.  
  22. PROCEDURE GETINTEGER(VAR VALUE:INTEGER; LOW,HIGH:INTEGER);
  23. VAR  OK                      : BOOLEAN;
  24.      TEMPX,TEMPY,CO,CO1,CO2  : BYTE;
  25.      INV,RET,BAK,PLUS,MINUS  : CHAR;
  26.      TEMPVAL                 : LONGINT;
  27.      NEGATIVE,SYMBOL         : BOOLEAN;
  28. LABEL AGAIN;
  29.  
  30. BEGIN
  31. RET   := CHR(13);
  32. BAK   := CHR(8);
  33. PLUS  := CHR(43);
  34. MINUS := CHR(45);
  35. OK    := FALSE;
  36. TEMPX := WHEREX;
  37. TEMPY := WHEREY;
  38. REPEAT
  39.    CO       := 0;
  40.    TEMPVAL  := 0;
  41.    NEGATIVE := FALSE;
  42.    SYMBOL   := FALSE;
  43.    REPEAT
  44.       BEGIN
  45. AGAIN:
  46.       INV := READKEY;
  47.       IF CO = 0 THEN
  48.          IF INV IN [PLUS,MINUS] THEN
  49.             BEGIN
  50.             IF INV = MINUS THEN NEGATIVE := TRUE;
  51.             WRITE(INV);
  52.             SYMBOL := TRUE;
  53.             GOTO AGAIN;
  54.             END;
  55.       IF INV IN [BAK,RET,'0'..'9'] THEN
  56.          BEGIN
  57.          IF INV IN ['0'..'9'] THEN
  58.             BEGIN
  59.             CO := CO + 1;
  60.             WRITE(INV);
  61.             TEMPVAL := TEMPVAL*10  + ORD(INV) - 48;
  62.             END
  63.          ELSE
  64.          IF INV = BAK THEN
  65.             BEGIN
  66.             GOTOXY(WHEREX-1,WHEREY);
  67.             WRITE(' ');
  68.             GOTOXY(WHEREX-1,WHEREY);
  69.             TEMPVAL := TEMPVAL DIV 10;
  70.             CO := CO - 1;
  71.             END;
  72.          END
  73.       ELSE
  74.          BEEP
  75.       END;
  76.    UNTIL (INV = RET) OR (CO > 6);
  77. IF (LOW<= TEMPVAL) AND (TEMPVAL<= HIGH) THEN
  78.   OK := TRUE
  79. ELSE
  80.       BEGIN
  81.       BEEP;
  82.       GOTOXY(TEMPX,TEMPY);
  83.       CO1 := 0;
  84.       REPEAT
  85.         CO1 := CO1 + 1;
  86.         TEMPVAL := TEMPVAL DIV 10;
  87.       UNTIL TEMPVAL = 0;
  88.       FOR CO2 := 1 TO CO1 DO WRITE(' ');
  89.       IF SYMBOL = TRUE THEN WRITE(' ');
  90.       GOTOXY(TEMPX,TEMPY);
  91.       END;
  92. UNTIL OK;
  93. VALUE := TEMPVAL;
  94. IF NEGATIVE = TRUE THEN VALUE := VALUE * (-1);
  95. IF CO = 0 THEN VALUE := 0;
  96. IF VALUE = 0 THEN
  97.    BEGIN
  98.    GOTOXY(TEMPX,TEMPY);
  99.    WRITE(VALUE);
  100.    END;
  101. END;
  102.  
  103. PROCEDURE GETREAL(VAR VALUE:REAL);
  104.  
  105. VAR  OK                          : BOOLEAN;
  106.      TEMPX,TEMPY,CO,CO2,I        : BYTE;
  107.      CO1                         : SHORTINT;
  108.      INV,RET,BAK,PER,PLUS,MINUS  : CHAR;
  109.      NEGATIVE,SYMBOL,PER1        : BOOLEAN;
  110.      ST1,ST2                     : STRING;
  111.      TENS                        : REAL;
  112. LABEL AGAIN,ONWEGO;
  113.  
  114. BEGIN
  115. RET   := CHR(13);
  116. BAK   := CHR(8);
  117. PLUS  := CHR(43);
  118. MINUS := CHR(45);
  119. PER   := CHR(46);
  120. TEMPX := WHEREX;
  121. TEMPY := WHEREY;
  122. CO    := 0;
  123. VALUE := 0;
  124. ST1   := '';
  125. OK       := FALSE;
  126. NEGATIVE := FALSE;
  127. SYMBOL   := FALSE;
  128. PER1     := FALSE;
  129. REPEAT
  130.    BEGIN
  131. AGAIN:
  132.    INV := READKEY;
  133.    IF CO = 0 THEN
  134.       IF INV IN [PLUS,MINUS] THEN
  135.          BEGIN
  136.          IF INV = MINUS THEN NEGATIVE := TRUE;
  137.          WRITE(INV);
  138.          SYMBOL := TRUE;
  139.          GOTO AGAIN;
  140.          END;
  141.    IF INV IN [BAK,RET,PER,'0'..'9'] THEN
  142.       BEGIN
  143.       IF INV = PER THEN
  144.         IF PER1 THEN
  145.            BEEP
  146.         ELSE
  147.            BEGIN
  148.            PER1 := TRUE;
  149.            CO := CO + 1;
  150.            WRITE(INV);
  151.            ST1 := ST1 + INV;
  152.            END
  153.         ELSE
  154.         IF INV IN ['0'..'9'] THEN
  155.            BEGIN
  156.            CO := CO + 1;
  157.            WRITE(INV);
  158.            ST1 := ST1 + INV;
  159.            END
  160.         ELSE
  161.         IF INV = BAK THEN
  162.            BEGIN
  163.            GOTOXY(WHEREX-1,WHEREY);
  164.            WRITE(' ');
  165.            GOTOXY(WHEREX-1,WHEREY);
  166.            ST2 := '';
  167.            FOR I := 1 TO (CO-1) DO
  168.               ST2 := ST2 + ST1[I];
  169.            ST1 := ST2;
  170.            CO := CO - 1;
  171.            END;
  172.       END
  173.    ELSE
  174.       BEEP
  175.    END;
  176. UNTIL INV = RET;
  177. IF CO > 0 THEN
  178.    BEGIN
  179.    CO1 := 0;
  180.    OK := FALSE;
  181.    REPEAT
  182.    CO1 := CO1 + 1;
  183.    IF ST1[CO1] = PER THEN
  184.       BEGIN
  185.       OK := TRUE;
  186.       GOTO ONWEGO;
  187.       END;
  188.    UNTIL CO1 = CO;
  189. ONWEGO:
  190.    TENS := 1;
  191.    IF OK THEN CO1 := CO1 - 1;
  192.    IF CO1 > 0 THEN
  193.       FOR I := 1 TO CO1 DO
  194.          VALUE := VALUE*10.0  + ORD(ST1[I]) - 48;
  195.       IF OK THEN
  196.          BEGIN
  197.          CO2 := CO1 + 2;
  198.          IF CO2 <= CO THEN
  199.             FOR I := CO2 TO CO DO
  200.                BEGIN
  201.                TENS := TENS * 10.0;
  202.                VALUE := VALUE + ((ORD(ST1[I]) -48)/TENS);
  203.                END;
  204.          END;
  205.    END;
  206. IF NEGATIVE THEN VALUE := VALUE * (-1.0);
  207. IF VALUE = 0.0 THEN
  208.    BEGIN
  209.    GOTOXY(TEMPX,TEMPY);
  210.    WRITE(VALUE:3:1);
  211.    END;
  212. END;
  213. 
  214.