home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Frostbyte's 1980s DOS Shareware Collection
/
floppyshareware.zip
/
floppyshareware
/
USCX
/
TURBO-06.ZIP
/
SCREEN.INC
< prev
next >
Wrap
Text File
|
1985-02-23
|
21KB
|
633 lines
{.L+}
{ SCREEN PROCEDURES }
{procedure Frame(UpperLeftX, UpperLeftY, LowerRightX, LowerRightY: Integer);}
{FUNCTION READREAL(X,Y,LENGTH,FRACTION:INTEGER):REAL;}
{FUNCTION READINT(X,Y,LENGTH:INTEGER):INTEGER;}
{FUNCTION READSTRING(X,Y,MAXLENGTH:INTEGER):XXXSTR80;}
{FUNCTION READDATE(X,Y:INTEGER):XXXSTR8;}
{.L-}
{.R-}
procedure Frame(UpperLeftX, UpperLeftY, LowerRightX, LowerRightY: Integer);
var
i: Integer;
begin
GotoXY(UpperLeftX, UpperLeftY); Write(chr(218));
for i:=UpperLeftX+1 to LowerRightX-1 do Write(chr(196));
Write(chr(191));
for i:=UpperLeftY+1 to LowerRightY-1 do
begin
GotoXY(UpperLeftX , i); Write(chr(179));
GotoXY(LowerRightX, i); Write(chr(179));
end;
GotoXY(UpperLeftX, LowerRightY);
Write(chr(192));
for i:=UpperLeftX+1 to LowerRightX-1 do Write(chr(196));
Write(chr(217));
end { Frame };
{**********************************************************************}
FUNCTION READREAL(X,Y,LENGTH,FRACTION:INTEGER):REAL;
{ READS A REAL NUMBER AT LOCATION X,Y }
VAR
POSITION : INTEGER;
SECTION : INTEGER;
SPACEEND : INTEGER;
EXIT : BOOLEAN;
HOLDMAIN : REAL;
HOLDFRACTION : REAL;
DIGIT : INTEGER;
INCHAR : CHAR;
HOLD: REAL;
COUNT : INTEGER;
FUNCTION POWER(N:INTEGER):REAL;
{ RASES 10 TO THE SPECIFIED POWER }
VAR
HOLD : REAL;
I : INTEGER;
BEGIN
HOLD := 1;
FOR I := 1 TO N DO
HOLD := HOLD * 10.0;
POWER := HOLD;
END;
BEGIN
POSITION := 0;
IF LENGTH > FRACTION + 1 THEN
SECTION := 1
ELSE
BEGIN
POSITION := 1;
SECTION := 3;
END;
EXIT := FALSE;
GOTOXY(X,Y);
TEXTCOLOR(BLACK);
TEXTBACKGROUND(LIGHTGRAY);
WRITE(XXXSPACE(LENGTH-(FRACTION+1)),'.',XXXSPACE(FRACTION));
WHILE NOT EXIT DO
BEGIN
GOTOXY((X+POSITION),Y);
READ(KBD,INCHAR);
CASE SECTION OF
1: {SPACES BEFORE}
BEGIN
IF ((INCHAR = ' ') AND (POSITION < (LENGTH-FRACTION)))THEN
POSITION := POSITION + 1
ELSE
IF INCHAR IN ['1'..'9','0'] THEN
BEGIN
POSITION := POSITION + 1;
DIGIT := ORD(INCHAR)-48;
HOLDMAIN := DIGIT;
SECTION := 2;
WRITE(INCHAR);
SPACEEND := POSITION;
END
ELSE
IF ((INCHAR = CHR(7)) OR (INCHAR = CHR(8))) THEN
IF POSITION > 0 THEN
BEGIN
POSITION := POSITION - 1;
GOTOXY((X+POSITION),Y);
WRITE(' ');
END
ELSE
WRITE(CHR(7))
ELSE
WRITE(CHR(7));
END;
2: {MAIN PART}
BEGIN
IF INCHAR IN ['1'..'9','0'] THEN
BEGIN {CHARATER IS DIGIT ADD TO MAIN}
WRITE(INCHAR);
DIGIT := ORD(INCHAR)-48;
HOLDMAIN := (HOLDMAIN * 10.0) + DIGIT;
POSITION := POSITION + 1;
IF POSITION = (LENGTH - (FRACTION+1)) THEN
BEGIN {SWITCH TO FRACTION SECTION}
POSITION := POSITION + 1;
IF FRACTION > 0 THEN
BEGIN
COUNT := 0;
HOLDFRACTION := 0.0;
SECTION := 3;
END
ELSE
BEGIN
COUNT := 1;
HOLDFRACTION := 0.0;
SECTION := 4;
END;
END;
END
ELSE
IF ((INCHAR = CHR(8)) OR (INCHAR = CHR(7))) THEN
BEGIN {DELETE}
IF POSITION = SPACEEND THEN
BEGIN {SWITCH BACK UP TO SPACE SECTION}
SECTION := 1;
POSITION := POSITION - 1;
GOTOXY((X+POSITION),Y);
WRITE(' ');
END
ELSE
BEGIN {DELETE A DIGIT}
POSITION := POSITION - 1;
GOTOXY((X+POSITION),Y);
WRITE(' ');
HOLDMAIN := INT(HOLDMAIN/10.0);
END;
END
ELSE
IF ((INCHAR = CHR(11)) OR (INCHAR = CHR(13))) THEN
BEGIN {TOTALLY FINISH NUMBER}
EXIT := TRUE;
HOLDFRACTION := 0;
COUNT := 1;
END
ELSE
IF INCHAR = '.' THEN
BEGIN
GOTOXY(X,Y);
WRITE(HOLDMAIN:(LENGTH-FRACTION-1):0);
SECTION := 3;
POSITION := LENGTH-FRACTION;
HOLDFRACTION := 0.0;
COUNT := 0;
END
ELSE
BEGIN {ERROR}
WRITE(CHR(7));
END
END;
3: {FRACTION}
BEGIN
IF INCHAR IN ['1'..'9','0'] THEN
BEGIN {ADD TO FRACTION CHECK FOR END OF FRACTION}
POSITION := POSITION + 1;
WRITE(INCHAR);
DIGIT := ORD(INCHAR)-48;
HOLDFRACTION := (HOLDFRACTION*10.0) + DIGIT;
COUNT := COUNT + 1;
IF COUNT = FRACTION THEN
BEGIN { SWITCH TO EXIT HOLD SECTION}
SECTION := 4;
END
END
ELSE
IF ((INCHAR = CHR(7)) OR (INCHAR = CHR(8))) THEN
BEGIN {DELETE}
IF COUNT = 0 THEN
BEGIN {SWITCH TO MAIN SECTION }
POSITION := POSITION - 2;
GOTOXY((X+POSITION),Y);
WRITE(' ');
HOLDMAIN := INT(HOLDMAIN/10.0);
SECTION := 2;
END
ELSE
BEGIN
HOLDFRACTION := INT(HOLDFRACTION/10.0);
COUNT := COUNT -1;
POSITION := POSITION -1;
GOTOXY((X+POSITION),Y);
WRITE(' ');
END;
END
ELSE
IF ((INCHAR = CHR(11)) OR (INCHAR = CHR(13))) THEN
BEGIN {FINISH}
EXIT := TRUE;
IF COUNT = 0 THEN
BEGIN
COUNT := 1;
HOLDFRACTION := 0.0;
END;
END
ELSE
BEGIN {ERROR}
WRITE(CHR(7));
END
END;
4: {FINISHED}
BEGIN
IF ((INCHAR = CHR(7)) OR (INCHAR = CHR(8))) THEN
BEGIN {DELETE}
IF FRACTION = 0 THEN
BEGIN
SECTION := 2;
HOLDMAIN := INT(HOLDMAIN/10.0);
POSITION := POSITION - 1;
GOTOXY((X+POSITION),Y);
WRITE(' ');
END
ELSE
BEGIN
SECTION := 3;
HOLDFRACTION := INT(HOLDFRACTION/10.0);
COUNT := COUNT -1;
POSITION := POSITION -1;
GOTOXY((X+POSITION),Y);
WRITE(' ');
END;
END
ELSE
IF ((INCHAR = CHR(11)) OR (INCHAR = CHR(13))) THEN
BEGIN { EXIT}
EXIT := TRUE;
IF COUNT = 0 THEN
BEGIN
COUNT := 1;
HOLDFRACTION := 0.0;
END;
END
ELSE
BEGIN {ERROR}
WRITE(CHR(7));
END;
END;
END;
END;
HOLD := HOLDMAIN + (HOLDFRACTION/POWER(COUNT));
READREAL := HOLD;
GOTOXY(X,Y);
WRITE(HOLD:LENGTH:FRACTION);
TEXTCOLOR(LIGHTGRAY);
TEXTBACKGROUND(BLACK);
END;
{***************************************************************************}
FUNCTION READINT(X,Y,LENGTH:INTEGER):INTEGER;
{ READS A INTEGER NUMBER FROM THE SCREEN }
VAR
HOLD : REAL;
POWER : INTEGER;
DIGIT : INTEGER;
INCHAR : CHAR;
EXIT : BOOLEAN;
POSITION : INTEGER;
HOLD2 : INTEGER;
BEGIN
IF LENGTH > 5 THEN
LENGTH := 5;
EXIT := FALSE;
GOTOXY(X,Y);
TEXTCOLOR(BLACK);
TEXTBACKGROUND(LIGHTGRAY);
WRITE(XXXSPACE(LENGTH));
HOLD := 0;
POWER := 1;
POSITION := 0;
WHILE NOT EXIT DO
BEGIN
GOTOXY((X+POSITION),Y);
READ(KBD,INCHAR);
CASE ORD(INCHAR) OF
11,13:{RETURN OR LINEFEED}
IF HOLD > 32767.0 THEN
BEGIN
WRITE(CHR(7));
GOTOXY(X,Y);
HOLD :=0;
POWER := 1;
POSITION := 0;
WRITE(XXXSPACE(LENGTH),CHR(7));
END
ELSE
EXIT := TRUE;
7,8:{BACKSPACE OR CNTRL G}
BEGIN
IF POSITION > 0 THEN
BEGIN
POSITION := POSITION - 1;
GOTOXY((X+POSITION),Y);
WRITE(' ');
HOLD := INT(HOLD/10.0);
POWER := POWER DIV 10;
END
ELSE
WRITE(CHR(7));
END;
48..57:{NUMBERS}
IF POSITION < LENGTH THEN
IF (HOLD*10+(ORD(INCHAR)-48)) <=32767.0 THEN
BEGIN
HOLD := HOLD*10+(ORD(INCHAR)-48);
WRITE(INCHAR);
POSITION := POSITION + 1;
POWER := POWER * 10;
END
ELSE
WRITE(CHR(7));
ELSE
WRITE(CHR(7));
END;
END;
READINT := TRUNC(HOLD);
HOLD2 := TRUNC(HOLD);
GOTOXY(X,Y);
WRITE(HOLD2:LENGTH);
TEXTCOLOR(LIGHTGRAY);
TEXTBACKGROUND(BLACK);
END;
{***************************************************************************}
FUNCTION READSTRING(X,Y,MAXLENGTH:INTEGER):XXXSTR80;
{ READS A STRING OF MAXLENGTH 80 FROM THE TERMINAL }
VAR
HOLD : XXXSTR80;
EXIT : BOOLEAN;
INCHAR : CHAR;
COUNT : INTEGER;
BEGIN
COUNT := 0;
EXIT := FALSE;
GOTOXY(X,Y);
TEXTCOLOR(BLACK);
TEXTBACKGROUND(LIGHTGRAY);
WRITE(XXXSPACE(MAXLENGTH));
GOTOXY(X,Y);
HOLD := '';
WHILE NOT EXIT DO
BEGIN
READ(KBD,INCHAR);
CASE ORD(INCHAR) OF
13,10,11,12:
BEGIN
EXIT := TRUE;
END;
32..125:
BEGIN
IF COUNT < MAXLENGTH THEN
BEGIN
HOLD := HOLD + INCHAR;
WRITE(INCHAR);
COUNT := COUNT + 1;
END
ELSE
WRITE(CHR(7));
END;
8,7:
IF COUNT > 0 THEN
BEGIN
DELETE(HOLD,COUNT,1);
COUNT := COUNT - 1;
GOTOXY((X+COUNT),Y);
WRITE(' ');
GOTOXY((X+COUNT),Y);
END
ELSE
WRITE(CHR(7));
27:
BEGIN
HOLD := '';
COUNT := 0;
GOTOXY(X,Y);
WRITE(XXXSPACE(MAXLENGTH));
GOTOXY(X,Y);
END;
ELSE
BEGIN
WRITE(CHR(7));
GOTOXY(X,Y);
WRITE(XXXSPACE(MAXLENGTH));
GOTOXY(X,Y);
WRITE(HOLD);
GOTOXY((X+COUNT),Y);
END;
END;
END;
READSTRING :=HOLD;
TEXTCOLOR(LIGHTGRAY);
TEXTBACKGROUND(BLACK);
END;
{***************************************************************************}
FUNCTION READDATE(X,Y:INTEGER):XXXSTR8;
{ READS A STRING FROM THE TERMINAL FROM SCREEN AT POSITION XY }
{ THE STRING WILL CONTAIN A VALID DATE IN FORMAT 00/00/00 }
VAR
HOLD : ARRAY [1..6] OF CHAR;
LOCATION : INTEGER;
INCHAR : CHAR;
BEGIN
LOCATION := 1;
TEXTCOLOR(BLACK);
TEXTBACKGROUND(LIGHTGRAY);
GOTOXY(X,Y);
WRITE(' / / ');
GOTOXY(X,Y);
WHILE LOCATION<8 DO
BEGIN
READ(KBD,INCHAR);
CASE LOCATION OF
1:
BEGIN
GOTOXY(X,Y);
IF INCHAR IN ['1','0',' '] THEN
BEGIN
HOLD[1] := INCHAR;
WRITE(INCHAR);
LOCATION := 2;
GOTOXY((X+1),Y);
END
ELSE
BEGIN
WRITE(CHR(7));
END;
END;
2:
BEGIN
GOTOXY((X+1),Y);
IF INCHAR IN ['1'..'9','0'] THEN
IF HOLD[1]='1' THEN
IF INCHAR IN ['1','2','0'] THEN
BEGIN
HOLD[2] := INCHAR;
WRITE(INCHAR);
LOCATION := 3;
END
ELSE
BEGIN
WRITE(CHR(7));
END
ELSE
BEGIN
WRITE(INCHAR);
HOLD[2] := INCHAR;
LOCATION := 3;
END
ELSE
IF ((INCHAR = CHR(8)) OR (INCHAR = CHR(7))) THEN
BEGIN
GOTOXY(X,Y);
WRITE(' ');
LOCATION := 1;
HOLD[1] := ' ';
GOTOXY(X,Y);
END
ELSE
BEGIN
WRITE(CHR(7));
END;
END;
3:
BEGIN
GOTOXY((X+3),Y);
IF INCHAR IN ['1'..'3','0',' '] THEN
BEGIN
HOLD[3] := INCHAR;
WRITE(INCHAR);
LOCATION := 4;
GOTOXY((X+4),Y);
END
ELSE
IF ((INCHAR = CHR(8)) OR (INCHAR = CHR(7))) THEN
BEGIN
GOTOXY((X+1),Y);
WRITE(' ');
LOCATION := 2;
HOLD[2] := ' ';
GOTOXY((X+1),Y);
END
ELSE
BEGIN
WRITE(CHR(7));
END;
END;
4:
BEGIN
GOTOXY((X+4),Y);
IF INCHAR IN ['1'..'9','0'] THEN
BEGIN
HOLD[4] := INCHAR;
WRITE(INCHAR);
LOCATION := 5;
GOTOXY((X+6),Y);
END
ELSE
IF ((INCHAR = CHR(8)) OR (INCHAR = CHR(7))) THEN
BEGIN
GOTOXY((X+3),Y);
WRITE(' ');
LOCATION := 3;
HOLD[3] := ' ';
GOTOXY((X+3),Y);
END
ELSE
BEGIN
WRITE(CHR(7));
END;
END;
5:
BEGIN
GOTOXY((X+6),Y);
IF INCHAR IN ['1'..'9','0'] THEN
BEGIN
HOLD[5] := INCHAR;
WRITE(INCHAR);
LOCATION := 6;
GOTOXY((X+7),Y);
END
ELSE
IF ((INCHAR = CHR(8)) OR (INCHAR = CHR(7))) THEN
BEGIN
GOTOXY((X+4),Y);
WRITE(' ');
LOCATION := 4;
HOLD[4] := ' ';
GOTOXY((X+4),Y);
END
ELSE
BEGIN
WRITE(CHR(7));
END;
END;
6:
BEGIN
GOTOXY((X+7),Y);
IF INCHAR IN ['1'..'9','0'] THEN
BEGIN
HOLD[6] := INCHAR;
WRITE(INCHAR);
LOCATION := 7;
END
ELSE
IF ((INCHAR = CHR(8)) OR (INCHAR = CHR(7))) THEN
BEGIN
GOTOXY((X+6),Y);
WRITE(' ');
LOCATION := 5;
HOLD[5] := ' ';
GOTOXY((X+6),Y);
END
ELSE
BEGIN
WRITE(CHR(7));
END;
END;
7:
BEGIN
IF ((INCHAR=CHR(11)) OR (INCHAR=CHR(13))) THEN
LOCATION := 8
ELSE
IF ((INCHAR=CHR(8)) OR (INCHAR=CHR(7))) THEN
BEGIN
GOTOXY((X+7),Y);
WRITE(' ');
LOCATION := 6;
HOLD[6] := ' ';
GOTOXY((X+7),Y);
END;
END;
END;
END;
READDATE := HOLD[1]+HOLD[2]+'/'+HOLD[3]+HOLD[4]+'/'+HOLD[5]+HOLD[6];
TEXTCOLOR(LIGHTGRAY);
TEXTBACKGROUND(BLACK);
END;
{.R+}
{.L+}