home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
World of Shareware - Software Farm 2
/
wosw_2.zip
/
wosw_2
/
QBAS
/
FLDEDIT.ZIP
/
FLDEDIT2.BAS
Wrap
BASIC Source File
|
1989-02-14
|
7KB
|
279 lines
' FldEdit()
' by Wayne Robinson, Under the Sun Software
' Data (201) 666-0519, The Covered Bridge, Phoenix 807/10
'
' Field Editor for taking keyboard input from a specific
' screen location of maximum length. Returns one string (FTemp$)
' and one integer value (FRKey%).
' Display this code with a TAB stop of 3 spaces for best result.
' Version 2.0, 3/2/88
'
' In order to trap function keys the variable FRKey% must be initialized
' with a non-zero value for the call. This will enable the page, cursor,
' function keys, and others to be trapped. If FRKey% is 0 coming into
' FldEdit then only Escape and Carriage Return are trapped. In order to
' parse for the occurance of one of these keys I suggest a test of FRKey%
' at the return from FldEdit via a select case such as this one. FldEdit
' will strip the leading 0's from extended keys and return only the second
' value in FRKey%
'
' SELECT CASE FRKey%
' CASE 13 'CR note FldEdit v1.0 returned 0
' CASE 27 'ESC
' CASE 9 'TAB
' CASE 59 'F1
' CASE 60 'F2
' .
' .
' .
' .
' CASE 71 'HOME
' CASE 79 'END
' CASE ELSE
' END SELECT
'
' The keys trapped with FRKey% are:
' F1 - F10 0, 59 to 0, 68
' Carriage Return 13
' Escape 27
' Tab 9
' Home 0, 71
' End 0, 79
' PgUp 0, 73
' PgDn 0, 81
' Cursor Up 0, 72
' Cursor Down 0, 80
'
' Parameters:
' FRow% = ROW of first character of field
' FCol% = Column of first character of field
' FLength% = maximum length of field
' FFore% = foreground color of text in field
' FBack% = background color of text in field
' FRKey% if 0 in then function keys are not parsed
' if > 0 in then function keys are parsed and value returned
' FTemp$ = String to edit. If not "" then this string will be placed
' in the field by FldEdit with the correct attribute.
' The edited string is returned in this variable.
SUB FldEdit (FRow%, FCol%, FLength%, FFore%, FBack%, FRKey%, FTemp$) STATIC
' Set boolean values
CONST TRUE = -1
CONST FALSE = 0
' Set color, ephasize field, insert string, and set cursor
FSet% = FCol% - 1
COLOR FFore%, FBack%
LOCATE FRow%, FCol%, 0
PRINT FTemp$; SPACE$(FLength% - LEN(FTemp$));
LOCATE FRow%, FCol%, 1
' Check FRKey% and set page key functions
IF FRKey% THEN
PageSet% = TRUE
ELSE
PageSet% = FALSE
END IF
' Initialize return key code, stop, reset insert mode
FRKey% = FALSE
FStop% = FALSE
FInsert% = FALSE
' Set Editor Output string to new Input string
FOut$ = FTemp$
' Start Parsing
DO UNTIL FStop%
' Sound alarm if called for
IF Alarm% THEN
SOUND 1000, 1
SOUND 1500, 2
SOUND 500, 1
Alarm% = FALSE
END IF
' Get a key to parse
FIn$ = ""
DO
FIn$ = INKEY$
LOOP WHILE FIn$ = ""
' Start by parsing length of key string
SELECT CASE LEN(FIn$)
' Check for extended key, strip leading zero
CASE 2
FIn$ = RIGHT$(FIn$, 1)
' Use ASCII value to select
SELECT CASE ASC(FIn$)
' Cursor Right
CASE 77
IF POS(0) < FSet% + (LEN(FOut$) + 1) THEN
LOCATE , POS(0) + 1
ELSE
Alarm% = TRUE
END IF
' Cursor Left
CASE 75
IF POS(0) > FSet% + 1 THEN
LOCATE , POS(0) - 1
ELSE
Alarm% = TRUE
END IF
' Delete
CASE 83
IF POS(0) - FSet% <= LEN(FOut$) THEN
Shift$ = MID$(FOut$, (POS(0) - FSet%) + 1)
FOut$ = LEFT$(FOut$, ((POS(0) - FSet%) - 1)) + Shift$
FTempPos% = POS(0)
LOCATE , , 0
PRINT MID$(FOut$, POS(0) - FSet%); CHR$(32);
LOCATE , FTempPos%, 1
ELSE
Alarm% = TRUE
END IF
' Insert
CASE 82
IF FInsert% = FALSE THEN
FInsert% = TRUE
LOCATE , , , 0, 7
ELSEIF FInsert% = TRUE THEN
FInsert% = FALSE
LOCATE , , , 7, 7
END IF
' Up, Down, PgUp, PgDn, Home, End
CASE 59 to 68, 71, 72, 73, 79, 80, 81
IF PageSet% THEN
FRKey% = ASC(FIn$)
FStop% = TRUE
ELSE
Alarm% = TRUE
END IF
' Any other key is illegal so set alarm and loop
CASE ELSE
Alarm% = TRUE
END SELECT
' Check for non-extended keys
CASE 1
' Use ASCII value to select
SELECT CASE ASC(FIn$)
' Backspace
CASE 8
IF POS(0) - FSet% > 1 THEN
IF POS(0) - FSet% > LEN(FOut$) THEN
FOut$ = LEFT$(FOut$, LEN(FOut$) - 1)
FTempPos% = POS(0)
LOCATE , POS(0) - 1, 0
PRINT CHR$(32);
LOCATE , FTempPos% - 1, 1
ELSEIF POS(0) - FSet% <= LEN(FOut$) THEN
Shift$ = MID$(FOut$, POS(0) - FSet%)
FOut$ = LEFT$(FOut$, ((POS(0) - FSet%) - 2)) + Shift$
FTempPos% = POS(0)
LOCATE , POS(0) - 1, 0
PRINT MID$(FOut$, POS(0) - FSet%); CHR$(32);
LOCATE , FTempPos% - 1, 1
END IF
ELSE
Alarm% = TRUE
END IF
' Tab
CASE 9
IF PageSet% THEN
FRKey% = ASC(FIn$)
FStop% = TRUE
ELSE
Alarm% = TRUE
END IF
' Carriage Return
CASE 13
FRKey% = ASC(FIn$)
FStop% = TRUE
' Escape
CASE 27
FRKey% = ASC(FIn$)
FStop% = TRUE
' Check for additional uprintable input
CASE IS < 32, IS > 125
Alarm% = TRUE
' Found printable key
CASE 32 TO 125
' If not past end of maximum length take input.
IF POS(0) <= FSet% + FLength% THEN
' If position is less than current string length then check for insert
' mode on and overwrite character if insert off or insert character if on.
IF POS(0) - FSet% <= LEN(FOut$) THEN
' Insert mode off?
IF FInsert% = FALSE THEN
MID$(FOut$, POS(0) - FSet%, 1) = FIn$
PRINT FIn$;
' Insert mode on?
ELSEIF FInsert% = TRUE THEN
' Check length of string plus input and take input if less than max lenth.
IF LEN(FOut$) < FLength% THEN
Shift$ = MID$(FOut$, POS(0) - FSet%)
FOut$ = LEFT$(FOut$, (POS(0) - FSet%) - 1) + FIn$ + Shift$
FTempPos% = POS(0)
LOCATE , , 0
PRINT MID$(FOut$, POS(0) - FSet%);
LOCATE , FTempPos% + 1, 1
' If string plus input too long sound alarm and return.
ELSE
Alarm% = TRUE
END IF
END IF
' If string position greater than current string length then add character.
ELSEIF POS(0) - FSet% > LEN(FOut$) THEN
FOut$ = FOut$ + FIn$
PRINT FIn$;
END IF
' Cursor past end of field so input is illegal
ELSE
Alarm% = TRUE
END IF
' Any other key is illegal so set alarm and loop
CASE ELSE
Alarm% = TRUE
END SELECT
END SELECT
LOOP
' Exit, reset cursor, assign passed variable
LOCATE , , 0, 7, 7
FTemp$ = FOut$
END SUB