SUB EditLoco (EdW$, Row%, Col%, FCol%, LenStr%, See%, TypeOfText$, Caps%, FGColr%, BGColr%, FKey$, Ins%, PW%, TabUpDn$, ExitCode%) STATIC ' +--------------------------------------------------------------------+ ' | | ' | - S U B E d i t L o c o - | ' | | ' | Public Domain - FreeWare | ' +--------------------------------------------------------------------+ ' | SUB EditLoco is FreeWare Public Domain software by Don Smith | ' | written on 01/01/2003. For Instructions, see SUB EditLoco. | ' +--------------------------------------------------------------------+ ' +--------------------------------------------------------------------+ ' | - ABOUT THE AUTHOR - | ' +--------------------------------------------------------------------+ ' | | ' |Hello. My name is Don Smith and I am a retired Math/History/Spanish | ' |teacher residing in Orange County, California. I am also a former | ' |6-year Sergeant of Marines. Who-Rah! On certain forums I am known | ' |as MarineDon. My email is: smithdonb@earthlink.net | ' | | ' +--------------------------------------------------------------------+ ' +--------------------------------------------------------------------+ ' | - COPYING AND DISTIBUTING - | ' +--------------------------------------------------------------------+ ' | Since this code is public domain and freeware, anyone may freely | ' | copy and distribute it. If you use the QuickBasic code in one of | ' | your own programs, you do not have to cite my name as the author, | ' | and you may even change its name. | ' +--------------------------------------------------------------------+ ' +--------------------------------------------------------------------+ ' | This is a version of SUB EditString is called SUB EditLoco. The | ' | SUB EditString is compiled with the Pro.Lib from Cresent SoftWare.| ' | This version, called SUB EditLoco is compiled with regular ol' | ' | QuickBASIC v4.5 and needs no special library. | ' +--------------------------------------------------------------------+ ' | EdW$ | The string to be edited. | ' +--------------+-----------------------------------------------------+ ' | Row% | The row to begin the editing. | ' +--------------+-----------------------------------------------------+ ' | Col% | The column to begin the editing. | ' +--------------+-----------------------------------------------------+ ' | FCol% | Use same number as Col% | ' +--------------+-----------------------------------------------------+ ' | LenStr% | Length of the string to edit. | ' +--------------+-----------------------------------------------------+ ' | See% | If See% = 0 then existing text will be displayed. | ' | | If See% = 1 existing text will be wiped. | ' +--------------+-----------------------------------------------------+ ' | TypeOfText$ | For all ASCII characers 32 to 255, TypeOfText = "" | ' | | For numbers only, TypeOfText$ = "1234567890" | ' | | For numbers with commas and decimals points, | ' | | TypeOfText$ = ".,1234567890" | ' | | For Yes or No answers, TypeOfText$ = "YNyn" | ' | | Whatever is included within the parethesis | ' | | is what will be accepted. | ' +--------------+-----------------------------------------------------+ ' | Caps% | Capital letters enabled, Caps% = 1 | ' +--------------+-----------------------------------------------------+ ' | FGColr% | The text foreground color. | ' +--------------+-----------------------------------------------------+ ' | BGColr% | The text back ground color. | ' +--------------+-----------------------------------------------------+ ' | FKey$ | Which keys to enable. To enabled | ' | | and , FKey$ = "150" ("0" is F10). | ' +--------------+-----------------------------------------------------+ ' | PW% | PW% = 1 - password mode enabled. | ' | | PW% = 0 - password mode NOT enabled. | ' +--------------+-----------------------------------------------------+ ' | Ins% | Ins% = 0 then INSERT OFF. Ins% = 1 then INSERT ON | ' +--------------+-----------------------------------------------------+ ' | TabUpDn$ | TabUpDn$ = "" nothing is initialized | ' | | TabUpDn$ = "T" initializes | ' | | TabUpDn$ = "U" initializes | ' | | TabUpDn$ = "D" initializes | ' | | TabUpDn$ = "TUD" initializes | ' | | | ' | | If one or more of these keys is initialized, then | ' | | the routine will exit showing the ExitCode% of the | ' | | pressed key. The programmer must make sure to | ' | | trap for the pressed key. Of course, if none | ' | | of these keys is to be employed, then place | ' | | TabUpDn$ = "" in the main module. | ' | | | ' | | : ExitCode% = 9 | ' | | : ExitCode% = 18432 | ' | | : ExitCode% = 20480 | ' | | | ' | | Example: | ' | | ------- | ' | | If ExitCode% = 18432 THEN ' | ' | | GOTO second.parameter | ' | | ELSEIF ExitCode% = 20480 THEN ' | ' | | GOTO fourth.parameter | ' | | 'Etc | ' | | | ' +--------------+-----------------------------------------------------+ ' | The ExitCode% is derived from the unique CVI Basic command. | ' | The ExitCode% for the keys gets changed to 1 to 10. | ' | To enable programmers to use the CVI code in their own programs, | ' | I have attached a short program, KeyCode.Bas (just below this | ' | section) | ' +------------------------------------+-------------------------------+ ' | ExitCode% = 1 is F1 key | I arbitrarily changed | ' | ExitCode% = 2 is F2 key | through to 1-10. | ' | ExitCode% = 3 is F3 key | Their CVI Codes are: | ' | ExitCode% = 4 is F4 key +-------------------------------+ ' | ExitCode% = 5 is F5 key | CVI: ExitCode: | ' | ExitCode% = 6 is F6 key | ---- --- -------- | ' | ExitCode% = 7 is F7 key | 15104 1 | ' | ExitCode% = 8 is F8 key | 15360 2 | ' | ExitCode% = 9 is F9 key | 15616 3 | ' | ExitCode% = 10 is F10 key | 15872 4 | ' | ExitCode% = 13 is ENTER key | 16128 5 | ' | ExitCode% = 27 is EXIT key | 17152 9 | ' | | 17408 10 | ' +------------------------------------+-------------------------------+ ' | Probably need to include at the top of the main module: DEFINT A-Z| ' +--------------------------------------------------------------------+ ' +--------------------------------------------------------------------+ ' | Use KeyCode.Bas below to find out what the CVI numbers will be | ' | for keys you wish to trap. | ' +--------------------------------------------------------------------+ ' | ' KeyCode.Bas - By Don Smith. FreeWare and Public Domain Program. | ' | ' Date: 09/01/2002. | ' | ' +-------------------------------------------------------------+ | ' | ' | Note: To reach the extended ASCII characters 127 to 255, | | ' | ' | press down on the key, and while pressed down, | | ' | ' | type in the number on your keypad, not the numbers | | ' | ' | above then keys. | | ' | ' +-------------------------------------------------------------+ | ' +--------------------------------------------------------------------+ ' | | ' | COLOR 14, 1: CLS | ' | Top1$ = "Press a key and the KeyCode% value will be displayed." | ' | Top2$ = "~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~" | ' | Top3$ = "(Press To Quit" | ' | COLOR 15, 1 | ' | LOCATE 2, 15: PRINT Top1$ | ' | LOCATE 3, 15: PRINT Top2$ | ' | COLOR 11, 1 | ' | LOCATE 4, 30, 0: PRINT Top3$ | ' | PRINT : PRINT | ' | COLOR 14, 1 | ' | DO | ' | DO | ' | Hit$ = INKEY$ | ' | IF Hit$ = CHR$(27) THEN | ' | PRINT | ' | LOCATE , 10: COLOR 15, 1: PRINT STRING$(62, "-"); | ' | PRINT | ' | LOCATE , 34: COLOR 11, 1: PRINT "Program Ends"; | ' | PRINT : PRINT | ' | END | ' | END IF | ' | LOOP UNTIL Hit$ <> "" | ' | Hit% = CVI(Hit$ + CHR$(0)) | ' | Key$ = STR$(Hit%) | ' | IF Hit% < 256 THEN | ' | LOCATE , 32, 0 | ' | PRINT Hit$ + SPACE$(9) + "= " + Key$ | ' | ELSEIF Hit% > 255 THEN | ' | LOCATE , 21, 0 | ' | PRINT "Extended Key" + SPACE$(9) + "= " + Key$; "" | ' | END IF | ' | LOOP | ' | | ' +--------------------------------------------------------------------+ EdW$ = "": Ky$ = "" IF See% = 1 THEN LOCATE Row%, Col% COLOR FGColr%, BGColr% PRINT STRING$(LenStr%, " "); END IF TabUpDn$ = UCASE$(TabUpDn$) begin.edit.line: DO IF Ins% = 1 THEN 'Insert On COLOR FGColr%, BGColr%: LOCATE Row%, Col%, 1, 4, 7 ELSEIF Ins% = 0 THEN 'Insert Off COLOR FGColr%, BGColr%: LOCATE Row%, Col%, 1, 6, 7 END IF DO Ky$ = INKEY$ IF PW% = 1 THEN IF BlankIt% = 1 THEN BlankIt% = 0 END IF END IF LOOP UNTIL LEN(Ky$) > 0 SlamKey% = CVI(Ky$ + CHR$(0)) ' IF SlamKey% > 31 AND SlamKey% < 256 THEN 'CHR$(31) to CHR$255) IF TypeOfText$ = "" THEN 'CHR$(32) is IF PW% = 0 THEN GOSUB show.char ELSEIF PW% = 1 THEN GOSUB edit.password END IF ELSEIF TypeOfText$ <> "" THEN IF INSTR(TypeOfText$, Ky$) > 0 THEN IF PW% = 0 THEN GOSUB show.char ELSEIF PW% = 1 THEN GOSUB edit.password END IF END IF END IF ', ELSEIF SlamKey% = 9 OR SlamKey% = 18432 OR SlamKey% = 20480 THEN IF SlamKey% = 9 THEN TabUpDnKey$ = "T" ELSEIF SlamKey% = 18432 THEN TabUpDnKey$ = "U" ELSEIF SlamKey% = 20480 THEN TabUpDnKey$ = "D" END IF IF INSTR(TabUpDn$, TabUpDnKey$) > 0 THEN GOSUB get.string ExitCode% = SlamKey% EXIT SUB END IF ELSEIF SlamKey% = 27 THEN ' Key ExitCode% = 27 GOSUB get.string EXIT SUB ELSEIF SlamKey% = 19712 THEN ' Arrow Col% = Col% + 1 IF Col% > FCol% + LenStr% - 1 THEN Col% = FCol% ELSE LOCATE Row%, Col%, 1, 6, 7 END IF ELSEIF SlamKey% = 19200 THEN ' Col% = Col% - 1 IF Col% = FCol% - 1 OR Col% < FCol% THEN Col% = FCol% + LenStr% - 1 END IF ELSEIF SlamKey% = 13 THEN ' IF PW% = 0 THEN GOSUB get.string END IF ExitCode% = 13 EXIT SUB ELSEIF SlamKey% = 8 THEN ' Col% = Col% - 1 IF Col% = FCol% OR Col% < FCol% THEN Col% = FCol% END IF LOCATE Row%, Col% COLOR FGColr%, BGColr%: PRINT " "; IF PW% = 1 THEN EdW$ = LEFT$(EdW$, LEN(EdW$) - 1) END IF ELSEIF SlamKey% = 20992 THEN ' 'If 1 (on), turn off (0). If 0 (off), turn on (1). IF Ins% = 1 THEN Ins% = 0 'unREM if need to print "Insert Off/On" 'LOCATE 2, 66: Print "Insert Off "; ELSEIF Ins% = 0 THEN 'REM out "Insert Off/On" if not used. Ins% = 1 'LOCATE 2, 66: Print "Insert On "; END IF ELSEIF SlamKey% = 21248 THEN ' SaveScr$ = "" FOR DelK% = Col% + 1 TO FCol% + LenStr% SaveScr$ = SaveScr$ + CHR$(SCREEN(Row%, DelK%)) NEXT SaveScr$ = MID$(SaveScr$, 1, LEN(SaveScr$)) LOCATE Row%, Col% COLOR FGColr%, BGColr% PRINT SaveScr$; SaveScr$ = "" ELSEIF SlamKey% = 18176 THEN ' Col% = FCol% ELSEIF SlamKey% = 20224 THEN ' GOSUB get.string Col% = FCol% + LEN(EdW$) LOCATE Row%, Col%, 1, 6, 7 ELSEIF SlamKey% = 25 THEN ' = clears line of LOCATE Row%, FCol% 'all text. WipeOut$ = SPACE$(LenStr%) COLOR FGColr%, BGColr% PRINT WipeOut$; ELSEIF SlamKey% > 15103 OR SlamKey% < 17409 THEN ' to IdentKey$ = STR$(((SlamKey% - 15104) \ 256) + 1) IdentKey$ = LTRIM$(RTRIM$(IdentKey$)) IF IdentKey$ = "10" THEN IdentKey$ = "0" END IF IF INSTR(FKey$, IdentKey$) > 0 THEN IF IdentKey$ = "0" THEN ExitCode% = 10 GOSUB get.string EXIT SUB ELSE ExitCode% = VAL(IdentKey$) GOSUB get.string EXIT SUB END IF END IF END IF LOOP show.char: IF Ins% = 1 THEN ' FOR Horizontal% = Col% TO FCol% + LenStr% - 1 EditL$ = EditL$ + CHR$(SCREEN(Row%, Horizontal%)) NEXT IF Caps% > 0 THEN EditL$ = UCASE$(EditL$) Ky$ = UCASE$(Ky$) END IF COLOR FGColr%, BGColr% LOCATE Row%, Col%, 1 PRINT LEFT$(Ky$ + EditL$, FCol% + LenStr% - Col%); IF Col% = FCol% + LenStr% THEN Col% = FCol% - 1 END IF Col% = Col% + 1 EditL$ = "" ELSEIF Ins% = 0 THEN ' LOCATE Row%, Col% IF Caps% > 0 THEN COLOR FGColr%, BGColr%: PRINT UCASE$(Ky$); ELSEIF Caps% = 0 THEN COLOR FGColr%, BGColr%: PRINT Ky$; END IF Col% = Col% + 1 IF Col% = FCol% + LenStr% THEN Col% = FCol% RETURN END IF END IF RETURN get.string: EditLine$ = SPACE$(LenStr%) FOR Horizontal% = FCol% TO FCol% + LenStr% EditLine$ = EditLine$ + CHR$(SCREEN(Row%, Horizontal%)) NEXT EditLine$ = RTRIM$(LTRIM$(EditLine$)) EdW$ = EditLine$ RETURN edit.password: EdW$ = UCASE$(EdW$) + UCASE$(Ky$) COLOR FGColr%, BGColr% LOCATE Row%, Col% PRINT "ù"; 'CHR$(249) LOCATE Row%, Col% + 1, 1, 6, 7 IF Col% = FCol% + LenStr% THEN Col% = FCol% - 1 END IF Col% = Col% + 1 RETURN END SUB SUB TinyBox (ULRow, ULCol, LRRow, LRCol, BoxFGColr, BoxBGColr, SingOrDoub) ' +----------------------------------------------------------------------+ ' | SUB TinyBox | ' +----------------------------------------------------------------------+ ' | ULRow = Upper Left Row. ULCol = Upper Left Column. | ' | LRRow = Lower Right Row. LRCol = Lower Right Column. | ' | BoxFGColr = The Foreground Color The Box. | ' | BoxBGColr = The Back Ground Color Of The Box. | ' | SingOrDoub = 1 (Single Line Box). SingOrDoub = 2 (Double Line Box). | ' +----------------------------------------------------------------------+ COLOR BoxFGColr, BoxBGColr IF SingOrDoub = 1 THEN LOCATE ULRow, ULCol PRINT CHR$(218) + STRING$(LRCol - ULCol, CHR$(196)) + CHR$(191); FOR BoxY = ULRow + 1 TO LRRow - 1 LOCATE BoxY, ULCol PRINT CHR$(179) + STRING$(LRCol - ULCol, " ") + CHR$(179); NEXT LOCATE LRRow, ULCol PRINT CHR$(192) + STRING$(LRCol - ULCol, CHR$(196)) + CHR$(217); ELSEIF SingOrDoub = 2 THEN LOCATE ULRow, ULCol PRINT CHR$(201) + STRING$(LRCol - ULCol, CHR$(205)) + CHR$(187); FOR BoxY = ULRow + 1 TO LRRow - 1 LOCATE BoxY, ULCol PRINT CHR$(186) + STRING$(LRCol - ULCol, " ") + CHR$(186); NEXT LOCATE LRRow, ULCol PRINT CHR$(200) + STRING$(LRCol - ULCol, CHR$(205)) + CHR$(188); END IF END SUB