home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
DP Tool Club 8
/
CDASC08.ISO
/
NEWS
/
439
/
PWEZ61
/
DEMPART2.BAS
< prev
next >
Wrap
BASIC Source File
|
1993-10-07
|
35KB
|
884 lines
'!!! ---------------------------------------------------------------------!!!
'!!! NOTE: THIS MODULE MUST BE LOADED WITH DEMO.BAS AS THE MAIN MODULE !!!
'!!! ---------------------------------------------------------------------!!!
'---------- MUST BE IN ANY MODULE USING "FINDDIR" DIRECTORY ROUTINE --------
TYPE DIREC
SIZE AS LONG ' SIZE
DATE AS STRING * 10 ' DATE
TIME AS STRING * 6 ' TIME
ATTR AS INTEGER ' ATTRIBUTE
END TYPE
COMMON SHARED /DIRECTORY/ DIREC$(), DIRINFO() AS DIREC
'----------------------------------------------------------------------------
DECLARE SUB B4INPT (INPTEXIT$, RESTRICT$)
DECLARE SUB B4SCRL (EXIT$, MARK$, TAGCOL%, NOREFRESH%)
DECLARE SUB BOXW (TR%, LC%, WD%, NR%, BORDER%)
DECLARE FUNCTION CHOICEBAR% (Choice$(), TR%, LC%, WD%, ATTR%, HATTR%, EXIT$)
DECLARE FUNCTION CHOICEWIND% (TITLE$, TX$(), CH$(), TR%, LC%, ATTR%, HCOL%, ESCEXIT%, BORDER%)
DECLARE SUB CHNGPULL (BAR%, WIND%, ATTR%)
DECLARE SUB CHNGWIND (W%)
DECLARE SUB CLRWIND ()
DECLARE SUB CUROFF ()
DECLARE SUB DELWIND (W%)
DECLARE SUB DISKSIZE (DISK%, DISKSZE&, FREESPACE&)
DECLARE SUB DOSOUND ()
DECLARE FUNCTION FINDPATH$ ()
DECLARE SUB FINDDIR (PATH$, TYPE$, F%)
DECLARE SUB GETANS (TEXT$, Choice$, ANS$, TR%, LC%, WATTR%, FATTR%, BORDER%)
DECLARE FUNCTION GETCUR& ()
DECLARE FUNCTION GETDISK% ()
DECLARE SUB INFOFIXED (FIXED$)
DECLARE SUB INFOLINE (TR%, LC%, WD%, ATTR%)
DECLARE SUB INPTINIT (DTYPE%, ISDOT%, STARTAT1%, NOBLANK%, SND%)
DECLARE SUB INPTWIND (PROMPT$, CODE$, TR%, LC%, WD%, WATTR%, FATTR%, RTRN$, RK%, BUT%, BRD%)
DECLARE FUNCTION GETAKEY% ()
DECLARE FUNCTION LBUTTON% ()
DECLARE SUB LINEW (ROW%, TYP%)
DECLARE SUB MAKEFIELD (SCRN%, FLD%, SCODE%, STR%, SLC%, SWD%, SBASEATTR%, SACTATTR%, MATTR%, RES$, EXTO$, HOT%, CURPOS%, BRACKET%)
DECLARE SUB MAKEWIND (W%, LABEL$, TR%, LC%, WD%, NR%, ATTR%, BORDER%)
DECLARE FUNCTION MARKED% (RTRN$, START%)
DECLARE FUNCTION MOUSECOL% ()
DECLARE SUB MOUSEINIT ()
DECLARE FUNCTION MOUSEINMULT% (MULTSCRN%)
DECLARE FUNCTION MOUSEINWIND% (WIND%)
DECLARE SUB MOUSELIMITS (TROW%, BROW%, LCOL%, RCOL%)
DECLARE FUNCTION MOUSEON% (ONFLAF%)
DECLARE SUB MOUSEPOS (ROW%, COL%)
DECLARE FUNCTION MOUSEROW% ()
DECLARE SUB MOUSESHOW ()
DECLARE SUB MULTINPT (SCRN%, TOFLD%, OPT$, FROMFLD%, RKEY%, RTRN$(), SELFLD%)
DECLARE FUNCTION WVAL& (S$)
DECLARE SUB NEWCOLOR (ATTR%)
DECLARE FUNCTION PEEKASM& (S&, O&, BYVAL N%)
DECLARE SUB PRINTINFO (I$)
DECLARE SUB PRINTW (TEXT$, TR%, LC%)
DECLARE SUB PRINTWHOT (TEXT$, TR%, LC%, HOTCHAR%, ATTR%)
DECLARE SUB PULLDOWN (INFO$(), A%, B%, EXIT$, RKEY%, ATTR%, HATTR%, BORDER%)
DECLARE FUNCTION RBUTTON% ()
DECLARE SUB RESAVE ()
DECLARE SUB RSTRINFO (DELFLAG%)
DECLARE SUB RSTRINPT (DELFLAG%)
DECLARE SUB RSTRPULL (RSTRMBAR%)
DECLARE SUB RSTRWIND (W%, DELFLAG%)
DECLARE SUB SAVEWIND (W%, TR%, LC%, WD%, NR%)
DECLARE SUB SCRLWIND (LIST$(), INFO$(), TOPLINE$, ENTRIES%, RTRN$, RTRN%, LI%, FC%, RKEY%, HIATTR%, SCROLLBAR%, BUT%)
DECLARE SUB SCROLLPRINT (TR%, LC%, ATTR%)
DECLARE SUB SETCUR (C&)
DECLARE SUB SETDISK (DRIVE%, BADFLAG%)
DECLARE SUB SETINPT (SCRN%, DISPLAYLEN%, EXIT$, HOTCOL%)
DECLARE SUB SETPULL (TR%, LC%, WD%, PWIND$())
DECLARE SUB SETWIND (FAST%, SND%, SHADCOL%, NOHIGH%, BRACKETATTR%)
DECLARE SUB UPDATEFIELD (SCRN%, FLD%, TEXT$)
DECLARE FUNCTION WAVAIL% (W%)
DECLARE SUB WINDSTATUS ()
'---------------------------------------------------------------------------
DECLARE FUNCTION COL% (A%)
DECLARE SUB PRINTFILEINFO ()
DECLARE FUNCTION FINDDRV% ()
DECLARE FUNCTION FINDSUB% ()
DECLARE FUNCTION FINDFILE% ()
DECLARE SUB MESSAGE (M%)
DIM SHARED PATH$, OLDPATH$, FOUNDFILE$, OLDDR%, MODE$, I$(0), SPEC$
DIM SHARED DISKERROR%, NUMFILES%, NUMSUBS%, LASTGOODPATH$, WASERR%
DIM SHARED FIL$(X%), SUBDIR$(X%), VOLUMN$, FILENUM%
DERROR:
CALL MESSAGE(0)
SELECT CASE ERR
CASE 24, 57, 71, 72
E$ = "DISK ERROR"
CASE 52, 64, 75, 76
E$ = "FILE SPEC ERROR"
CASE ELSE
END SELECT
REDIM C$(2), T$(0)
C$(1) = "Retry": C$(2) = "Abort"
A% = COL%(31)
X% = CHOICEWIND%("@ " + E$ + " ", T$(), C$(), 7, 100, A%, 0, 0, 112)
IF X% = 1 THEN CALL MESSAGE(1): RESUME
DISKERROR% = 1: WASERR% = ERR: RESUME NEXT
SUB CHOICEDEMO
A% = COL%(31): IF A% = 15 THEN A% = 112: B% = 127 ELSE B% = 28
PRINTINFO " TAB to a selection and press ENTER or the SPACE BAR or use the MOUSE."
REDIM C$(5), T$(10)
FOR X% = 65 TO 69: C$(X% - 64) = CHR$(X%) + LCASE$(STRING$(5, X%)): NEXT
T$(1) = " 1. One to ten choices are permitted."
T$(2) = " 2. The windows width and length are automatically set."
T$(3) = " 3. Hot characater selection is available."
T$(4) = " 4. The area under the choice window is saved and restored on exit"
T$(5) = " 5. Selection can be made via the keyboard or the MOUSE."
T$(6) = " 6. Segmenting lines are permitted."
T$(7) = "-"
T$(9) = "@** Text can be automatically centered **"
J% = CHOICEWIND%("@** Choice Window **", T$(), C$(), 100, 100, A%, B%, 1, 111)
IF J% <> 27 THEN
REDIM C$(1), T$(1)
PRINTINFO " Select OK...."
C$(1) = "OK": T$(1) = "@" + CHR$(J% + 64) + LCASE$(STRING$(5, J% + 64))
J% = CHOICEWIND%(" Your choice was... ", T$(), C$(), 100, 100, 112, 0, 1, 112)
END IF
END SUB
FUNCTION FINDDRV% STATIC
'---------------------------------------------------------------------------
' look for drives only on first pass through this function
IF PASS% = 0 THEN ' 1st pass only
DR$ = SPACE$(26) ' room for 26 drive letters
EQUIP& = PEEKASM&(64, 16, 2) ' to see if B: is installed
IF (EQUIP& AND 1) = 1 THEN
IF 1 + (EQUIP& AND 192) \ 64 = 1 THEN NOB% = 66 ' NOB%=66 if no B: drv
END IF
DRIVES% = 0 ' counter for number of drives
FOR X% = 65 TO 90 '
IF X% <> NOB% THEN ' skip if X%=2 and NOB%=2
CALL SETDISK(X% - 64, BAD%) ' check for valid drive
IF BAD% <> 1 THEN ' not valid - no more checks
DRIVES% = DRIVES% + 1 ' increment drive counter
MID$(DR$, DRIVES%, 1) = CHR$(X%) ' place drive letter in DR$
END IF
END IF
NEXT
REDIM DRV$(DRIVES%) ' DIM to number of drives
FOR X% = 1 TO DRIVES%
DRV$(X%) = "[-" + MID$(DR$, X%, 1) + "-]" ' make scroll window list
NEXT
CALL SETDISK(OLDDR%, B%) ' make original default drive active
END IF
'---------------------------------------------------------------------------
DO
RTRN% = 0
CHNGWIND 3 ' this scroll window active
CALL B4SCRL("EOMCRT", "", 0, 0) ' set exit keys
RKEY% = -1
CALL SCRLWIND(DRV$(), I$(), "", DRIVES%, MODE$, RTRN%, LI%, 1, RKEY%, 0, 1, 0)
IF RKEY% = 13 THEN
' ENTER or double MOUSE click
' make selected drivv active
CALL SETDISK(ASC(MID$(DRV$(RTRN%), 3, 1)) - 64, B%)
ON ERROR GOTO DERROR ' for FINDPATH$
CALL MESSAGE(1) ' reading message
PATH$ = FINDPATH$ ' get drive path
ON ERROR GOTO 0
IF DISKERROR% = 1 THEN ' disk error
DISKERROR% = 0: FINDDRV% = 100: EXIT FUNCTION ' abort selected
END IF
IF PATH$ <> OLDPATH$ THEN
' new drive was selected so there is different path
ON ERROR GOTO DERROR ' about to read disk
DISKSIZE ASC(PATH$) - 64, DISKSZE&, FREESPACE& ' get disk info
ON ERROR GOTO 0
IF DISKERROR% = 1 THEN ' disk error
DISKERROR% = 0: FINDDRV% = 100: EXIT FUNCTION ' abort selected
END IF
CHNGWIND 4 ' full screen window
P$ = SPACE$(15): P1$ = P$
LSET P$ = STR$(DISKSZE&)
LSET P1$ = STR$(FREESPACE&)
CALL PRINTW(P$, 17, 21) ' print disk bytes
CALL PRINTW(P1$, 17, 61) ' print free bytes
MODE$ = "NV" ' view - exit with scroll bar ereasd
J% = FINDFILE% ' find the files
J% = FINDSUB% ' find the sub directories
MODE$ = "N" ' mode back to not view only
CALL PRINTFILEINFO ' erases any displayed file info
OLDPATH$ = PATH$ ' to check for future path changes
END IF
CALL MESSAGE(0) ' erase "reading" message
END IF
LOOP WHILE RKEY% = 13
FINDDRV% = RKEY% ' "exit" key in FINDDRV%
END FUNCTION
FUNCTION FINDFILE% STATIC
RKEY% = 0 ' no exit key
CHNGWIND 1 ' make this the active window
IF OLDPATH$ <> PATH$ THEN
' only if the path has changed
FOUNDFILE$ = "" ' new path no selected file
ON ERROR GOTO DERROR
CALL FINDDIR(LEFT$(PATH$, 3) + "*.*", "LV", F%)
IF F% <> 0 THEN VOLUMN$ = DIREC$(F%)
CALL FINDDIR(PATH$ + SPEC$, "AHSROL", NFIL%) ' find all files
ON ERROR GOTO 0
IF DISKERROR% = 1 THEN ' was a disk error
PATH$ = LASTGOODPATH$ ' restore last good path
DISKERROR% = 0: FINDFILE% = 100: EXIT FUNCTION ' abort selected
END IF
FIL% = NFIL% ' FIL% = number of found files
NUMFILES% = FIL% ' NUMFILES% shared with GETFILE
NR% = 0 ' tells B4SCRL refresh the scroll wind
RTRN% = 1 ' start on first file
LI% = 1 ' on line 1
CLRWIND ' clear the scroll window
REDIM FIL$(FIL%) ' make scroll window entries.
X% = 1
FOR X% = 1 TO FIL%
SWAP FIL$(X%), DIREC$(X%) ' " "
NEXT
ERASE DIREC$ ' get the memory back
ELSE ' no new path.
NR% = 1 ' tell B4SCRL no need to refresh wind
END IF
IF MODE$ = "N" THEN MODE$ = "SN"
IF FIL% <> 0 THEN
' only if there are files
' set exit keys - determine if scroll window is refreshed. enter scroll wind
CALL B4SCRL("OEMCRT", "", 0, NR%)
SCROLLPRINT 8, 9, 112
RKEY% = -1
CALL SCRLWIND(FIL$(), I$(), "", FIL%, MODE$, RTRN%, LI%, 1, RKEY%, 0, 1, 0)
IF MODE$ = "SN" THEN
FILENUM% = RTRN%
FOUNDFILE$ = FIL$(RTRN%)
END IF
IF RKEY% = 13 THEN
' ENTER selected or double MOUSE click
CALL PRINTFILEINFO ' erase last selected file info
FOUNDFILE$ = FIL$(RTRN%) ' new selected file
P$ = SPACE$(12)
LSET P$ = FOUNDFILE$
PRINTW FOUNDFILE$, 5, 8
P1$ = SPACE$(8)
LSET P1$ = STR$(DIRINFO(RTRN%).SIZE)
CALL PRINTW("Bytes:" + P1$, 5, 25) ' print file size
CALL PRINTW("Date:" + DIRINFO(RTRN%).DATE, 5, 45) ' print file date
CALL PRINTW("Time:" + DIRINFO(RTRN%).TIME, 5, 64) ' print file time
END IF
END IF
FINDFILE% = RKEY% ' "exit" key in FINDFILE%
IF MODE$ = "SN" THEN MODE$ = "N"
END FUNCTION
FUNCTION FINDSUB% STATIC
RKEY% = 0 ' no exit key
GOSUB GETSUBS ' get any sub directories
DO
CHNGWIND 2 ' make this window active
IF NR% = 0 THEN CLRWIND ' clear it if to be refreshed
IF SUBDIR% <> 0 THEN
' sub GETSUBS found some subs
' set exit keys and determine if window is to be refreshed - enter wind
RKEY% = -1
CALL B4SCRL("OEMCRT", "", 0, NR%)
CALL SCRLWIND(SUBDIR$(), I$(), "", SUBDIR%, MODE$, RTRN%, LI%, 1, RKEY%, 0, 1, 0)
IF RKEY% = 13 THEN
' ENTER selected or double MOUSE click
IF SUBDIR$(RTRN%) = ".." THEN
' go "up" the dir tree
DO
PATH$ = LEFT$(PATH$, LEN(PATH$) - 1)
IF RIGHT$(PATH$, 1) = "\" THEN
PATH$ = LEFT$(PATH$, LEN(PATH$))
EXIT DO
END IF
LOOP
ELSE
'add selected dir to existing to existing path
PATH$ = PATH$ + SUBDIR$(RTRN%) + "\"
END IF
CALL MESSAGE(1) ' "reading" message
GOSUB GETSUBS ' find subs based on selection
MODE$ = "NV" ' call to FINDFILE% is view only
J% = FINDFILE% ' get the files for the new path
CALL MESSAGE(0) ' erase the message
MODE$ = "N" ' mode no longer view only
CALL PRINTFILEINFO ' erase any exiting file infp
OLDPATH$ = PATH$
END IF
END IF
LOOP WHILE RKEY% = 13
FINDSUB% = RKEY% ' return with "exit" key in FINDSUB%
EXIT FUNCTION
'---------------------------------------------------------------------------
' get any sub directories
GETSUBS:
IF PATH$ <> OLDPATH$ THEN
' only if the path has changed
ON ERROR GOTO DERROR
CALL FINDDIR(PATH$ + "*.*", "D", F%) ' find all dirs
ON ERROR GOTO 0
IF DISKERROR% = 1 THEN ' was a disk error
DISKERROR% = 0: FINDSUB% = 100 ' abort was selected
PATH$ = OLDPATH$ ' error, so restore the old path
EXIT FUNCTION ' and get ot
END IF
LASTGOODPATH$ = PATH$ ' save the path
IF F% > 0 THEN
' dirs were found
IF DIREC$(1) = "." THEN
SUBDIR% = F% - 1: START% = 2 ' not using the root dir
ELSE
SUBDIR% = F%: START% = 1 ' path was changed to root dir
END IF
REDIM SUBDIR$(SUBDIR%) ' to hold sub-directories
Y% = 1
FOR X% = START% TO F%
SWAP SUBDIR$(Y%), DIREC$(X%) ' put sub dirs in SUBDIR%()
Y% = Y% + 1
NEXT
ERASE DIREC$ ' get the memory back
ELSE
SUBDIR% = 0 ' no sub dirs found
END IF
NUMSUBS% = SUBDIR% ' for GETFILE%
NR% = 0 ' tell B4SCRL to refresh wind
RTRN% = 1 ' start on first entry
ELSE
NR% = 1 ' no new path - don't refresh wind
END IF
RETURN
END FUNCTION
SUB GETANSDEMO
A% = COL%(95) ' COLOR GRAY/PURPLE OR B/W
' MAKE WINDOW 1 AND PRINT IN SAME.
MAKEWIND 1, "@***** Get Answer Window Demonstration *****", 4, 100, 72, 9, A%, 132
PRINTW "Get answer windows are used to ask a question and wait for a single", 1, 100
PRINTW "key response. They can also be used to pause a program and wait for", 2, 100
PRINTW "any key to be pressed. Prompts may be windowed or un-windowed. The", 3, 100
PRINTW "area under the prompt or window is restored on exit. If the response", 4, 100
PRINTW "is displayed, ENTER must be pressed to accept it....", 5, 2
PRINTINFO " Press Y or N. Press ENTER to accept...."
' Y, N or ESC are valid responses.. Displays "N" on entry as ANS$ = "N"
ANS$ = "N"
GETANS "Are you sure? (Y/N) " + S$, "YN", ANS$, 13, 100, A%, 15, 32
IF ANS$ <> CHR$(27) THEN
IF ANS$ = "Y" THEN TEMP$ = "YES" ELSE TEMP$ = "NO"
GOSUB REPLY
PRINTINFO " Press A, B or C..."
' A, B, C or ESC are valid. No fiels displayed on entry as ABS$ = ""
ANS$ = ""
GETANS "Press A, B or C to continue" + S$, "ABC", ANS$, 13, 100, A%, 0, 32
END IF
IF ANS$ <> CHR$(27) THEN
TEMP$ = ANS$: GOSUB REPLY
END IF
RSTRWIND 1, 1
EXIT SUB
REPLY:
PRINTINFO " Press any key....."
GETANS "Your reply was: " + TEMP$ + ". Press any key...", "", "", 13, 100, A% + 128, 0, 32
RETURN
END SUB
SUB GETFILE (P$, F$, RKEY%) STATIC
WASERR% = 0 ' start no errors
A% = COL%(31) ' color or b/w
CALL MAKEWIND(4, "@[ Select a file ]", 1, 1, 80, 25, 112, 102)
OLDDR% = GETDISK% ' save existing default drive
ON ERROR GOTO DERROR
PATH$ = FINDPATH$ ' get existing path
DISKSIZE OLDDR%, DISKSZE&, FREESPACE& ' and existing disk size/ free space
ON ERROR GOTO 0
IF DISKERROR% = 1 THEN ' was a disk error
DISKERROR% = 0 ' abort was selected
GOTO GETOUT
END IF
CALL PRINTW("DISK BYTES:" + STR$(DISKSZE&), 17, 10) ' print disk bytes
CALL PRINTW("FREE BYTES:" + STR$(FREESPACE&), 17, 50) ' print free bytes
CALL PRINTW("ID:", 3, 2)
CALL PRINTW("Path:", 4, 2) ' print in full screen window
CALL PRINTW("File:", 5, 2) ' "
CALL LINEW(18, 1) ' "
CALL LINEW(20, 1) ' "
'-------------------------------------------------------------------------
' make the three windows to be used as scroll windows
CALL MAKEWIND(1, "@Files", 10, 10, 16, 9, A%, 101)
CALL MAKEWIND(2, "@Directories", 10, 36, 16, 9, A%, 101)
CALL MAKEWIND(3, "@Drives", 10, 61, 10, 9, A%, 101)
'-------------------------------------------------------------------------
' print/update scroll windows -- print choicebar
SPEC$ = "*.*" ' start with all files
GOSUB UPDATEALL ' update scroll windows and choice bar
WASERR% = 0
'-------------------------------------------------------------------------
LOOKIN% = 1 ' start in FILE SPEC: input window
' for info-line
I$ = " Press ENTER or DOUBLE CLICK MOUSE to select. Press tab to move."
DO
SELECT CASE LOOKIN%
CASE 1 ' file spec input window
CALL PRINTINFO(" Enter a file spec. ( EX: *.BAS / *.DOC ). ENTER accepts - TAB moves.")
GOSUB GETSPEC
IF RKEY% = 14 OR RKEY% = 15 THEN LOOKIN% = 2 ' TAB or SHIFT+TAB
CASE 2 ' files scroll window
INFOFIXED I$
GOSUB GETFILES
IF RKEY% = 15 OR RKEY% = 0 THEN LOOKIN% = 3 ' TAB "view" or no entries
IF RKEY% = 14 THEN LOOKIN% = 1 ' SHIFT/TAB
IF RKEY% = 13 THEN RKEY% = 1 ' SAME AS <OK>
CASE 3 ' directory scroll window
INFOFIXED I$
GOSUB GETDIRS
IF RKEY% = 15 OR RKEY% = 0 THEN LOOKIN% = 4 ' TAB "view" or no entries
IF RKEY% = 14 THEN LOOKIN% = 2 ' SHIFT/TAB
CASE 4 ' drives scroll window
INFOFIXED I$
GOSUB GETDRVS
IF RKEY% = 15 OR RKEY% = 0 THEN LOOKIN% = 5 ' TAB "view" or no entries
IF RKEY% = 14 THEN LOOKIN% = 3 ' SHIFT/TAB
CASE 5 ' < OK >, < CANCEL > choicebar
CALL PRINTINFO(" Select OK to accept or CANCEL to cancel.")
GOSUB GETCHOICE
IF RKEY% = 15 OR RKEY% = 0 THEN LOOKIN% = 1 ' TAB or "view"
IF RKEY% = 14 THEN LOOKIN% = 4 ' SHIFT/TAB
END SELECT
INFOFIXED "" ' erase infoline fixed string
' rkey% = 200 if left mouse button pressed out of window, field or choicebar.
IF RKEY% = 200 THEN GOSUB PROCESSMOUSE
LOOP WHILE RKEY% <> 27 AND RKEY% <> 1 ' do until ESC, < CANCEL > or < OK >
SETDISK OLDDR%, J% ' default drive back to original drive
GETOUT:
P$ = PATH$ ' returned path
F$ = FOUNDFILE$ ' returned file
CHNGWIND 4: LINEW 19, 0 ' erase < - OK - >, < CANCEL >
IF F$ <> "" AND RKEY% = 1 THEN
PRINTW F$, 5, 8
P1$ = STR$(DIRINFO(FILENUM%).SIZE)
CALL PRINTW("Bytes:" + P1$, 5, 25) ' print file size
CALL PRINTW("Date:" + DIRINFO(FILENUM%).DATE, 5, 45) ' print file date
CALL PRINTW("Time:" + DIRINFO(FILENUM%).TIME, 5, 64) ' print file time
END IF
FOR X% = 1 TO 3: DELWIND X%: NEXT ' delete scroll windows from window mem.
CALL RSTRINPT(0) ' deactivate active input wind (FILE SPEC)
ERASE FIL$, SUBDIR$, DIRINFO
EXIT SUB
'---------------------------------------------------------------------------
GETDRVS:
RKEY% = FINDDRV% ' drive scroll window
RETURN
'---------------------------------------------------------------------------
GETDIRS:
RKEY% = FINDSUB% ' directory scroll window
RETURN
'---------------------------------------------------------------------------
GETFILES:
RKEY% = FINDFILE% ' files scroll window
RETURN
'---------------------------------------------------------------------------
' go to scroll window, choicebar or input window if left mouse button is
' pressed with mouse cursor in same.
PROCESSMOUSE:
DO WHILE LBUTTON% = 1
IF MOUSEINWIND%(1) > 0 AND NUMFILES% > 0 THEN LOOKIN% = 2: EXIT DO
IF MOUSEINWIND%(2) > 0 AND NUMSUBS% > 0 THEN LOOKIN% = 3: EXIT DO
IF MOUSEINWIND%(3) > 0 THEN LOOKIN% = 4: EXIT DO
IF MOUSEINWIND%(21) > 0 THEN LOOKIN% = 1: EXIT DO
IF MOUSEROW% = 22 THEN LOOKIN% = 5: EXIT DO
LOOP
RETURN
'---------------------------------------------------------------------------
GETSPEC:
OLDSPEC$ = SPEC$
CALL B4INPT(EXIT$, "")
CALL INPTWIND("File Spec: ", "A", 4, 100, 5, 112, 112, SPEC$, RKEY%, 0, 1)
IF SPEC$ = "" THEN SPEC$ = "*.*"
IF RKEY% <> 27 AND SPEC$ <> OLDSPEC$ THEN
' file spec has changed
RR% = RKEY% ' save exit key
GOSUB UPDATEALL ' update all scroll windows
RKEY% = RR% ' restore exit key
IF WASERR% > 74 THEN SPEC$ = OLDSPEC$: WASERR% = 0
END IF
RETURN
'---------------------------------------------------------------------------
GETCHOICE:
REDIM C$(2): C$(1) = "- OK -": C$(2) = "CANCEL"
RKEY% = CHOICEBAR%(C$(), 22, 15, 50, 112, 1, EXIT$)
IF RKEY% = 2 THEN RKEY% = 27
RETURN
'---------------------------------------------------------------------------
UPDATEALL:
EXIT$ = "VIEW" ' view only for choice bar. enter and exit to display
GOSUB GETCHOICE
CALL MESSAGE(1)
MODE$ = "VN" ' view scroll windows ( enter-exit ) no scroll bar on exit
OLDPATH$ = "" ' scroll windows update when OLDPATH$ <> PATH$
GOSUB GETFILES
IF WASERR% = 0 THEN
GOSUB GETDIRS
GOSUB GETDRVS
END IF
CALL MESSAGE(0)
' scroll windows/ choicebar/ input window will be active when entered.
MODE$ = "N" ' exit scroll windows with scroll bar erased.
EXIT$ = "OTE" ' mouse out of/ TAB / SHIFT TAB exit
' CHOICEBAR and INPTWIND.
CALL PRINTFILEINFO
OLDPATH$ = PATH$ ' no scroll windows update if OLDPATH$ = PATH$
RETURN
'---------------------------------------------------------------------------
END SUB
SUB MESSAGE (M%)
IF M% = 1 THEN
CALL MAKEWIND(5, "", 4, 100, 38, 3, 15, 2)
CALL PRINTW("Reading directory tree....", 1, 100)
ELSE
RSTRWIND 5, 1
END IF
END SUB
SUB MULTINPUTDEMO2
RSTRINFO 0 ' RESTORE AREA UNDER INFOLINE
INFOLINE 0, 0, 0, 15
C& = GETCUR&
A% = COL%(23): IF A% = 15 THEN A% = 112 ' A%= COLOR -- B/W
STATIC CHNGRTRN$(), ONSEARCH%, NOTFIRSTPASS%, HOTCOL%
IF NOTFIRSTPASS% = 0 THEN
REDIM CHNGRTRN$(11) ' FOR "CHANGE" MULTINPT
CHNGRTRN$(3) = "[ ] Match Upper/Lowercase"
CHNGRTRN$(4) = "[ ] Whole Word"
CHNGRTRN$(5) = "(" + CHR$(4) + ") 1. Active Window"
CHNGRTRN$(6) = "( ) 2. Current Module"
CHNGRTRN$(7) = "( ) 3. All Modules"
CHNGRTRN$(8) = "< Find and Verify >"
CHNGRTRN$(9) = "< Change All >"
CHNGRTRN$(10) = "< Cancel >"
CHNGRTRN$(11) = "< Help >"
ONSEARCH% = 5
NOTFIRSTPASS% = 1
END IF
' PRINT THE INPUT SCREEN IN WINDOW 15
MAKEWIND 15, "@Multi-field Input. Extensive use of fixed choice fields.", 1, 1, 80, 25, A%, 102
MAKEWIND 0, "@ Change ", 6, 100, 59, 15, 112, 11
LINEW 12, 1
IF DEMONOHI% = 1 THEN HOTCOL% = 7 ELSE HOTCOL% = 127
CALL BOXW(1, 14, 43, 3, 1)
PRINTWHOT "Find What:", 2, 2, 1, HOTCOL%
CALL BOXW(4, 14, 43, 3, 1)
PRINTWHOT "Change To:", 5, 2, 8, HOTCOL%
CALL BOXW(7, 32, 25, 5, 1)
PRINTW " Search ", 7, 40
TOFLD% = 1 ' START IN FIELD ONE.
FROMFLD% = 0 ' UPDATE ALL FIELDS.
CHANGE:
' CURSOR TO FIELD 5 TO 7. THIS IS THE "SEARCH" SCOPE
IF TOFLD% > 4 AND TOFLD% < 8 THEN
TOFLD% = ONSEARCH%
END IF
SELECT CASE TOFLD% ' PU INSTRUCTIONS IN A$
CASE 1, 2 ' ON ACTIVE (TOFLD%) FIELD.
A$ = "Input data."
CASE 3, 4
A$ = "Press SPACE BAR to change."
CASE 5, 6, 7
A$ = "Press UP/DOWN arrow keys to change."
CASE 8 TO 11
A$ = "Press SPACE BAR/ENTER to select."
CASE ELSE
A$ = ""
END SELECT
A$ = A$ + " TAB = next field. ESC/ENTER exits."
PRINTINFO " " + A$
' GET MULTIFIELD INPUT. TOFLD% = THE ACTIVE FIELD ON ENTRY. FROMFLD%
' REPRESENTS THE FIELD WHICH IS ACTIVE ON EXIT
MULTINPT 3, TOFLD%, "U", FROMFLD%, RK%, CHNGRTRN$(), 0
IF RK% = 50 THEN RK% = 100 ' key character selection
IF RK% = 300 THEN GOTO CHANGE ' mouse release out of field
IF RK% = 100 THEN FROMFLD% = TOFLD%
IF FROMFLD% > 4 AND FROMFLD% < 8 THEN ' Cursor from search window.
IF RK% = 16 OR RK% = 19 OR RK% = 100 THEN ' Was UP or DOWN arrow.
IF RK% < 100 THEN
IF TOFLD% = 4 THEN TOFLD% = 7 ' Keep cursor in the
IF TOFLD% = 8 THEN TOFLD% = 5 ' search window.
END IF
MID$(CHNGRTRN$(ONSEARCH%), 2, 1) = " " ' make it a blank
FROMFLD% = ONSEARCH% ' blank this field
ONSEARCH% = TOFLD%
MID$(CHNGRTRN$(TOFLD%), 2, 1) = CHR$(4) ' Only one choice is permitted.
END IF
IF RK% = 14 THEN TOFLD% = 4 ' Was SHIFT TAB
IF RK% = 15 THEN TOFLD% = 8 ' Was TAB
END IF
SELECT CASE RK%
' RETURN CAUSED EXIT.
CASE 13
PICK$ = "ENTER"
IF FROMFLD% >= 7 THEN PICK$ = CHNGRTRN$(FROMFLD%)
GOTO PRINTRESULTS
' ESC CAUSED EXIT.
CASE 27
PICK$ = "ESC"
GOTO PRINTRESULTS
' SPACE BAR CAUSED EXIT.
CASE 32, 100
IF FROMFLD% = 3 OR FROMFLD% = 4 THEN ' EXITING FIELD 3 OR 4
IF MID$(CHNGRTRN$(FROMFLD%), 2, 1) = " " THEN
X$ = "X"
ELSE
X$ = " "
END IF
MID$(CHNGRTRN$(FROMFLD%), 2, 1) = X$
'IF CHNGRTRN$(FROMFLD%) = "" THEN CHNGRTRN$(FROMFLD%) = "X" ELSE CHNGRTRN$(FROMFLD%) = ""
ELSEIF FROMFLD% > 7 THEN ' EXITING FIELD 8,9,10,11
PICK$ = CHNGRTRN$(FROMFLD%)
GOTO PRINTRESULTS
ELSE ' FIELD 5,6,7
'NOTHING
END IF
CASE ELSE
END SELECT
GOTO CHANGE
PRINTRESULTS:
' PRINT THE RESULTS IN WINDOW 1. GETANS WAITS FOR ANY KEY.
REDIM T$(9)
T$(1) = SPACE$(55)
T$(2) = " Find What: = " + CHNGRTRN$(1)
T$(3) = " Change To: = " + CHNGRTRN$(2)
IF MID$(CHNGRTRN$(3), 2, 1) = " " THEN S$ = "No" ELSE S$ = "Yes"
T$(4) = " Match Upper/Lowercase = " + S$
IF MID$(CHNGRTRN$(4), 2, 1) = " " THEN S$ = "No" ELSE S$ = "Yes"
T$(5) = " Whole Word = " + S$
SELECT CASE ONSEARCH%
CASE 5
S$ = "Active Window"
CASE 6
S$ = "Current Module"
CASE ELSE
S$ = "All Modules"
END SELECT
T$(7) = " Search Criteria = " + S$
T$(9) = " Exit was via ...." + PICK$
REDIM Choice$(1)
Choice$(1) = "OK"
PRINTINFO " Select OK to proceed..........."
A% = CHOICEWIND%("@Results", T$(), Choice$(), 6, 11, 112, 112, 1, 111)
SETCUR (C&)
' RESTORING WINDOW 15 RESTORES THE SCREEN TO IT'S
' STATE BEFORE THIS SUB WAS CALLED.
RSTRWIND 15, 1
INFOLINE 0, 0, 0, COL%(31)
END SUB
SUB MULTSETUP (SCRN%)
A% = 25
REDIM M(A%) AS STRING * 50
'DECLARE SUB MAKEFIELD " (SCRN%, FLD%, SCODE%, STR%, SLC%, SWD%, SBASEATTR%, SACTATTR%, MATTR%, RES$, EXTO$, HOT%, CURPOS%, BRACKET%)
SELECT CASE SCRN%
CASE 1 'CD T L W B A M H C BR RES EXTO
CALL SETINPT(1, 25, "01", 0)
LSET M(1) = "10000,6,5,10,15,15,15,0,0,0, , ,"
LSET M(2) = "10040,8,5,10,15,15,15,0,0,0, , ,"
LSET M(3) = "10001,6,20,10,15,15,15,0,0,0, , ,"
LSET M(4) = "10002,6,35,10,15,15,15,0,0,0, , ,"
LSET M(5) = "30007,6,58,12,15,15,15,0,0,0, , ,"
LSET M(6) = "30007,8,58,12,15,15,15,0,0,0, , ,"
LSET M(7) = "10017,11,5,20,15,15,15,0,0,0, , ,"
LSET M(8) = "10027,11,31,20,15,15,15,0,0,0, , ,"
LSET M(9) = "10007,11,55,20,15,15,15,0,0,0, , ,"
LSET M(10) = "11017,16,22,1,15,15,15,0,0,0,MF, ,"
LSET M(11) = "11017,16,38,1,15,15,15,0,0,0,YN, ,"
LSET M(12) = "11000,16,60,3,15,15,15,0,0,0, , ,"
LSET M(13) = "11000,16,64,2,15,15,15,0,0,0, , ,"
LSET M(14) = "11000,16,67,3,15,15,15,0,0,0, , ,"
LSET M(15) = "11000,21,23,6,15,15,15,0,0,0, , ,"
LSET M(16) = "11000,21,38,6,15,15,15,0,0,0, , ,"
LSET M(17) = "100,21,53,7,15,15,15,0,0,0, , ,"
LSET M(18) = "30107,24,15,11,112,112,15,0,0,0, , ,"
LSET M(19) = "30107,24,55,12,112,112,15,0,0,0, , ,"
CASE 2
CALL SETINPT(2, 25, "EO", 127)
LSET M(1) = "30000,6,4,3,112,112,112,0,2,1, , ," ' Click
LSET M(2) = "30000,7,4,3,112,112,112,0,2,1, , ," ' Beep
LSET M(3) = "30000,8,4,3,112,112,112,0,2,1, , ," ' No sound
LSET M(4) = "30000,12,4,5,112,112,112,0,2,1, , ," ' Slow print
LSET M(5) = "30000,6,28,3,112,112,112,0,2,1, , ," ' Start of text
LSET M(6) = "30000,7, 28,3,112,112,112,0,2,1, , ," ' End of text
LSET M(7) = "30000,11,28,3,112,112,112,0,2,1, , ," ' Erase and print
LSET M(8) = "30000,12,28,3,112,112,112,0,2,1, , ," ' Prints
LSET M(9) = "30000,16,28,3,112,112,112,0,2,1, , ," ' Make default snd
LSET M(10) = "30000,17,28,3,112,112,112,0,2,1, , ," ' No sound"
LSET M(11) = "30000,21,28,3,112,112,112,0,2,1, , ," ' As a period
LSET M(12) = "30000,22,28,3,112,112,112,0,2,1, , ," ' As a comma
LSET M(13) = "10007,7,65,10,15,15,15,0,0,1, , ," ' Text
LSET M(14) = "10030,10,65,10,15,15,15,0,0,1, , ," ' Number
LSET M(15) = "10008,13,65,10,15,15,15,0,0,1, , ," ' Date
LSET M(16) = "30007,15,65,9,112,112,15,0,3,1, , ," ' < SOUND >
LSET M(17) = "30007,18,65,10,112,7,7,0,5,1, , ," ' < Ok >
LSET M(18) = "30007,21,65,10,112,7,7,0,3,1, , ," ' < Cancel >
CASE 3
CALL SETINPT(3, 25, "E", 127)
LSET M(1) = "10007,8,26,41,112,112,112,0,0,0, ,F," 'Find What:
LSET M(2) = "10007,11,26,41,112,112,112,0,0,0, ,T," 'Change To:
LSET M(3) = "30007,14,13,25,112,112,112,5,2,0, ,M," 'Match Upper/Lowercase
LSET M(4) = "30007,15,13,25,112,112,112,5,2,0, ,W," 'Whole Word
LSET M(5) = "30007,14,45,21,112,112,112,5,2,0, ,1," 'Active Window
LSET M(6) = "30007,15,45,21,112,112,112,5,2,0, ,2," 'Current Module
LSET M(7) = "30007,16,45,21,112,112,112,5,2,0, ,3," 'All Modules
LSET M(8) = "30007,19,13,19,112,112,7,12,3,1, ,V," 'Find and Verify
LSET M(9) = "30007,19,33,14,112,112,7,3,3,1, ,C," 'Change All
LSET M(10) = "30007,19,48,10,112,112,7,0,3,1, , ," 'Cancel
LSET M(11) = "30007,19,59,8,112,112,7,3,3,1, ,H," 'Help
CASE 4
CALL SETINPT(4, 25, "10", 0)
LSET M(1) = "10007,5,14,32,15,15,15,0,0,0, , ," ' name - upper case
LSET M(2) = "10007,7,14,32,15,15,15,0,0,0, , ," ' address - upper case
LSET M(3) = "10007,9,14,32,15,15,15,0,0,0, , ," ' address - upper case
LSET M(4) = "10007,11,14,32,15,15,15,0,0,0, , ," ' city/state - upper case
LSET M(5) = "10010,13,14,5,15,15,15,0,0,0, , ," ' zip - padded w/0's
LSET M(6) = "10008,5,56,10,15,15,15,0,0,0, , ," ' date
LSET M(7) = "10017,7,69,1,15,15,15,0,0,0,YN, ," ' registered user ( Y or N )
LSET M(8) = "10000,9,69,5,15,15,15,0,0,0, , ," ' registration number
LSET M(9) = "10017,13,69,1,15,15,15,0,0,0,YN, ," ' USE or CANADA ( Y or N )
LSET M(10) = "30007,15,25,20,15,15,15,0,0,0, , ," ' programming language
LSET M(11) = "30007,15,58,20,15,15,15,0,0,0, , ," ' disk size
LSET M(12) = "11017,17,33,1,15,15,15,0,0,0,YN, ," ' hard copy docs ( Y or N )
LSET M(13) = "10007,22,24,20,15,15,15,0,0,0,123456789 0, ," ' Visa/MC card number
LSET M(14) = "10007,22,63,5,15,15,15,0,0,0,1234567890/, ," ' expiration date
LSET M(15) = "30107,2,7,11,112,112,15,0,0,0, , ," ' F1=ABORT (mouse selectable)
LSET M(16) = "30107,2,62,13,112,112,15,0,0,0, , ," ' F10=PRINT (mouse selectable)
END SELECT
F% = 1
DO WHILE M(F%) <> STRING$(50, 0)
A% = 10: REDIM C%(A%)
E% = 0
FOR X% = 1 TO 12
S% = E% + 1
E% = INSTR(S%, M(F%), ",")
X$ = MID$(M(F%), S%, E% - S%)
SELECT CASE X%
CASE 1 TO 10
C%(X%) = WVAL&(X$)
CASE 11
RES$ = LTRIM$(X$)
CASE 12
EXTO$ = LTRIM$(X$)
END SELECT
NEXT
CALL MAKEFIELD(SCRN%, F%, C%(1), C%(2), C%(3), C%(4), C%(5), C%(6), C%(7), RES$, EXTO$, C%(8), C%(9), C%(10))
F% = F% + 1
LOOP
END SUB
SUB PRINTFILEINFO
' print the path in the full screen window
CALL CHNGWIND(4) ' make full screen window active
P$ = SPACE$(64)
V$ = SPACE$(12)
LSET V$ = VOLUMN$
LSET P$ = PATH$
CALL PRINTW(P$, 4, 8) ' print the path in it
CALL PRINTW(V$, 3, 6) ' print the VOLUMN
IF OLDPATH$ <> PATH$ THEN ' if it's a new path
P$ = SPACE$(12) ' erase all existing file info
CALL PRINTW(P$, 5, 8) ' " "
END IF
END SUB