PC Plus SuperCD (UK) 1995 September/Image.iso/pcplus/handson/wilfw107/pathfind.bas

BASIC Source File | 1995-06-22 | 3.9 KB | 209 lines

DECLARE SUB Rfield (Field$, Min%, Max%, Permitted$)
DECLARE SUB InPath (Field$)
DIM SHARED BAD$
ON ERROR GOTO RESUMENEXT
RESUMENEXT:
 IF ERR THEN
  BAD$ = "X"
  RESUME NEXT
 END IF



CLS
SCREEN 9
COLOR 4, 3
PRINT SPACE$(30); "P A T H F I N D E R"
PRINT
PRINT SPACE$(10); "Your PATH is "; UCASE$(ENVIRON$("PATH"))
PRINT
DO
 LOCATE , 3
 COLOR 14
 CALL Rfield(File$, 0, 11, "*C")
 I% = LEN(File$)
 IF LEN(File$) THEN
  CALL InPath(File$)
  LOCATE , 20
  COLOR 8
  IF File$ <> "" THEN
   PRINT "Found at ";
   COLOR 14
   PRINT File$
  ELSE
   PRINT "Not found in path"
  END IF
 END IF
LOOP WHILE I%

SYSTEM


SUB InPath (Field$)

 x$ = ".;" + ENVIRON$("PATH")
 IF RIGHT$(x$, 1) <> ";" THEN x$ = x$ + ";"
 I% = 1
 DO
  J% = INSTR(I%, x$, ";")
  IF J% THEN
   Y$ = UCASE$(MID$(x$, I%, J% - I%))
   I% = J% + 1
   IF RIGHT$(Y$, 1) <> "\" THEN Y$ = Y$ + "\"
   F$ = Y$ + Field$
   BAD$ = ""
   OPEN "I", 1, F$
   IF BAD$ = "" THEN
    CLOSE 1
    EXIT DO
   END IF
   F$ = ""
  END IF
 LOOP WHILE J%
 BAD$ = ""
 Field$ = F$


END SUB

SUB Rfield (Field$, Min%, Max%, Permitted$)

' locate the field on the screen
atRow% = CSRLIN
atCol% = POS(x)

' clear the field on the screen
Field$ = ""
PRINT CHR$(219); SPACE$(Max%);

' set the brake and loop until done
Brake% = 1

WHILE Brake%

' get a keystroke
 x$ = ""
 WHILE LEN(x$) = 0
  x$ = INKEY$
 WEND

' convert to uppercase if specified
 IF INSTR(Permitted$, "C") THEN x$ = UCASE$(x$)
 oldLen% = LEN(Field$)

' test for permitted keystroke
 Good% = 0
 IF INSTR(Permitted$, ".") THEN
  IF x$ = "." THEN
   IF INSTR(Field$, ".") = 0 THEN Good% = 1
  END IF
 END IF
 IF INSTR(UCASE$(Permitted$), "N") THEN
  IF INSTR("0123456789", x$) THEN Good% = 1
 END IF
 IF INSTR(UCASE$(Permitted$), "S") THEN
  IF x$ = " " THEN Good% = 1
 END IF
 IF INSTR(UCASE$(Permitted$), "X") THEN
  IF INSTR("ABCDEFGHIJKLMNOPQRSTUVWXYZ", UCASE$(x$)) THEN
   Good% = 1
  END IF
 END IF
 IF INSTR(UCASE$(Permitted$), "Y") THEN
  IF INSTR("YyNy", x$) THEN Good% = 1
 END IF

'************************
' NEW CODE

 IF INSTR(Permitted$, "*") THEN
  IF x$ = CHR$(8) OR x$ = CHR$(13) OR x$ = CHR$(27) THEN
  ELSE
   Good% = 1
  END IF
 END IF
'
' END NEW CODE
'************************

 IF Good% THEN
  Field$ = Field$ + x$
  IF INSTR(Field$, ".") THEN
   NewMax% = Max% + 1
  ELSE
   NewMax% = Max%
  END IF
  Field$ = MID$(Field$, 1, NewMax%)
 END IF

' handle Bkspace
 IF ASC(x$) = 8 AND LEN(Field$) THEN
  Field$ = MID$(Field$, 1, LEN(Field$) - 1)
 END IF

' calculate significant digits
 Signif$ = Field$ + "X"
 WHILE INSTR(" 0", MID$(Signif$, 1, 1))
  Signif$ = MID$(Signif$, 2)
 WEND
 IF INSTR(Signif$, ".") THEN
  SignifLen% = LEN(Signif$) - 2
 ELSE
  SignifLen% = LEN(Signif$) - 1
 END IF

' handle Enter
 IF ASC(x$) = 13 AND SignifLen% >= Min% THEN
  oldLen% = LEN(Field$) + 1
  Brake% = 0
 END IF

' handle Esc
 IF ASC(x$) = 27 THEN
  LOCATE atRow%, atCol%
  PRINT CHR$(219); SPACE$(Max%);
  Field$ = ""
  IF INSTR(UCASE$(Permitted$), "E") THEN
   RETURN
  END IF
 END IF

' reprint if change, or beep if no change
 IF oldLen% = LEN(Field$) THEN
  BEEP
 ELSE
  LOCATE atRow%, atCol%
  IF INSTR(UCASE$(Permitted$), "P") THEN
   PRINT STRING$(LEN(Field$), 254); CHR$(219); " ";
  ELSE
   PRINT Field$; CHR$(219); " ";
  END IF
 END IF

' check for auto-Enter
 IF INSTR(UCASE$(Permitted$), "A") THEN
  IF SignifLen% = Max% THEN
   Brake% = 0
  END IF
 END IF
WEND

' justify if required
IF INSTR(UCASE$(Permitted$), "J") THEN
 WHILE MID$(Field$, 1, 1) = "0"
  Field$ = MID$(Field$, 2)
 WEND
 Field$ = RIGHT$(SPACE$(NewMax%) + Field$, NewMax%)
END IF

' reprint, deleting the cursor
LOCATE atRow%, atCol%
IF INSTR(UCASE$(Permitted$), "P") THEN
 PRINT STRING$(LEN(Field$), 254); " ";
ELSE
 PRINT Field$; " ";
END IF

END SUB