' +-------------------------------------------------------------------+ ' | | ' | - 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. | ' +-------------------------------------------------------------------+ ' +-------------------------------------------------------------------+ ' | | ' | Compile: BC: EditLoco | ' | LINK: EditLoco | ' | LIB: BCom45.Lib | ' | | ' +-------------------------------------------------------------------+ DECLARE SUB EditLoco (EdW$, Row%, Col%, FCol%, LenStr%, See%, TypeOfText$, Caps%, FGColr%, BGColr%, FKey$, Ins%, PW%, TabUpDn$, ExitCode%) DECLARE SUB TinyBox (ULRow, ULCol, LRRow, LRCol, BoxFGColr, BoxBGColr, SingOrDoub) begin: '===================================================================== ' SUB EditLoco set up: '===================================================================== EdW$ = "" ' The string to edit. Row% = 12 ' Row to place EditQB. Col% = 29 ' Column to place EditQB. FCol% = Col% ' First Column of editing. Same as Col%. LenStr% = 20 ' Length of string to edit. See% = 0 ' See% = 0 means existing letters will be wiped. TypeOfText$ = "" ' Type of text to edit. See SUB for details. Caps% = 0 ' Caps% = 0 means use lower/upper case. FGColr% = 15 ' Foreground color. BGColr% = 0 ' Background color. FKey$ = "150" ' keys to enable. "150" enables F1, F5, F10. PW% = 0 ' Password function NOT enabled. Ins% = 0 ' Insert disabled. TabUpDn$ = "TUD" ' initialized. COLOR FGColr%, BGColr% + 1: CLS '===================================================================== ' SUB TinyBox called here: '===================================================================== CALL TinyBox(2, 18, 6, 62, 7, 1, 2) COLOR 14, 1 LOCATE 3, 25: PRINT "ð" LOCATE 3, 55: PRINT "ð" COLOR 15, 1 LOCATE 3, 28: PRINT "SUB EditLoco Demo Program"; COLOR 11, 1 LOCATE 5, 22: PRINT "(Public Domain FreeWare by Don Smith)"; COLOR 15, 1 LOCATE 5, 22: PRINT "("; LOCATE 5, 58: PRINT ")"; LOCATE 9, 25: COLOR FGColr%, BGColr% + 1: PRINT "Type something and press "; CALL TinyBox(11, 26, 13, 50, 7, 1, 1) LOCATE Row%, Col%: COLOR FGColr%, BGColr%: PRINT STRING$(LenStr%, " "); LOCATE Row%, Col%: COLOR FGColr%, BGColr%: PRINT EdW$; COLOR FGColr%, BGColr% + 1: LOCATE 15, 30: PRINT "Press To Quit"; COLOR FGColr% - 4, BGColr% + 1 LOCATE 15, 37: PRINT "Esc"; LOCATE 19, 14, 0: PRINT "Try pressing "; COLOR FGColr%, BGColr% + 1 LOCATE 19, 28, 0: PRINT "F1"; LOCATE 19, 33, 0: PRINT "F5"; LOCATE 19, 38, 0: PRINT "F10"; LOCATE 19, 44, 0: PRINT "Tab"; LOCATE 19, 50, 0: PRINT "UpArrow"; LOCATE 19, 60, 0: PRINT "DnArrow"; CALL TinyBox(21, 23, 24, 58, 7, 1, 1) COLOR FGColr%, BGColr% + 1 LOCATE 22, 25: PRINT "To try password mode, in the main"; LOCATE 23, 25: PRINT "module, change PW% = 0 to PW% = 1"; CALL EditLoco(EdW$, Row%, Col%, FCol%, LenStr%, See%, TypeOfText$, Caps%, FGColr%, BGColr%, FKey$, Ins%, PW%, TabUpDn$, ExitCode%) IF ExitCode% = 27 THEN ' GOTO leave ' or or ELSEIF ExitCode% = 1 OR ExitCode% = 5 OR ExitCode% = 10 THEN IF ExitCode% = 1 THEN FMessage$ = "1" ELSEIF ExitCode% = 5 THEN FMessage$ = "5" ELSEIF ExitCode% = 10 THEN FMessage$ = "10" END IF COLOR 15, 2: CLS LOCATE 10, 30, 0: PRINT "You Pressed "; LOCATE 14, 30, 0: PRINT ""; SOUND 200, 2 DO: LOOP WHILE INKEY$ = "" GOTO begin ELSEIF ExitCode% = 13 THEN ' COLOR 15, 2: CLS IF PW% = 1 THEN IF EdW$ = "" THEN LOCATE 10, 30, 0: PRINT "You Pressed ."; LOCATE 11, 30, 0: PRINT "No characters were typed in."; LOCATE 14, 30, 0: PRINT ""; ELSE LOCATE 10, 30, 0: PRINT "You Entered: " + CHR$(34) + EdW$ + CHR$(34); LOCATE 14, 30, 0: PRINT ""; END IF ELSEIF PW% = 0 THEN IF EdW$ = "" THEN LOCATE 10, 30, 0: PRINT "You Pressed ."; LOCATE 11, 30, 0: PRINT "No characters were typed in."; LOCATE 14, 30, 0: PRINT ""; ELSE LOCATE 10, 30, 0: PRINT "You Entered: " + CHR$(34) + EdW$ + CHR$(34); LOCATE 14, 30, 0: PRINT ""; END IF END IF SOUND 200, 2 DO: LOOP WHILE INKEY$ = "" GOTO begin ELSEIF ExitCode% = 9 OR ExitCode% = 18432 OR ExitCode% = 20480 THEN IF ExitCode% = 9 THEN Phrase$ = "" ELSEIF ExitCode% = 18432 THEN Phrase$ = "" ELSEIF ExitCode% = 20480 THEN Phrase$ = "" END IF COLOR 15, 2: CLS LOCATE 10, 30, 0: PRINT "You Pressed " + Phrase$; LOCATE 14, 30, 0: PRINT ""; SOUND 200, 2 DO: LOOP WHILE INKEY$ = "" GOTO begin END IF leave: COLOR 7, 0: CLS : LOCATE 1, 1, 1, 6, 7: END 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