home *** CD-ROM | disk | FTP | other *** search
/ ftp.barnyard.co.uk / 2015.02.ftp.barnyard.co.uk.tar / ftp.barnyard.co.uk / cpm / walnut-creek-CDROM / CPM / TURBOPAS / TP-UTIL.ARK / SCREEN.PAS < prev    next >
Pascal/Delphi Source File  |  1986-01-06  |  6KB  |  201 lines
  1. {-----------------------------}
  2. {            SCREEN           }
  3. {      by Jeff Duntemann      }
  4. {                             }
  5. {  Screen input demo program  }
  6. {                             }
  7. {      Turbo Pascal V2.0      }
  8. {      Last Update 3/9/85     }
  9. {-----------------------------}
  10.  
  11.  
  12. PROGRAM SCREEN;
  13.  
  14. {$V-}  { Allow length mismatch for string VAR parameters.  See 23.4 }
  15.  
  16. CONST CAPSLOCK      = TRUE;
  17.       NO_CAPSLOCK   = FALSE;
  18.       NUMERIC       = TRUE;
  19.       NON_NUMERIC   = FALSE;
  20.  
  21. TYPE STRING80 = STRING[80];
  22.      STRING30 = STRING[30];
  23.      STRING6  = STRING[6];
  24.      STRING4  = STRING[4];
  25.      STRING3  = STRING[3];
  26.  
  27.      NAPREC   = RECORD
  28.                   NAME    : STRING30;
  29.                   ADDRESS : STRING30;
  30.                   CITY    : STRING30;
  31.                   STATE   : STRING3;
  32.                   ZIP     : STRING6
  33.                 END;
  34.  
  35.      GRAFREC = RECORD        { For drawing boxes }
  36.                  UL_CORNER,
  37.                  UR_CORNER,
  38.                  LL_CORNER,
  39.                  LR_CORNER,
  40.                  H_BAR,
  41.                  V_BAR,
  42.                  LINE_CROSS,
  43.                  T_DOWN,
  44.                  T_UP,
  45.                  T_RIGHT,
  46.                  T_LEFT     : STRING[4]
  47.                END;
  48.  
  49.  
  50. VAR  CH             : CHAR;
  51.      CURRENT_RECORD : NAPREC;
  52.      GRAFCHARS      : GRAFREC;
  53.      EDIT           : BOOLEAN;
  54.      QUIT           : BOOLEAN;
  55.      ESCAPE         : BOOLEAN;
  56.      WIDTH,HEIGHT   : INTEGER;
  57.      I,J            : INTEGER;
  58.      R              : REAL;
  59.  
  60.  
  61. PROCEDURE BEEP;
  62.  
  63. BEGIN
  64.   WRITE(CHR(7))
  65. END;
  66.  
  67.  
  68. FUNCTION YES : BOOLEAN;     { Described in Section 17.2 }
  69.  
  70. VAR CH : CHAR;
  71.  
  72. BEGIN
  73.   READ(CH);
  74.   IF CH IN ['Y','y'] THEN YES := TRUE ELSE YES := FALSE
  75. END;
  76.  
  77.  
  78.  
  79. PROCEDURE DEFINE_CHARS(VAR GRAFCHARS : GRAFREC);
  80.  
  81. BEGIN
  82.   WITH GRAFCHARS DO
  83.     BEGIN
  84.       UL_CORNER := CHR(201);
  85.       UR_CORNER := CHR(187);
  86.       LL_CORNER := CHR(200);
  87.       LR_CORNER := CHR(188);
  88.       H_BAR     := CHR(205);
  89.       V_BAR     := CHR(186);
  90.       LINE_CROSS := CHR(206);
  91.       T_DOWN     := CHR(203);
  92.       T_UP       := CHR(202);
  93.       T_RIGHT    := CHR(185);
  94.       T_LEFT     := CHR(204)
  95.     END
  96. END;
  97.  
  98.  
  99. PROCEDURE MAKE_BOX(X,Y,WIDTH,HEIGHT : INTEGER;
  100.                    GRAFCHARS        : GRAFREC);
  101.  
  102. VAR I,J : INTEGER;
  103.  
  104. BEGIN
  105.   IF X < 0 THEN X := (80-WIDTH) DIV 2;    { Negative X centers box }
  106.   WITH GRAFCHARS DO
  107.     BEGIN                                 { Draw top line }
  108.       GOTOXY(X,Y); WRITE(UL_CORNER);
  109.       FOR I := 3 TO WIDTH DO WRITE(H_BAR);
  110.       WRITE(UR_CORNER);
  111.                                           { Draw bottom line }
  112.       GOTOXY(X,(Y+HEIGHT)-1); WRITE(LL_CORNER);
  113.       FOR I := 3 TO WIDTH DO WRITE(H_BAR);
  114.       WRITE(LR_CORNER);
  115.                                           { Draw sides }
  116.       FOR I := 1 TO HEIGHT-2 DO
  117.         BEGIN
  118.           GOTOXY(X,Y+I); WRITE(V_BAR);
  119.           GOTOXY((X+WIDTH)-1,Y+I); WRITE(V_BAR)
  120.         END
  121.     END
  122. END;
  123.  
  124.  
  125. {$I KEYSTAT.SRC }    { Described in Section 20.6 }
  126.  
  127. {$I GETSTRIN.SRC }   { Described in Section 15.2 }
  128.  
  129.  
  130. PROCEDURE GET_SCREEN(VAR SCREEN_DATA : NAPREC;
  131.                          EDIT        : BOOLEAN;
  132.                      VAR ESCAPE      : BOOLEAN);
  133.  
  134. BEGIN
  135.   MAKE_BOX(1,1,79,20,GRAFCHARS);        { Draw the screen box }
  136.   IF NOT EDIT THEN WITH SCREEN_DATA DO  { If not editing, clear record }
  137.     BEGIN
  138.       NAME := ''; ADDRESS := ''; CITY := ''; STATE := ''; ZIP := ''
  139.     END;
  140.   GOTOXY(23,2);
  141.   WRITELN('<< Name / Address Entry Screen >>');
  142.   WITH SCREEN_DATA DO
  143.     BEGIN                        { First draw field frames: }
  144.       GOTOXY(5,7);
  145.       WRITE('>>Customer Name:    |..............................|');
  146.       GOTOXY(5,9);
  147.       WRITE('>>Customer Address: |..............................|');
  148.       GOTOXY(5,11);
  149.       WRITE('>>Customer City:    |..............................|');
  150.       GOTOXY(5,13);
  151.       WRITE('>>Customer State:   |...|');
  152.       GOTOXY(5,15);
  153.       WRITE('>>Customer Zip:     |......| ');
  154.       IF EDIT THEN WITH SCREEN_DATA DO  { If editing, show current values }
  155.         BEGIN
  156.           GOTOXY(26,7);  WRITE(NAME);
  157.           GOTOXY(26,9);  WRITE(ADDRESS);
  158.           GOTOXY(26,11); WRITE(CITY);
  159.           GOTOXY(26,13); WRITE(STATE);
  160.           GOTOXY(26,15); WRITE(ZIP)
  161.         END;                            { Now input/edit field data: }
  162.       GETSTRING(25,7,NAME,30,NO_CAPSLOCK,NON_NUMERIC,FALSE,R,I,J,ESCAPE);
  163.       IF NOT ESCAPE THEN
  164.         GETSTRING(25,9,ADDRESS,30,NO_CAPSLOCK,NON_NUMERIC,FALSE,R,I,J,ESCAPE);
  165.       IF NOT ESCAPE THEN
  166.         GETSTRING(25,11,CITY,30,NO_CAPSLOCK,NON_NUMERIC,FALSE,R,I,J,ESCAPE);
  167.       IF NOT ESCAPE THEN
  168.         GETSTRING(25,13,STATE,3,CAPSLOCK,NON_NUMERIC,FALSE,R,I,J,ESCAPE);
  169.       IF NOT ESCAPE THEN
  170.         GETSTRING(25,15,ZIP,6,CAPSLOCK,NON_NUMERIC,FALSE,R,I,J,ESCAPE);
  171.     END
  172. END;
  173.  
  174.  
  175. BEGIN        { SCREEN MAIN }
  176.   DEFINE_CHARS(GRAFCHARS);        { Load box drawing characters }
  177.   EDIT := FALSE;
  178.   REPEAT
  179.     CLRSCR;
  180.     GET_SCREEN(CURRENT_RECORD,EDIT,ESCAPE);  { Input/edit a data screen }
  181.     IF ESCAPE THEN QUIT := TRUE ELSE         { Quit if ESC pressed }
  182.       BEGIN                                  { Otherwise summarize data }
  183.         QUIT := FALSE;                       { and ask for approval }
  184.         GOTOXY(1,22);
  185.         WRITE('>>Summary: ');
  186.         WITH CURRENT_RECORD DO
  187.           BEGIN
  188.             WRITE(NAME,'/',ADDRESS,'/',ZIP);
  189.             GOTOXY(1,23); WRITE('>>OK? (Y/N): ');
  190.             IF YES THEN EDIT := FALSE ELSE EDIT := TRUE
  191.           END
  192.       END
  193.   UNTIL QUIT;
  194.   GOTOXY(1,22)
  195. END.
  196.  
  197. 0            ;  AND SOURCE INDEX
  198. ;
  199. ; LOOP TO COPY EVEN LINES
  200. ;
  201.