$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) '/*------------------------------------------------------------------*/ $CODE SEG "MLIB6" DECLARE SUB TBOX(BYVAL ROW,BYVAL COL,BYVAL ROWS,BYVAL COLS,BYVAL ATTR,BYVAL OPT,BYVAL SHAD) DECLARE SUB SAY(BYVAL Row AS INTEGER, BYVAL Col AS INTEGER, BYVAL Text AS STRING, BYVAL Attr AS INTEGER) DECLARE FUNCTION GETSCREEN() AS STRING DECLARE SUB PUTSCREEN(BYVAL X AS STRING) DECLARE SUB EDIT(ROW,COL,ATTR,LTH,F$,RKEY$,OPT$) ' DECLARE SUB LGEDIT(EL AS STRING , BYVAL TPE AS STRING, BYVAL ROW AS INTEGER, BYVAL COL AS INTEGER, BYVAL ELTH AS INTEGER,BYVAL ATTR AS INTEGER, RKEY$,BYVAL WS AS INTEGER) '/*------------------------------------------------------------------*/ SUB PBOX(SROW,SCOL,QUES$(),ANS$(), AL(), PARM$(), AATTR, BATTR, BTYPE, OPT$, RTKY$, CF) PUBLIC '/* --- Save Calling Screen --- SCREEN1$ = GETSCREEN NQ = VAL(QUES$(0)) '/* --- Determine PBOX Parms ----------------------------------------- DFLAG = INSTR(1,UCASE$(OPT$),"PDISPLAY") NOREFRESH = INSTR(1,UCASE$(OPT$),"PNOREFRESH") IF INSTR(1,UCASE$(OPT$),"PWIDTH") > 0 THEN WFLAG = 1 S = INSTR(1,UCASE$(OPT$),"PWIDTH") S = S + 6 T$ = MID$(OPT$,S,2) WD = VAL(T$) ELSE WFLAG = 0 WD = 78 END IF '/* --- Determine Panel Size ----------------------------------------- NROWS = NQ QLEN = 0 ALEN = 0 FOR CNT = 1 TO NQ IF LEN(QUES$(CNT)) > QLEN THEN QLEN = LEN(QUES$(CNT)) IF AL(CNT) > ALEN AND WFLAG = 0 THEN ALEN = AL(CNT) NEXT CNT IF WFLAG = 1 THEN ALEN = WD -QLEN-4 '/* --- Determine Panel Placement ------------------------------------ IF SROW < 1 THEN SROW = 12-(NROWS/2) IF SCOL < 1 THEN SCOL = 40 - ((QLEN + ALEN + 4)/2) +1 WDTH = QLEN+ALEN+4 IF WDTH > 80 THEN WDTH = 80 - SCOL '/* --- Display Panel and Text --------------------------------------- TBOX SROW,SCOL-1,NROWS+2,WDTH,BATTR,BTYPE,1 FOR CNT = 1 TO NQ SAY SROW+CNT,SCOL+1,QUES$(CNT),BATTR IF SCOL+1+LEN(QUES$(CNT))+LEN(ANS$(CNT)) > 78 THEN DL = 78-(SCOL+1+LEN(QUES$(CNT)))-2 ELSE DL = AL(CNT) IF LEN(QUES$(CNT))+LEN(ANS$(CNT)) > WD THEN DL = WD - LEN(QUES$(CNT)) - 4 SAY SROW+CNT,SCOL+1+LEN(QUES$(CNT)),LEFT$(ANS$(CNT),DL),BATTR NEXT CNT IF DFLAG > 0 THEN EXIT SUB '/* --- Edit Fields -------------------------------------------------- FCNT = NQ IF CF = < 1 OR CF > FCNT THEN CF = 1 CNT = CF DO RKEY$ = CHR$(27,0,72,0,80,13) + RTKY$ IF LEN(QUES$(CNT))+AL(CNT)+4 > WD THEN DL = WD - LEN(QUES$(CNT)) - 4 ELSE DL = 0 EDIT SROW+CNT,SCOL+1+LEN(QUES$(CNT)),AATTR,AL(CNT),ANS$(CNT),RKEY$,PARM$(CNT)+" WS'"+TRIM$(STR$(DL))+"' REDISPLAY" '/* --- Exit? --- IF RKEY$ = CHR$(27) THEN RTKY$ = RKEY$ EXIT LOOP END IF '/* --- ENTER? --- IF RKEY$ = CHR$(13) THEN RKEY$ = CHR$(00,80) IF INSTR(1,RTKY$,RKEY$) > 0 THEN RTKY$ = RKEY$ EXIT LOOP END IF '/* --- Down Arrow? --- IF RKEY$ = CHR$(00,80) THEN INCR CNT '/* --- Up Arrow? --- IF RKEY$ = CHR$(00,72) THEN DECR CNT IF CNT < 1 THEN CNT = FCNT IF CNT > FCNT THEN CNT = 1 CF = CNT LOOP UNTIL RKEY$ = CHR$(27) IF NOREFRESH = 0 THEN PUTSCREEN SCREEN1$ END SUB '/*------------------------------------------------------------------*/ ' $INCLUDE "C:\CODE\MLIB\MLIB.INC" ' DIM QUES$(20) ' DIM ANS$(20) ' DIM AL(20) ' DIM PARM$(20) ''/*-----------123456789012 ' QUES$(1) = "Name -------> " ' QUES$(2) = "Address ----> " ' QUES$(3) = "City -------> " ' QUES$(4) = "State ------> " ' QUES$(5) = "Zip Code ---> " ' QUES$(6) = "Phone ------> " ' QUES$(0) = "6" ' AL(1) = 10 ' AL(2) = 30 ' AL(3) = 21 ' AL(4) = 2 ' AL(5) = 5 ' AL(6) = 8 ' ANS$(1) = "" ' ANS$(2) = "1234567890123456789012345" ' ANS$(3) = "123" ' PARM$(1) = "SLIST'MARK SUSIE NINA MICHAEL RICHARD KYLE'" ' PARM$(2) = "ASCII UPPER STRIP" ' PARM$(3) = "ASCII UPPER STRIP" ' PARM$(4) = "ASCII UPPER STRIP" ' PARM$(5) = "NBR STRIP" ' PARM$(6) = "PHONE STRIP" ' RKEY$ = CHR$(00,66) ' TITLE$ = "Testing the Title" ' PBOX 0,0,QUES$(), ANS$(), AL(), PARM$(), 31, 48, 1, "PWIDTH30", RKEY$, CF '/*------------------------------------------------------------------*/