home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
World of Shareware - Software Farm 2
/
wosw_2.zip
/
wosw_2
/
PASCAL
/
MADTRB21.ZIP
/
GETSTRIN.SRC
< prev
next >
Wrap
Text File
|
1985-08-15
|
4KB
|
107 lines
PROCEDURE GETSTRING( X,Y : INTEGER;
VAR XSTRING : STRING80;
MAXLEN : INTEGER;
CAPSLOCK : BOOLEAN;
NUMERIC : BOOLEAN;
GET_REAL : BOOLEAN;
VAR RVALUE : REAL;
VAR IVALUE : INTEGER;
VAR ERROR : INTEGER;
VAR ESCAPE : BOOLEAN);
VAR I,J : INTEGER;
CH : CHAR;
CURSOR : CHAR;
DOT : CHAR;
BLENGTH : BYTE;
CLEARIT : STRING80;
WORKER : STRING80;
PRINTABLES : SET OF CHAR;
LOWERCASE : SET OF CHAR;
NUMERICS : SET OF CHAR;
CR : BOOLEAN;
BEGIN
PRINTABLES := [' '..'}']; { Init sets }
LOWERCASE := ['a'..'z'];
IF GET_REAL THEN NUMERICS := ['-','.','0'..'9','E','e']
ELSE NUMERICS := ['-','0'..'9'];
CURSOR := '_'; DOT := '.';
CR := FALSE; ESCAPE := FALSE;
FILLCHAR(CLEARIT,SIZEOF(CLEARIT),'.'); { Filex clear string }
CLEARIT[0] := CHR(MAXLEN); { Set clear string to MAXLEN }
{ Convert numbers to string if required: }
IF NUMERIC THEN { Convert zero values to null string: }
IF (GET_REAL AND (RVALUE = 0.0)) OR
(NOT GET_REAL AND (IVALUE = 0)) THEN XSTRING := ''
ELSE { Convert nonzero values to string equiv: }
IF GET_REAL THEN STR(RVALUE:MAXLEN,XSTRING)
ELSE STR(IVALUE:MAXLEN,XSTRING);
{ Truncate string value to MAXLEN }
IF LENGTH(XSTRING) > MAXLEN THEN XSTRING[0] := CHR(MAXLEN);
GOTOXY(X,Y); WRITE('|',CLEARIT,'|'); { Draw the field }
GOTOXY(X+1,Y); WRITE(XSTRING);
IF LENGTH(XSTRING)<MAXLEN THEN
BEGIN
GOTOXY(X + LENGTH(XSTRING) + 1,Y);
WRITE(CURSOR) { Draw the cursor }
END;
WORKER := XSTRING; { Fill work string with input string }
REPEAT { Until ESC or (CR) entered }
{ Wait here for keypress: }
WHILE NOT KEYSTAT(CH) DO BEGIN {NULL} END;
IF CH IN PRINTABLES THEN { If CH is printable... }
IF LENGTH(WORKER) >= MAXLEN THEN BEEP ELSE
IF NUMERIC AND (NOT (CH IN NUMERICS)) THEN BEEP ELSE
BEGIN
IF CH IN LOWERCASE THEN IF CAPSLOCK THEN CH := CHR(ORD(CH)-32);
WORKER := CONCAT(WORKER,CH);
GOTOXY(X+1,Y); WRITE(WORKER);
IF LENGTH(WORKER) < MAXLEN THEN WRITE(CURSOR)
END
ELSE { If CH is NOT printable... }
CASE ORD(CH) OF
8,127 : IF LENGTH(WORKER) <= 0 THEN BEEP ELSE
BEGIN
DELETE(WORKER,LENGTH(WORKER),1);
GOTOXY(X+1,Y); WRITE(WORKER,CURSOR);
IF LENGTH(WORKER)<MAXLEN-1 THEN WRITE(DOT);
END;
13 : CR := TRUE; { Carriage return }
24 : BEGIN { CTRL-X : Blank the field }
GOTOXY(X+1,Y); WRITE(CLEARIT);
WORKER := ''; { Blank out work string }
END;
27 : ESCAPE := TRUE; { ESC }
ELSE BEEP { CASE ELSE }
END; { CASE }
UNTIL CR OR ESCAPE; { Get keypresses until (CR) or }
{ ESC pressed }
GOTOXY(X+1,Y); WRITE(CLEARIT);
GOTOXY(X+1,Y); WRITE(WORKER);
IF CR THEN { Don't update XSTRING if ESC hit }
BEGIN
XSTRING := WORKER;
IF NUMERIC THEN { Convert string to numeric values }
CASE GET_REAL OF
TRUE : VAL(WORKER,RVALUE,ERROR);
FALSE : VAL(WORKER,IVALUE,ERROR)
END { CASE }
ELSE
BEGIN
RVALUE := 0.0;
IVALUE := 0
END
END
END; { GETSTRING }