home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
World of Shareware - Software Farm 2
/
wosw_2.zip
/
wosw_2
/
PASCAL
/
MADTRB21.ZIP
/
SCREEN.PAS
< prev
next >
Wrap
Pascal/Delphi Source File
|
1985-06-06
|
6KB
|
197 lines
{-----------------------------}
{ SCREEN }
{ by Jeff Duntemann }
{ }
{ Screen input demo program }
{ }
{ Turbo Pascal V2.0 }
{ Last Update 3/9/85 }
{-----------------------------}
PROGRAM SCREEN;
{$V-} { Allow length mismatch for string VAR parameters. See 23.4 }
CONST CAPSLOCK = TRUE;
NO_CAPSLOCK = FALSE;
NUMERIC = TRUE;
NON_NUMERIC = FALSE;
TYPE STRING80 = STRING[80];
STRING30 = STRING[30];
STRING6 = STRING[6];
STRING4 = STRING[4];
STRING3 = STRING[3];
NAPREC = RECORD
NAME : STRING30;
ADDRESS : STRING30;
CITY : STRING30;
STATE : STRING3;
ZIP : STRING6
END;
GRAFREC = RECORD { For drawing boxes }
UL_CORNER,
UR_CORNER,
LL_CORNER,
LR_CORNER,
H_BAR,
V_BAR,
LINE_CROSS,
T_DOWN,
T_UP,
T_RIGHT,
T_LEFT : STRING[4]
END;
VAR CH : CHAR;
CURRENT_RECORD : NAPREC;
GRAFCHARS : GRAFREC;
EDIT : BOOLEAN;
QUIT : BOOLEAN;
ESCAPE : BOOLEAN;
WIDTH,HEIGHT : INTEGER;
I,J : INTEGER;
R : REAL;
PROCEDURE BEEP;
BEGIN
WRITE(CHR(7))
END;
FUNCTION YES : BOOLEAN; { Described in Section 17.2 }
VAR CH : CHAR;
BEGIN
READ(CH);
IF CH IN ['Y','y'] THEN YES := TRUE ELSE YES := FALSE
END;
PROCEDURE DEFINE_CHARS(VAR GRAFCHARS : GRAFREC);
BEGIN
WITH GRAFCHARS DO
BEGIN
UL_CORNER := CHR(201);
UR_CORNER := CHR(187);
LL_CORNER := CHR(200);
LR_CORNER := CHR(188);
H_BAR := CHR(205);
V_BAR := CHR(186);
LINE_CROSS := CHR(206);
T_DOWN := CHR(203);
T_UP := CHR(202);
T_RIGHT := CHR(185);
T_LEFT := CHR(204)
END
END;
PROCEDURE MAKE_BOX(X,Y,WIDTH,HEIGHT : INTEGER;
GRAFCHARS : GRAFREC);
VAR I,J : INTEGER;
BEGIN
IF X < 0 THEN X := (80-WIDTH) DIV 2; { Negative X centers box }
WITH GRAFCHARS DO
BEGIN { Draw top line }
GOTOXY(X,Y); WRITE(UL_CORNER);
FOR I := 3 TO WIDTH DO WRITE(H_BAR);
WRITE(UR_CORNER);
{ Draw bottom line }
GOTOXY(X,(Y+HEIGHT)-1); WRITE(LL_CORNER);
FOR I := 3 TO WIDTH DO WRITE(H_BAR);
WRITE(LR_CORNER);
{ Draw sides }
FOR I := 1 TO HEIGHT-2 DO
BEGIN
GOTOXY(X,Y+I); WRITE(V_BAR);
GOTOXY((X+WIDTH)-1,Y+I); WRITE(V_BAR)
END
END
END;
{$I KEYSTAT.SRC } { Described in Section 20.6 }
{$I GETSTRIN.SRC } { Described in Section 15.2 }
PROCEDURE GET_SCREEN(VAR SCREEN_DATA : NAPREC;
EDIT : BOOLEAN;
VAR ESCAPE : BOOLEAN);
BEGIN
MAKE_BOX(1,1,79,20,GRAFCHARS); { Draw the screen box }
IF NOT EDIT THEN WITH SCREEN_DATA DO { If not editing, clear record }
BEGIN
NAME := ''; ADDRESS := ''; CITY := ''; STATE := ''; ZIP := ''
END;
GOTOXY(23,2);
WRITELN('<< Name / Address Entry Screen >>');
WITH SCREEN_DATA DO
BEGIN { First draw field frames: }
GOTOXY(5,7);
WRITE('>>Customer Name: |..............................|');
GOTOXY(5,9);
WRITE('>>Customer Address: |..............................|');
GOTOXY(5,11);
WRITE('>>Customer City: |..............................|');
GOTOXY(5,13);
WRITE('>>Customer State: |...|');
GOTOXY(5,15);
WRITE('>>Customer Zip: |......| ');
IF EDIT THEN WITH SCREEN_DATA DO { If editing, show current values }
BEGIN
GOTOXY(26,7); WRITE(NAME);
GOTOXY(26,9); WRITE(ADDRESS);
GOTOXY(26,11); WRITE(CITY);
GOTOXY(26,13); WRITE(STATE);
GOTOXY(26,15); WRITE(ZIP)
END; { Now input/edit field data: }
GETSTRING(25,7,NAME,30,NO_CAPSLOCK,NON_NUMERIC,FALSE,R,I,J,ESCAPE);
IF NOT ESCAPE THEN
GETSTRING(25,9,ADDRESS,30,NO_CAPSLOCK,NON_NUMERIC,FALSE,R,I,J,ESCAPE);
IF NOT ESCAPE THEN
GETSTRING(25,11,CITY,30,NO_CAPSLOCK,NON_NUMERIC,FALSE,R,I,J,ESCAPE);
IF NOT ESCAPE THEN
GETSTRING(25,13,STATE,3,CAPSLOCK,NON_NUMERIC,FALSE,R,I,J,ESCAPE);
IF NOT ESCAPE THEN
GETSTRING(25,15,ZIP,6,CAPSLOCK,NON_NUMERIC,FALSE,R,I,J,ESCAPE);
END
END;
BEGIN { SCREEN MAIN }
DEFINE_CHARS(GRAFCHARS); { Load box drawing characters }
EDIT := FALSE;
REPEAT
CLRSCR;
GET_SCREEN(CURRENT_RECORD,EDIT,ESCAPE); { Input/edit a data screen }
IF ESCAPE THEN QUIT := TRUE ELSE { Quit if ESC pressed }
BEGIN { Otherwise summarize data }
QUIT := FALSE; { and ask for approval }
GOTOXY(1,22);
WRITE('>>Summary: ');
WITH CURRENT_RECORD DO
BEGIN
WRITE(NAME,'/',ADDRESS,'/',ZIP);
GOTOXY(1,23); WRITE('>>OK? (Y/N): ');
IF YES THEN EDIT := FALSE ELSE EDIT := TRUE
END
END
UNTIL QUIT;
GOTOXY(1,22)
END.