$CPU 8086 ' make compatible with XT systems $LIB ALL OFF ' turn off all PowerBASIC libraries $ERROR ALL OFF ' turn off all PowerBASIC error checking $OPTIMIZE SIZE ' optimize for smaller code '$COMPILE UNIT ' compile to a UNIT (.PBU) $COMPILE EXE ' compile to a UNIT (.PBU) DEFINT A-Z ' Required for all numeric functions, forces PB to not ' include floating point in UNIT (makes it smaller) '/*------------------------------------------------------------------*/ DECLARE SUB GETFB(ATTR,CF,CB) DECLARE FUNCTION MKTATTR(CF,CB) AS INTEGER DECLARE SUB SAY(BYVAL Row AS INTEGER, BYVAL Col AS INTEGER, BYVAL Text AS STRING, BYVAL Attr AS INTEGER) DECLARE FUNCTION WORD(BYVAL X AS STRING,XN AS INTEGER) AS STRING DECLARE FUNCTION WORDS(BYVAL X AS STRING) AS INTEGER DECLARE FUNCTION GETPARM(OPT$,SEARCH$) AS STRING '/*------------------------------------------------------------------*/ $CODE SEG "MLIB2" '/*------------------------------------------------------------------*/ ' EDIT ROW,COL,ATTR,LTH,STRING$,RKEY$,OPT$ ' Edit string. ' Allows editing of STRING$ with return controlled by RKEYS. ' ROW = Start row of edit. ' COL = Start column of edit. ' ATTR = Edit color ' LTH = Maximum lenght of string. STRING$ will be set to this ' length when returned unless the OPT$ contains TRIM. ' If LTH = 0 then length of STRING$ is used. ' STRING$ = String to be edited. ' RKEY$ = Controlling keys that cause the EDIT function to be exited. ' If RKEY$ = "" then ENTER and ESC are used otherwise only ' the specified keys will cause an exit. When exited, RKEY$ ' will contain keycode of controlling key pressed. ' OPT$ = Controlling options. Allows you to specify options to ' control how STRING$ is edited/returned. ' ALLOW = Allowed characters. This option allows only the ' specified characters to be typed. If the UPPER ' option is specified, only Upper Case letters are ' allowed. Example: ALLOW'MF' ' COMMA = Requires that a comma "," be present in STRING$ ' before control is returned. ' ESP = Specifies that editing begins at nnth character in ' STRING$. EXAMPLE: ESP'10' ' END = Specifies that editing begins at the first trailing ' character in STRING$. Overrides ESP option. ' FILL = Specifies that while editing STRING$ the trailing ' characters are to be character number nnn. ' EXAMPLE: FILL'176' ' LOWER = Returns all characters as lower case. ' MSEC = Specfies that you want the cursor to work like ' the MicroSoft Editor Cursor where the Underscore ' cursor denotes insert mode and the block cursor ' denotes overtype mode. ' PASSWORD= Only * are displayed. The Real text is properly ' returned but is not echoed to the screen. ' RSTRING = Specifies that the editor will return STRING$ only ' if one of the required strings is present. Case ' matters. EXAMPLE: RSTRING'ACT REQ UNK RET' ' STRIP = All Leading and trailing spaces are removed. ' UPPER = Returns all characters as upper case. ' REDISPLAY Specifies that SRTRING$ is to be redisplayed using ' the Attribute found at ROW and COL before editing ' began when the edit routine is exited. ' WS = Window string edit. Specifies that STRING$ is to be ' edited in a window. Arrow keys are used to scroll in ' the window (left/right/up/down). ' Column is specified first. If only column is specified, ' then a one line scrolling window is presented. If ' row is specified and is greater than one, the a multi-line ' window is presented. ' At any time COL + LTH is greater than the 80th column, a ' one-line scrollable window is invoked. ' EXAMPLE: WS'30 10' ' WS'30' ' WS'30 1' ' ' EXAMPLE: EDIT 25,1,31,80,A$,"UPPER WS'30' FILL'176' RSTRING'ACT REQ FAV'" '/*------------------------------------------------------------------*/ SUB EDIT(ROW,COL,ATTR,LTH,F$,RKEY$,OPT$) PUBLIC '/* --- Get Existing Field Color ---*/ HATTR = SCREEN(ROW,COL,1) IF LTH = 0 THEN LTH = LEN(F$) '/* --- Use Select List? ---*/ SLIST$ = GETPARM(OPT$,"SLIST") IF SLIST$ <> "" THEN SPF = WORDS(SLIST$) '/* --- Position on Re-entry ---* FOR CNT = 1 TO SPF IF F$ = WORD(SLIST$,CNT) THEN EXIT FOR NEXT CNT IF CNT > SPF THEN CNT = 1 DO '/* --- Arrow Guide --- T$ = CHR$(29) IF CNT = 1 THEN T$ = CHR$(26) IF CNT = SPF THEN T$ = CHR$(27) '/* --- Display Choice --- SAY ROW,COL,LEFT$(T$+WORD(SLIST$,CNT)+STRING$(LTH,32),LTH),ATTR '/* --- Get Key --- WHILE NOT INSTAT:WEND Y$ = INKEY$ '/* --- Scroll Choices --- IF Y$ = CHR$(0,77) THEN INCR CNT IF Y$ = CHR$(0,75) THEN DECR CNT IF CNT < 1 THEN CNT = 1 IF CNT > SPF THEN CNT = SPF IF INSTR(1,RKEY$,Y$) > 0 THEN EXIT DO LOOP UNTIL Y$ = CHR$(13) OR Y$ = CHR$(27) OR Y$ = CHR$(0,80) OR Y$ = CHR$(0,72) '/* --- Exit Select List ---* RKEY$ = Y$ F$ = WORD(SLIST$,CNT) OPT$ = OPT$ + " REDISPLAY" GOTO EDITLNEEXIT2: END IF '/* --- Use End Filler Character instead of Space? ---*/ IF INSTR(1,UCASE$(OPT$),"FILL") > 0 THEN FILLCHAR$ = CHR$(VAL(GETPARM(OPT$,"FILL"))) ELSE FILLCHAR$ = " " '/* --- Set String Length ---*/ F$ = RTRIM$(F$) F$ = LEFT$(F$+STRING$(LTH,FILLCHAR$),LTH) '/* --- Required Specified? ---*/ RSTRING$ = GETPARM(OPT$,"RSTRING") '/* --- Allow Specified? ---*/ ALLOW$ = GETPARM(OPT$,"ALLOW") '/* --- Start Position Specified? ---*/ SP = VAL(GETPARM(OPT$,"ESP")) IF SP = 0 THEN SP = 1 IF INSTR(1,UCASE$(OPT$),"END") > 0 THEN SP = LEN(RTRIM$(F$,FILLCHAR$))+1 '/* --- Set Default Start Position if Needed ---*/ IF SP = -1 THEN SP = LEN(RTRIM$(F$,FILLCHAR$))+1 '/* --- Window Scroll Specified? ---*/ IF COL + LTH > 80 THEN OPT$=OPT$+" WS'"+TRIM$(STR$(80-COL))+"'" WS$ = GETPARM(OPT$,"WS") IF WS$ <> "" THEN NCOL = VAL(WORD(WS$,1)) IF WORDS(WS$) > 1 THEN NROW = VAL(WORD(WS$,2)) MRP = NCOL * NROW ELSE NROW = 1 MRP = NCOL END IF WP = SP END IF '/* --- Password? ---*/ IF INSTR(1,UCASE$(OPT$),"PASSWORD") > 0 THEN PW$ = STRING$(LTH,32) ELSE PW$ = "" '/* --- Set Default Return Keys if Needed ---*/ IF RKEY$ = "" THEN RKEY$ = CHR$(13,27) '/* --- Set Insert Key Parms ---*/ INSKEY = 0 IF INSTR(1,UCASE$(OPT$),"MSEC") > 0 THEN CINS = 6 CNORM = 4 ELSE CINS = 4 CNORM = 6 END IF CBL = CNORM '/* --- Start Edit Loop ---*/ EDITLNRESTART: DO '/* --- Display Field ---*/ IF WS$ = "" THEN SAY ROW,COL,F$,ATTR LOCATE ROW,COL+SP-1,1,CBL,7 ELSE '/* --- Down/Up Arrow Keys ---*/ HSP = SP HWP = WP IF Y$ = CHR$(0,80) OR Y$ = CHR$(0,72) THEN IF Y$ = CHR$(0,80) THEN SP = SP + NCOL IF Y$ = CHR$(0,72) THEN SP = SP - NCOL IF SP < WP THEN WP = WP - NCOL IF SP > (WP+MRP) THEN WP = WP + NCOL IF (SP > LTH) OR (SP < 1) THEN SP = HSP WP = HWP END IF END IF '/* --- Determine Sliding Window Position ---*/ IF SP < WP THEN WP = SP IF SP > (WP+MRP-1) THEN WP = (SP-MRP)+1 '/* --- Display Text ---*/ FOR CNT = 1 TO NROW SAY ROW+CNT-1,COL,STRING$(NCOL,32),ATTR SAY ROW+CNT-1,COL,MID$(F$,WP+(CNT*NCOL)-NCOL,NCOL),ATTR NEXT CNT '/* --- Determine Relative Window Position ---*/ RP = (SP-WP)+1 WCOL = (FRAC(RP/NCOL)*NCOL)-1 WROW = FIX(RP/NCOL) IF WCOL = -1 THEN WCOL = NCOL-1 DECR WROW END IF 'SAY 24,1,STR$(NROW)+STR$(NCOL)+STR$(MRP),31 'SAY 25,1,STRING$(50,32),31 'SAY 25,1,STR$(ROW+WROW)+STR$(COL+WCOL)+STR$(WP)+STR$(SP)+STR$(WROW)+STR$(WCOL),31 LOCATE ROW+WROW,COL+WCOL,1,CBL,7 END IF '/* --- Get Keystroke ---*/ WHILE NOT INSTAT:WEND Y$ = INKEY$ '/* --- Backspace Key? ---*/ IF Y$ = CHR$(8) THEN IF SP > 1 THEN F$ = LEFT$(F$,SP-2)+MID$(F$,SP) + FILLCHAR$ SP = SP -1 END IF ITERATE END IF '/* --- Exit Key? ---*/ IF ASC(Y$) < 32 OR LEN(Y$) > 1 THEN IF INSTR(1,RKEY$,Y$) > 0 THEN RKEY$ = Y$ GOTO EDITLNEEXIT END IF END IF '/* --- Keep Character? ---*/ IF LEN(Y$) = 1 AND ASC(Y$) > 31 THEN IF PW$ <> "" THEN MID$(PW$,SP,1) = Y$ MID$(F$,SP,1) = "*" '/* --- Allowed Character? ---*/ ELSE IF ALLOW$ <> "" AND INSTR(1,ALLOW$,Y$) < 1 THEN ITERATE IF INSKEY = 0 THEN MID$(F$,SP,1) = Y$ ELSE F$ = LEFT$(LEFT$(F$,SP-1)+Y$+MID$(F$,SP),LTH) END IF END IF Y$ = CHR$(0,77) END IF '/* --- Insert Key? ---*/ IF Y$ = CHR$(0,82) THEN IF INSKEY = 1 THEN INSKEY = 0 ELSE INSKEY = 1 IF INSKEY = 1 THEN CBL = CINS ELSE CBL = CNORM END IF ITERATE END IF '/* --- Home Key? ---*/ IF Y$ = CHR$(0,71) THEN SP = 1 '/* --- End Key? ---*/ IF Y$ = CHR$(0,79) THEN L = LEN(RTRIM$(F$,FILLCHAR$)) SP = L + 1 END IF '/* --- Move Cursor Right? ---*/ IF Y$ = CHR$(0,77) THEN INCR SP '/* --- Move Cursor Left? ---*/ IF Y$ = CHR$(0,75) THEN DECR SP '/* --- Check Bounds ---*/ IF SP < 1 THEN SP = 1 IF SP > LTH THEN SP = LTH '/* --- Fill Character? ---*/ IF FILLCHAR$ <> " " THEN REPLACE FILLCHAR$ WITH " " IN F$ IF LEN(RTRIM$(F$)) < SP THEN F$ = LEFT$(F$,SP) ELSE F$ = RTRIM$(F$) F$ = LEFT$(F$+STRING$(LTH,FILLCHAR$),LTH) END IF '/* --- Delete Character? ---*/ IF Y$ = CHR$(0,83) THEN F$ = LEFT$(F$,SP-1)+MID$(F$,SP+1) F$ = F$ + FILLCHAR$ END IF LOOP UNTIL Y$ = CHR$(13) OR Y$ = CHR$(27) EDITLNEEXIT: '/* --- Comma Required? ---*/ IF INSTR(1,UCASE$(OPT$),"COMMA") > 0 AND INSTR(1,F$,",") < 1 THEN GOTO EDITLNRESTART '/* --- Required String Present? ---*/ IF RSTRING$ <> "" THEN SPF2 = WORDS(RSTRING$) SPF = 0 FOR WCNT = 1 TO SPF2 T$ = WORD(RSTRING$,WCNT) IF INSTR(1,F$,T$) > 0 THEN INCR SPF NEXT WCNT IF SPF = 0 THEN GOTO EDITLNRESTART END IF '/* --- Password? ---*/ IF PW$ <> "" THEN F$ = PW$ '/* --- Fill Character ---*/ IF FILLCHAR$ <> " " THEN F$ = LEFT$(RTRIM$(F$,FILLCHAR$)+STRING$(LTH,32),LTH) '/* --- Convert Case? ---*/ IF INSTR(1,UCASE$(OPT$),"UPPER") > 0 THEN F$ = UCASE$(F$) IF INSTR(1,UCASE$(OPT$),"LOWER") > 0 THEN F$ = LCASE$(F$) '/* --- Trim? ---*/ IF INSTR(1,UCASE$(OPT$),"STRIP") > 0 THEN F$ = TRIM$(F$) '/* --- Display String? ---*/ EDITLNEEXIT2: IF INSTR(1,UCASE$(OPT$),"REDISPLAY") > 0 THEN IF WS > 0 THEN SAY ROW,COL,LEFT$(F$+STRING$(80,32),WS+2),HATTR ELSE SAY ROW,COL,STRING$(LTH,32),HATTR SAY ROW,COL,F$,HATTR END IF END IF LOCATE,,0 END SUB '/*------------------------------------------------------------------*/ $INCLUDE "c:\CODE\MLIB\MLIB.INC" F$ = "1234567891123456789212345678931234567894123456789512345678961234567897" ROW = 10 COL = 5 ATTR = 31 LTH = 120 RKEY$ = CHR$(27) OPT$ = "WS'10 5'" EDIT ROW,COL,ATTR,LTH,F$,RKEY$,OPT$ SAY 20,1,F$,33 Y$ = GETKEY