home *** CD-ROM | disk | FTP | other *** search
- '----------------------------------------------------------------------------
- '-------------------------- Windows R-E-Z Demonstration ---------------------
- '-------------------------- CONNECT Software --------------------------------
- '-------------------------- Apr. 01, 1991 -----------------------------------
- '----------------------------------------------------------------------------
- '-------------------------- Copyright 1988,1989,1990,1991 -------------------
- '-------------------------- By: CONNECT Software ----------------------------
- '-------------------------- All rights reserved -----------------------------
- '----------------------------------------------------------------------------
- '
- ' **** VER 4.20 ------- LAST UPDATE ------- 04/01/1991 ****
- '
- '***************************************************************************
- '**** THIS PROGRAM MUST BE USED WITH ONE OF THE FOLLOWING LIBRARIES: ****
- '***************************************************************************
- '**** For QB4.+ unenhanced version use QB4UNEN.QLB ****
- '**** For BASIC 7.+ unenhanced version use PDSUNEN.QLB ****
- '**** For QB4.+ enhanced version use QB4ALL.QLB or QB4NER.QLB ****
- '**** For BASIC 7.0 enhanced version use PDSALL70.QLB or PDSNER70.QLB ****
- '**** For BASIC 7.1 enhanced version use PDSALL71.QLB or PDSNER71.QLB ****
- '**** Load QB or QBX with the /L option using the correct library ****
- '***************************************************************************
-
- DECLARE SUB CHNGPULL (BAR%, WIND%, ATTR%)
- DECLARE SUB CHNGWIND (W%)
- DECLARE SUB CLRWIND ()
- DECLARE SUB DELWIND (W%)
- DECLARE SUB DISKSIZE (DISK%, DISKSZE&, FREESPACE&)
- DECLARE SUB DOSOUND ()
- DECLARE SUB FINDPATH (PATH$)
- DECLARE SUB FINDDIR (PATH$, TYPE$, F%)
- DECLARE SUB GETANS (TEXT$, CHOICE$, ANS$, TR%, LC%, ATTR%, BORDER%)
- DECLARE SUB GETDISK (DR%)
- DECLARE SUB INPTWIND (PROMPT$, CODE$, TR%, LC%, WD%, ATTR%, RESTRICT$, RTRN$, RK%, BRD%)
- DECLARE FUNCTION KEYMOUSE%
- DECLARE SUB LINEW (ROW%, TYP%)
- DECLARE SUB MAKEWIND (W%, LABEL$, TR%, LC%, WD%, NR%, ATTR%, BORDER%)
- DECLARE FUNCTION MARKED% (RTRN$, START%)
- DECLARE SUB MBUTTONS (LBUTTON%, RBUTTON%)
- DECLARE SUB MOUSEON (ONFLAF%)
- DECLARE SUB MULTINPT (SCRN%, FLD%, EXIT$, AUTOEXIT%, RKEY%, RTRN$())
- DECLARE SUB NEWCOLOR (ATTR%)
- DECLARE SUB PRINTW (TEXT$, TR%, LC%)
- DECLARE SUB PULLDOWN (A%, B%, ATTR%, HATTR%, BORDER%)
- DECLARE SUB RESAVE ()
- DECLARE SUB RSTRWIND (W%, DELFLAG%)
- DECLARE SUB SAVEWIND (W%, TR%, LC%, WD%, NR%)
- DECLARE SUB SCRLWIND (LIST$(), ENTRIES%, RTRN$, RTRN%, HIATTR%)
- DECLARE SUB SETDISK (DRIVE%, BADFLAG%)
- DECLARE SUB SETINPT (SCRN%, WD%, EXIT$, INPT%(), INPT$(), BACKCOL%)
- DECLARE SUB SETPULL (TR%, LC%, WD%, BAR$, PWIND$())
- DECLARE SUB SETWIND (FAST%, SND%, SHADCOL%, NOHI%, DOT%, SCROLLARROW%, DFORMAT%)
- DECLARE SUB WINDSTATUS ()
-
- '---------- 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
-
- '--------------------------- DIMENSION ARRAYS -------------------------------
- DIM MRTRN1$(20), MRTRN2$(10) ' FOR MULTI-FIELD INPUT DEMO
- DIM COLCHOICE$(4), LOCHOICE$(4) ' " "
-
- MRTRN1$(5) = "RED" ' # 1 INPUT SCREEN
- MRTRN1$(6) = "NORTH" ' "
- COLCHOICE$(1) = "RED" ' "
- COLCHOICE$(2) = "PURPLE" ' "
- COLCHOICE$(3) = "YELLOW" ' "
- COLCHOICE$(4) = "GREEN" ' "
- LOCHOICE$(1) = "NORTH" ' "
- LOCHOICE$(2) = "SOUTH" ' "
- LOCHOICE$(3) = "EAST" ' "
- LOCHOICE$(4) = "WEST" ' "
- COLCHOICE% = 1: LOCHOICE% = 1 ' "
-
- MRTRN2$(1) = "CONNECT SOFTWARE" ' # 2 INPUT SCREEN
- MRTRN2$(2) = "6192 FAWN MEADOW" ' "
- MRTRN2$(3) = "FARMINGTON, NY" ' "
- MRTRN2$(4) = "14425" ' "
- MRTRN2$(6) = "123,1" ' "
- MRTRN2$(7) = "123,12" ' "
- MRTRN2$(8) = "123,123" ' "
-
- DIM LAN$(3), DISK$(2), VER$(10), ORDER$(20) ' FOR ORDER FORM
-
- LAN$(1) = "QuickBASIC 4.++" ' "
- LAN$(2) = "BASIC 7.0 - PDS" ' "
- LAN$(3) = "BASIC 7.1 - PDS" ' "
- LAN% = 1: ORDER$(10) = LAN$(1) ' "
-
- VER$(1) = "" ' "
- VER$(2) = "3.10" ' "
- VER$(3) = "3.20" ' "
- VER$(4) = "3.30" ' "
- VER$(5) = "3.40" ' "
- VER$(6) = "3.60" ' "
- VER$(7) = "4.00" ' "
- VER$(8) = "4.01" ' "
- VER$(9) = "4.10"
- VERS% = 1: ORDER$(9) = "" ' "
-
- DISK$(1) = "5.25 inch - 360K" ' "
- DISK$(2) = "3.5 inch - 720K" ' "
- DSIZE% = 1: ORDER$(11) = DISK$(1) ' "
-
- '-------------- ALLOWABLE DATE FORMATS FOR INPUT ROUTINES -------------------
- DIM DATETYPE$(5)
- DATETYPE$(1) = "mm-dd-yyyy"
- DATETYPE$(2) = "mm/dd/yyyy"
- DATETYPE$(3) = "dd-mm-yyyy"
- DATETYPE$(4) = "dd/mm/yyyy"
- DATETYPE$(5) = "dd.mm.yyyy"
- '----------------------------------------------------------------------------
- REALSTART:
- PREFLAG% = 1: A% = 15
- ON ERROR GOTO DISKERROR
- CALL FINDPATH(PATH$) ' FIND PRESENT DISK AND PATH
- PREFLAG% = 0
- ON ERROR GOTO 0
- MOUSEON (1) ' TURN THE MOUSE ON
- MBUTTONS 13, 27
- WIDTH 80
- CLS
- '-------------------- SET DATA FOR MULTIPLE SCROLL WINDOWS ------------------
- REDIM SRTRN1$(4), SRTRN2$(5), SRTRN3$(4), SRTRN4$(1), SRTRN5$(1)
- D% = 6
- REDIM SWIND%(D%), STR%(D%), SLC%(D%), SWID%(D%), SNR%(D%)
- REDIM ST$(D%), SENTRIES%(D%)
- FOR y% = 1 TO 6 ' 5 SCROLL WINDOWS + TITLES
- READ SWIND%(y%)
- READ STR%(y%)
- READ SLC%(y%)
- READ SWID%(y%)
- READ SNR%(y%)
- READ SENTRIES%(y%) ' ENTRIES FOR EACH SCROLL WINDOW
- FOR X% = 1 TO SENTRIES%(y%)
- SELECT CASE y%
- CASE 1
- READ SRTRN1$(X%)
- CASE 2
- READ SRTRN2$(X%)
- CASE 3
- READ SRTRN3$(X%)
- CASE 4
- READ SRTRN4$(X%)
- CASE 5
- READ SRTRN5$(X%)
- CASE 6
- READ ST$(X%)
- CASE ELSE
- END SELECT
- NEXT
- NEXT
-
- ' DATA FOR EACH SCROLL WINDOW AND TITLES
- ' WINDOW#,TOPROW,LEFT COLUMN,WIDTH,ROWS,ENTRIES, ITEMS.......
- DATA 16,6,13,16,7,3,No Border,Single line,Double line
- DATA 17,6,33,16,9,5,No Shadow,Right/Bottom,Left/Bottom,Left/Top,Right/Top
- DATA 18,6,52,16,7,2, On Top Line,In Title Box
- DATA 19,15,15,14,3,1,"----OK----"
- DATA 20,15,52,14,3,1,"--CANCEL--"
- DATA 0,0,0,0,0,3,"@Border","@Shadow","@Title"
-
- '--------------------- SET DATA FOR SCROLL WINDOW DEMO ----------------------
- DIM SCROLL$(20) ' READ DATA FOR SCROLL WINDOW DEMO
-
- FOR X% = 1 TO 14 ' "
- READ SCROLL$(X%) ' "
- NEXT ' "
-
- '***** DATA FOR SCROLL WINDOW DEMO *****
-
- DATA This is a sample of a scroll window.
- DATA The A@RROW keys or different colored
- DATA letter can be pressed to make a sel-
- DATA ection. REGULAR scroll windows exit
- DATA when ENTER is pressed. AUTO-EXIT
- DATA scroll windows exit if the letter
- DATA pressed is found. END / HOME / PGUP
- DATA and PGDN keys respond as ex@pected.
- DATA MARK scroll windows mark or unmark
- DATA items in the window with the "+"
- DATA or "-" keys. The PRINT k@ey or
- DATA SPACE B@AR marks or unmarks all
- DATA items. Press ECS to return to the
- DATA pulldown@ menu.
- '------------------ SET DATA FOR PULLDOWN WINDOWS -----------------------
- BAR$ = "Windows Input Print Directory Color Sound Order-Me" ' SET PULLDOWN
- B% = 200 ' WINDOWS MENUBAR
- REDIM PWIND$(B%) ' AND READ DATA
- TEMP% = 0 ' FOR PULLDOWN
- WHILE PWIND$(TEMP%) <> "ENDPULL" ' WINDOWS.
- TEMP% = TEMP% + 1
- READ PWIND$(TEMP%)
- WEND
-
- '***** DATA FOR PULLDOWN WINDOW DEMO *****
-
- DATA Window Management System,-,Multiple S@croll windows. - Window Types,Regular Scroll window, Auto-exit Scroll window, Mark Scroll window,-,Get answer windows,-,Ex@it, ***
- DATA Select date format,Multi-field input,Input window,***
- DATA Print in M@ultiple windows,-,Slow print ( Eliminates screen snow. ), Fast print,***
- DATA Directory routines,***
- DATA Black and white,Color,No hi-intensity (Black & white),***
- DATA Beep,Click,No sound,***
- DATA Make an order form,***
- DATA ENDPULL
-
- CALL SETPULL(2, 9, 60, BAR$, PWIND$()) ' SET UP PULLDOWN WINDOWS
- ERASE PWIND$ ' ERASE TEMPORARY ARRAY HOLD-
- ' ING PULLDOWN WINDOW DATA.
-
- '--------------- CALL SET UP ROUTINE FOR FIRST INPUT SCREEN -----------------
-
- A% = 150: REDIM INPT%(A%) ' INPT%() AND INPT$ HOLD DATA
- A% = 25: REDIM INPT$(A%) ' FOR FIELDS
- y% = 1: FLD% = 1
-
- DO
- READ INPT%(y%)
- IF INPT%(y%) = 9999 THEN EXIT DO
- y% = y% + 1
- FOR X% = 1 TO 5
- READ INPT%(y%)
- y% = y% + 1
- NEXT
- READ INPT$(FLD%)
- FLD% = FLD% + 1
- LOOP
-
- DATA 0,6,5,10,15,99,""
- DATA 10,8,5,10,15,99,""
- DATA 1,6,20,10,15,99,""
- DATA 2,6,35,10,15,99,""
-
- DATA 30007,6,58,12,15,99,""
- DATA 30007,8,58,12,15,99,""
-
- DATA 17,11,5,20,15,99,""
- DATA 27,11,31,20,15,99,""
- DATA 7,11,55,20,15,99,""
-
- DATA 1017,16,22,1,15,99,"MF"
- DATA 1017,16,38,1,15,99,"YN"
-
- DATA 1010,16,60,3,15,99,""
- DATA 1010,16,64,2,15,99,""
- DATA 1010,16,67,4,15,99,""
-
- DATA 21000,21,23,6,15,99,""
- DATA 21000,21,38,6,15,99,""
- DATA 100,21,53,7,15,99,""
-
- DATA 9999
-
- CALL SETINPT(1, 80, "012", INPT%(), INPT$(), 0) ' SET UP MULTI-INPUT SCREEN #1
- '----------------------------------------------------------------------------
-
- FAST% = 1 ' FAST PRINT
- SND% = 1 ' "CLICK" SOUND
- SHADCOL% = 7 ' BLACK/WHITE WINDOW SHADOWS
- NOHI% = 0 ' HI-INTENSITY ON
- DECPOINT% = 1
- SCROLLARROW% = 1
- DATETYPE$ = "mm-dd-yyyy"
- DFORMAT% = 1
- GOSUB SETPARAMETERS
- A% = 112
- '----------------------------- INTRODUCTION SCREEN --------------------------
- PREINTRO:
- IF SHADCOL% = 7 THEN A% = 112 ELSE A% = 116
- TITLEA$ = "WINDOWS R-E-Z ────── WINDOWS R-E-Z ────── WINDOWS R-E-Z ────── WINDOWS R-E-Z"
- MAKEWIND 0, "", 1, 1, 80, 25, A%, 2
- FOR X% = 1 TO 23 STEP 2
- PRINTW TITLEA$, X%, 2
- IF X% <> 23 THEN PRINTW STRING$(76, 176), X% + 1, 2
- NEXT
- IF INTROPASS% = 1 THEN GOTO PREMAIN.MENU
-
- MAKEWIND 2, "@*** New for Version 4.20 ***", 3, 100, 67, 9, 15, 111
- PRINTW "- Pulldown windows may be placed at any screen location.", 1, 2
- PRINTW "- Input routines support dates from 01/01/1901 to 12/31/2099.", 2, 2
- PRINTW "- Date fields may be formated in ten user selectable formats.", 3, 2
- PRINTW "- ESC key can optionally exit multi-field input routine.", 4, 2
- PRINTW "- Less code!", 5, 2
- ONE:
- GETANS "Color or Monochrome? (C/M)", "CM", ANS$, 12, 100, 143, 12
-
- IF ANS$ = CHR$(27) THEN GOTO ONE
- IF ANS$ = "M" THEN
- DEMOATTR% = 112
- SHADCOL% = 7
- ELSE
- CALL CHNGPULL(5, 1, 0)
- DEMOATTR% = 0
- SHADCOL% = 8
- END IF
- GOSUB SETPARAMETERS
- RSTRWIND 2, 1
- INTROPASS% = 1: GOTO PREINTRO
- '----------------- SET DATA FOR SECOND MULTI-FIELD INPUT SCREEN -------------
-
- PREMAIN.MENU:
- RESTORE PREMAIN.MENU
- A% = 120: REDIM INPT%(A%) ' INPT%() AND INPT$ HOLD DATA
- A% = 20: REDIM INPT$(A%) ' FOR FIELDS
-
- y% = 1: FLD% = 1: Z% = 112
- DO
- READ INPT%(y%)
- IF INPT%(y%) = 9999 THEN EXIT DO
- y% = y% + 1
- FOR X% = 1 TO 5
- READ INPT%(y%)
- y% = y% + 1
- NEXT
- READ INPT$(FLD%)
- FLD% = FLD% + 1
- LOOP
-
- '***** DATA FOR SECOND MULTI-FIELD INPUT SCREEN *****
-
- DATA 10007,9,25,40,112,99,""
- DATA 10007,10,25,30,112,99,""
- DATA 10007,11,25,30,112,99,""
- DATA 10010,11,56,5,112,99,""
- DATA 10008,13,27,10,112,99,""
- DATA 10001,16,36,8,112,99,""
- DATA 10002,16,53,8,112,99,""
- DATA 10003,16,70,8,112,99,""
- IF DEMOATTR% = 0 THEN
- FOR X% = 5 TO 65 STEP 6
- INPT%(X%) = 71
- NEXT
- END IF
- DATA 9999
-
- CALL SETINPT(2, 80, "120", INPT%(), INPT$(), 15) ' SET UP MULTI-INPUT SCREEN #2 AND
-
- ERASE INPT%, INPT$
- '----------------------------------------------------------------------------
-
- PREMAIN.MENU2:
- IF DEMOATTR% = 112 THEN A% = 112 ELSE A% = 120
-
- '-------------- MAIN MENU WINDOW ---- USES PULLDOWN ROUTINE -----------------
-
- MAIN.MENU:
-
- CHNGWIND 0
- LINEW 1, 0
- LINEW 2, 2
-
- A% = 111: GOSUB COL
- MAKEWIND 2, "@WINDOWS R-E-Z", 5, 50, 25, 7, A%, 111
- PRINTW "Version 4.20", 1, 100
- PRINTW "CONNECT Software", 2, 100
- PRINTW "Apr. 1, 1991", 3, 100
-
- MAKEWIND 1, "@***** Instructions *****", 14, 100, 65, 10, A%, 111
- PRINTW " These are the PULLDOWN WINDOWS supplied with WINDOWS", 1, 3
- PRINTW "R-E-Z. This program demonstrates most of the features in-", 2, 3
- PRINTW "cluded. Use the arrow keys, mouse, or press the appropriate", 3, 3
- PRINTW "letter to make your selection. For this demonstration the", 4, 3
- PRINTW "the left mouse botton is set to ENTER and the right button", 5, 3
- PRINTW "is set to ESC. WINDOWS R-E-Z can re-define the buttons. ", 6, 3
-
- A% = 113: GOSUB COL: IF A% = 15 THEN A% = 112
- HATTR% = 127
- PULL:
- PULLDOWN BAR%, WIND%, A%, HATTR%, 12 ' PULLDOWN WINDOWS
- IF BAR% = 0 THEN GOTO PULL ' ESC OR VERSION
-
- RSTRWIND 2, 1
- RSTRWIND 1, 1
-
- CHNGWIND 0
- LINEW 2, 0
- PRINTW TITLEA$, 1, 2
- PRINTW STRING$(76, 176), 2, 2
-
- SELECT CASE BAR%
-
- '--------------------------- SCROLL WINDOW DEMO -----------------------------
-
- CASE 1 'WINDOWS OPTION FROM PULLDOWN MENUBAR
- SELECT CASE WIND%
-
- CASE 3 'MULTIPLE SCROLL WINDOWS - SINGLE MARK
-
- SCROLLARROW% = 0: GOSUB SETPARAMETERS ' NO ARROW
- A% = 116: GOSUB COL: IF A% = 15 THEN A% = 112
- MAKEWIND 14, "@** Multiple Scroll Windows -- Window types. **", 1, 1, 80, 25, A%, 102
- A% = 79: GOSUB COL
- MAKEWIND 15, "@Instructions", 18, 100, 66, 8, A%, 132
- PRINTW "Use the ARROW keys or MOUSE to select items. The RIGHT MOUSE", 1, 2
- PRINTW "BUTTON button or TAB moves to the next window. Press ENTER or", 2, 2
- PRINTW "the LEFT MOUSE button with the scroll bar on OK or CANCEL to", 3, 2
- PRINTW "finalize or cancel the selections. ESC cancels all selections.", 4, 2
-
- A% = 116: GOSUB COL
- FOR X% = 1 TO 5 ' MAKE WINDOWS FOR SCROLL WINDOWS
- IF X% > 3 THEN BRD% = 31 ELSE BRD% = 131
- CALL MAKEWIND(SWIND%(X%), ST$(X%), STR%(X%) - 1, SLC%(X%), SWID%(X%), SNR%(X%), A%, BRD%)
- NEXT
- KIND$ = "SV" ' FIRST PASS - ALL "VIEW" SCROLL
- ' WINDOWS ( PRINT AND EXIT )
- CALL MBUTTONS(13, 9) ' CHANGE LEFT MOUSE BUTTON TAB
- MSCROLL:
- CHNGWIND 16
- SCRLWIND SRTRN1$(), 3, KIND$, R1%, 0 ' BORDER SCROLL WINDOW
- IF R1% = 0 THEN GOTO NOCHANGE ' WAS ESC
- CHNGWIND 17
- SCRLWIND SRTRN2$(), 5, KIND$, R2%, 0 ' SHADOW SCROLL WINDOW
- IF R2% = 0 THEN GOTO NOCHANGE ' WAS ESC
- CHNGWIND 18
- SCRLWIND SRTRN3$(), 2, KIND$, R3%, 0 ' TITLE BOX SCROLL WINDOW
- IF R3% = 0 THEN GOTO NOCHANGE ' WAS ESC
- CHNGWIND 19
- SCRLWIND SRTRN4$(), 1, KIND$, R4%, 0 ' ---OK--- SCROLL WINDOW
- IF KIND$ = "S" THEN ' NOT "VIEW"
- IF R4% = 1 GOTO DSCRL ' WAS ENTER
- IF R4% = 0 THEN GOTO NOCHANGE ' WAS ESC
- ELSE ' KIND$ = "SV" FOR VIEW
- PR1% = R1%: PR2% = R2%: PR3% = R3% ' ONLY SCROLL WINDOWS.
- END IF
- CHNGWIND 20
- SCRLWIND SRTRN5$(), 1, KIND$, R5%, 0 ' -CANCEL- SCROLL WINDOW
- IF KIND$ = "SV" OR R5% = -1 THEN ' WAS VIEW ONLY OR TAB
- KIND$ = "S" ' MAKE SINGLE MARK SCROLL
- GOTO MSCROLL ' WINDOWS FOR SUBSEQUENT
- END IF ' PASSES.
- ' GO TO NOCHANGE IF R5%=1 <ENTER> OR R5%=0 <ESC>
-
- NOCHANGE:
- R3% = PR3%: R2% = PR2%: R1% = PR1% ' RETURN PREVIOUS VALUES
- GOTO CLRSCRL
- DSCRL:
- A% = 79: GOSUB COL
- RSTRWIND 15, 1: RSTRWIND 19, 1: RSTRWIND 20, 1
- BRD% = (R1% - 1) + (R2% - 1) * 10 + (R3% - 1) * 100
- MAKEWIND 20, "@You made this window!", 16, 100, 40, 8, A%, BRD%
- PRINTW "Border.." + SRTRN1$(R1%), 2, 9
- PRINTW "Shadow.." + SRTRN2$(R2%), 3, 9
- PRINTW "Title..." + SRTRN3$(R3%), 4, 9
- GETANS "Press any key...", "", "", 23, 100, 240, 0
- CLRSCRL:
- RSTRWIND 14, 1
- FOR X% = 20 TO 15 STEP -1
- DELWIND X%
- NEXT
- CALL MBUTTONS(13, 27) ' RESTORE MOUSE BUTTONS
- Q% = 1
- SCROLLARROW% = 1: GOSUB SETPARAMETERS ' TURN SCROLL ARROW ON
-
- CASE 4 ' REGULAR SCROLL WINDOW
- RTRN$ = "": OP% = 3: MARK% = 0
- OPT$ = "REGULAR"
- GOTO SCROLLDEMO
- CASE 5 ' AUTO-EXIT
- RTRN$ = "A": OP% = 1: MARK% = 0
- OPT$ = "AUTO-EXIT"
- GOTO SCROLLDEMO
- CASE 6 ' MARK
- RTRN$ = "M": OP% = 2: MARK% = 1
- OPT$ = "MARK"
-
- SCROLLDEMO:
- RSTRWIND 1, 1
- IF RTRN$ = CHR$(27) THEN GOTO MAIN.MENU ' ESC
- A% = 23: GOSUB COL: IF A% = 15 THEN HIATTR% = 15 ELSE HIATTR% = 31
- MAKEWIND 2, "@" + OPT$ + " SCROLL WINDOW", 4, 100, 40, 11, A%, 121
- RTRN% = 0
- IF A% = 15 THEN NEWCOLOR 7
- SCRLWIND SCROLL$(), 14, RTRN$, RTRN%, HIATTR%
- IF RTRN% = 0 THEN GOTO DONESCROLL ' ESC
-
- IF MARK% = 1 THEN
- TR% = 4: NR% = 18: TEXT$ = "@** THE MARKED ITEM(S) WERE: **": BR% = 121
- RSTRWIND 2, 1
- ELSE
- TR% = 17: NR% = 5: TEXT$ = "@The item selected was:": BR% = 121
- END IF
- MAKEWIND 3, TEXT$, TR%, 100, 40, NR%, A%, BR%
-
- IF MARK% = 1 THEN
- IF RTRN$ = "" THEN
- PRINTW "NO ITEMS WERE MARKED!", 8, 100
- ELSE
- TR% = 1: START% = 1 ' START SEARCH AT POSITION 1
- DO
- B% = MARKED%(RTRN$, START%) ' B%= MARKED ITEM # IN SCROLL$()
- IF B% <> 0 THEN
- S$ = SCROLL$(B%): GOSUB NEWSTR: PRINTW S$, TR%, 2
- ELSE
- EXIT DO
- END IF
- TR% = TR% + 1
- LOOP
- END IF
- ELSE
- S$ = SCROLL$(RTRN%): GOSUB NEWSTR
- PRINTW S$, 1, 100
- END IF
- GETANS "[ Press any key ]", "", ANS$, 21, 100, 240, 0
- RSTRWIND 3, 1
- DONESCROLL:
- RSTRWIND 2, 1
-
- '---------------------------- GET ANSWER DEMO -------------------------------
-
- CASE 8 'GET ANSWER DEMO
- A% = 87: GOSUB COL
- MAKEWIND 1, "@***** Get Answer Window Demonstration *****", 5, 100, 72, 8, 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.", 4, 2
- GETANS "[ Press A,B or C to continue.. ]", "ABC", ANS$, 12, 100, 240, 0
- IF ANS$ = CHR$(27) THEN GOTO ENDGET
- GETANS "Are you sure? (Y/N)", "YN", ANS$, 16, 30, A%, 32
- IF ANS$ = CHR$(27) THEN GOTO ENDGET
- IF ANS$ = "Y" THEN TEMP$ = "YES" ELSE TEMP$ = "NO"
- MAKEWIND 2, "", 16, 28, 25, 3, A%, 32
- PRINTW "Your reply was: " + TEMP$, 1, 100
- A% = 71: GOSUB COL
- GETANS "Press any key...", "", ANS$, 21, 100, A% + 128, 32
- ENDGET:
- RSTRWIND 2, 1
- RSTRWIND 1, 1
-
- CASE 10 ' EXIT
- CLS
- END
- '---------------------------- WINDOW MANAGER DEMO ---------------------------
-
- CASE 1 'WINDOW MANAGER DEMO
-
- A% = 71: GOSUB COL
- MAKEWIND 20, "@*** Window Demonstration Instructions ***", 2, 100, 72, 10, A%, 111
- PRINTW "Window memory is dynamically allocated and returned to BASIC when a", 1, 3
- PRINTW "window is restored. Up to 20 windows may be stacked and restored.", 2, 3
- PRINTW "Window memory is outside of BASIC's normal 64K storage area. Press", 3, 3
- PRINTW "the UP ARROW or move the MOUSE up to create windows at random loca-", 4, 3
- PRINTW "tions. Press the DOWN ARROW or move the MOUSE down to remove the", 5, 3
- PRINTW "windows. Press ESC to return to the main menu.", 6, 3
-
- RANDOMIZE TIMER
- MAXWIND% = 19
- WIND% = 0
- GETMAKE:
- K% = KEYMOUSE%
- IF K% < 255 THEN TEMP$ = CHR$(K%) ELSE TEMP$ = CHR$(0) + CHR$(K% / 256)
- IF TEMP$ = CHR$(27) THEN
- FOR X% = 19 TO 1 STEP -1
- CALL RSTRWIND(X%, 1)
- NEXT
- CALL RSTRWIND(20, 1)
- GOTO MAIN.MENU
- END IF
- TR% = INT(11 * RND + 12)
- LC% = INT(60 * RND + 3)
- NR% = INT((25 - TR% - 3) * RND + 3)
- WI% = INT((80 - LC% - 16) * RND + 16)
- BO% = INT((2) * RND + 100) + 1
- IF TEMP$ = CHR$(0) + "H" THEN
- IF WIND% < MAXWIND% THEN WIND% = WIND% + 1 ELSE CALL DOSOUND: GOTO GETMAKE
- A% = WIND% * 16: IF A% = 128 OR A% = 256 THEN A% = 135
- IF A% > 127 THEN A% = A% - 128
- GOSUB COL:
- IF A% = 15 THEN IF WIND% / 2 <> INT(WIND% / 2) THEN A% = 112
- IF NR% < 8 OR BO% = 100 THEN BO% = BO% - 100
- MAKEWIND WIND%, "@Demo Window" + STR$(WIND%), TR%, LC%, WI%, NR%, A%, BO%
- END IF
- IF TEMP$ = CHR$(0) + "P" THEN
- IF WIND% > 0 THEN
- RSTRWIND WIND%, 1
- WIND% = WIND% - 1
- ELSE
- CALL DOSOUND
- END IF
- END IF
- GOTO GETMAKE
- CASE ELSE
-
- END SELECT
- '------------------------------- INPUT DEMO -------------------------------
-
- CASE 2 ' INPUT ROUTINES
- SELECT CASE WIND%
- '--------------------------- SELECT DATE FORMAT --------------------------
-
- CASE 1 ' DATE FORMAT
- A% = 23: GOSUB COL
- MAKEWIND 4, "", 7, 100, 60, 3, A%, 11
- PRINTW "Select the preferred date format for input routines.", 1, 100
- MAKEWIND 3, "", 100, 100, 14, 7, A%, 12
- PRETYPE% = DFORMAT%
- SCRLWIND DATETYPE$(), 5, "", DFORMAT%, 0
- RSTRWIND 3, 1
- RSTRWIND 4, 1
-
- IF DFORMAT% = 0 THEN
- DFORMAT% = PRETYPE%
- ELSE
- GETANS "DATE FORMAT FOR INPUT ROUTINES IS: " + DATETYPE$(DFORMAT%) + " -- Press any key....", "", "", 100, 100, A%, 11
- Q% = 1: GOSUB SETPARAMETERS
- END IF
-
- '---------------------------- MULTI-FIELD INPUT ---------------------------
-
- CASE 2 ' MULTI-FIELD INPUT
-
- A% = 71: GOSUB COL: IF A% = 15 THEN A% = 112
- MAKEWIND 20, "@***** Multi-field Input Demonstration *****", 4, 4, 74, 7, A%, 112
- PRINTW " Up to ten multi-field input screens may be defined using up to", 1, 2
- PRINTW "100 input fields per screen. Fields may be set to alpha/numeric num-", 2, 2
- PRINTW "eric, date, or protected. Complete editing features are incorporated.", 3, 2
- GETANS "Press any key.......", "", ANS$, 13, 100, A% + 128, 11
- RSTRWIND 20, 1
- IF ANS$ = CHR$(27) THEN GOTO ALLDONE
- MAKEWIND 20, "@F1 - Next Input Screen F2 - Main Menu F10 - Help", 1, 1, 80, 25, A%, 102
- IF THISDATE% <> DFORMAT% THEN MRTRN2$(5) = ""
- THISDATE% = DFORMAT%
- SCRN% = 1: FLD1% = 1: FLD2% = 1
-
- MAKEINPT:
- AUTOEXIT% = 0
- IF SCRN% = 1 THEN
- DECPOINT% = 1: Q% = 1: GOSUB SETPARAMETERS
- NEWCOLOR A%
- CLRWIND
- PRINTW "**** FIXED CHOICE FIELDS ****", 1, 48
- PRINTW "****** Press SPACE BAR ******.", 2, 48
- PRINTW "Decimal(0) Decimal(1) Decimal(2)", 2, 4
- PRINTW "Color...", 3, 48
- PRINTW "( Padded with leading zeros.) Location.", 5, 14
- PRINTW "Alpha/num. Upper case Alpha/num. Lower case Alpha/numeric", 7, 4
- PRINTW "*** Auto-advance fields -- Cursor moves to the next field automatically ***", 10, 100
- PRINTW "(-- Restricted Input --)", 12, 14
- PRINTW "M or F: Y or N: SOC SECURITY #.. - -", 13, 100
- PRINTW "* Auto-exit ( On change only ) and Auto-advance fields. (A,B ) *", 15, 100
- PRINTW "* Single field update on protected field C allows fast exit and return *", 16, 100
- PRINTW "[ PRESS F1 FOR MORE AUTO-EXIT EXAMPLES.]", 20, 100
- PRINTW "A +B =C", 18, 20
- PRINTW "If formatted number won't fit, field and input screen cannot be exited.", 21, 4
- MAKE1:
- MULTINPT 1, FLD1%, EXIT$, AUTOEXIT%, RKEY%, MRTRN1$()
-
- IF AUTOEXIT% <> 0 THEN
- SELECT CASE AUTOEXIT%
- CASE 5, 6
- IF EXIT$ = "FIXED" THEN
- IF AUTOEXIT% = 5 THEN
- COLCHOICE% = COLCHOICE% + 1
- IF COLCHOICE% = 5 THEN COLCHOICE% = 1
- MRTRN1$(5) = COLCHOICE$(COLCHOICE%)
- ELSE
- LOCHOICE% = LOCHOICE% + 1
- IF LOCHOICE% = 5 THEN LOCHOICE% = 1
- MRTRN1$(6) = LOCHOICE$(LOCHOICE%)
- END IF
- END IF
- CASE 15, 16
- AUTOEXIT% = 17 ' ONLY UPDATA THIS FIELD
- MRTRN1$(17) = STR$(VAL(MRTRN1$(15)) + VAL(MRTRN1$(16)))
- IF MRTRN1$(15) = "" AND MRTRN1$(16) = "" THEN MRTRN1$(17) = ""
- CASE ELSE
-
- END SELECT
- IF EXIT$ = "AUTO" OR EXIT$ = "FIXED" THEN GOTO MAKE1
- END IF
- IF EXIT$ = "F10" THEN GOSUB HELP: GOTO MAKE1
- END IF
-
- IF SCRN% = 2 THEN
- DECPOINT% = 0: Q% = 1: GOSUB SETPARAMETERS
- CLRWIND
- PRINTW "*** ---------- All fields are Auto-exit ( Always ) fields.---------- ***", 2, 100
- PRINTW "*** The instruction line is made possible by using Auto-exit fields. ***", 3, 100
- LINEW 4, 1
- LINEW 11, 1
- PRINTW "NAME..............", 6, 5
- PRINTW "ADDRESS...........", 7, 5
- PRINTW "CITY/STATE/ZIP....", 8, 5
- PRINTW "DATE...(" + DATETYPE$(DFORMAT%) + ")..", 10, 5
- PRINTW "Decimal 1 Decimal 2 Decimal 3", 12, 35
- PRINTW "Comma as decimal ( non-USA ):", 13, 5
- LINEW 14, 1
- PRINTW "* This example sets the active field to a different color than the inactive *", 16, 1
- PRINTW "* fields allowing the fields to be placed on consecutive rows without blend- *", 17, 1
- PRINTW "* ing into each other. The user's attention is drawn to the active field. *", 18, 1
-
- LINEW 20, 1
- NEWCOLOR 15
- PRINTW SPACE$(78), 21, 100
- MAKE2:
- SELECT CASE FLD2%
- CASE 1
- I$ = "INPUT YOUR NAME"
- CASE 2
- I$ = "INPUT YOUR STREET ADDRESS"
- CASE 3
- I$ = "INPUT YOUR CITY AND STATE"
- CASE 4
- I$ = "INPUT YOUR ZIP CODE"
- CASE 5
- I$ = "VALID DATE (" + DATETYPE$(DFORMAT%) + ") 1901 TO 2099 REQUIRED TO EXIT FIELD!"
- CASE 6, 7, 8
- I$ = "FIELD CAN NOT BE EXITED IF FORMATED NUMBER WILL NOT FIT!"
- CASE ELSE
- END SELECT
- PRINTW "INSTRUCTIONS: " + I$ + SPACE$(62 - LEN(I$)), 21, 2
- MULTINPT 2, FLD2%, EXIT$, AUTOEXIT%, RKEY%, MRTRN2$()
- AUTOEXIT% = 1
- IF EXIT$ = "F10" THEN GOSUB HELP: GOTO MAKE2
- IF EXIT$ = "AUTO" THEN GOTO MAKE2
- END IF
-
-
- IF EXIT$ = "F1" THEN
- IF SCRN% = 1 THEN
- SCRN% = 2
- ELSE
- NEWCOLOR A%
- LINEW 4, 0: LINEW 11, 0: LINEW 14, 0: LINEW 20, 0
- SCRN% = 1
- END IF
- GOTO MAKEINPT
- END IF
-
- GOTO ALLDONE
-
- HELP:
- MAKEWIND 15, "@***** Multi-field Input Instructions *****", 100, 100, 76, 14, 15, 101
- PRINTW "Key(s): Function:", 1, 2
- PRINTW "CTRL END/ CTRL HOME Move to first or last field.", 1, 2
- PRINTW "TAB/ SHIFT TAB Move from field to field horizontally.", 2, 2
- PRINTW "UP/ DOWN ARROW /ENTER Move from field to field. ( user defined order )", 3, 2
- PRINTW "BACKSPACE/ DELETE Erase character to left of or under cursor.", 4, 2
- PRINTW "LEFT/ RIGHT ARROW Moves cursor from start to end of text.", 5, 2
- PRINTW "INSERT Toggle between insert and overstrike mode.", 6, 2
- PRINTW "ESC/ CTRL E Returns field to pre-edited state. / Erases field.", 7, 2
- PRINTW "HOME/ END Moves cursor to start or end of text.", 8, 2
- PRINTW "SPACE BAR Erases field if it this is the first key pressed.", 9, 2
- GETANS "[ PRESS ANY KEY TO EXIT HELP ]", "", "", 19, 100, 240, 0
- RSTRWIND 15, 1
- CHNGWIND 20
- RETURN
-
- ALLDONE:
- DECPOINT% = 1: GOSUB SETPARAMETERS
- RSTRWIND 20, 1
-
- '------------------------------- INPUT WINDOW -------------------------------
-
- CASE 3 'INPUT WINDOW DEMO
- A% = 32: GOSUB COL ' GREEN
- IF A% = 32 THEN AADD% = 1000 ELSE AADD% = 0
- MAKEWIND 20, "@*** Input Window Demonstration ***", 3, 4, 70, 6, A%, 112
- PRINTW "An input window can be used to prompt for, and receive, input. The", 1, 2
- PRINTW "area under the window is automatically saved and restored on exit.", 2, 2
- GETANS "Press any key.......", "", ANS$, 13, 100, A% + 128, 11
- RSTRWIND 20, 1
-
- MAKEWIND 20, "@[ Input Window Instructions ]", 3, 100, 72, 9, A%, 12
- PRINTW "SPACE BAR/ CTRL E Erases field if first key pressed./ Erases field.", 1, 2
- PRINTW "ENTER Exits the procedure. ( Returns the string )", 2, 2
- PRINTW "BACKSPACE/ DELETE Erase character to left of or under cursor.", 3, 2
- PRINTW "LEFT/ RIGHT ARROW Moves cursor from start to end of input text.", 4, 2
- PRINTW "INSERT Toggle between insert and overstrike mode.", 5, 2
- PRINTW "ESC Returns field to pre-edited state, and exits.", 6, 2
- PRINTW "HOME/ END Move cursor to start or end of text.", 7, 2
- START.EDIT:
- GETANS "Press <U> for upper case - <L> for lower case - <B> for both.", "ULB", P$, 21, 100, A% + 128, 11
- IF P$ = CHR$(27) THEN GOTO DONEIWIND
- IF P$ = "B" THEN P$ = "A"
- I$ = "Input prompts can be printed "
- MAKEWIND 15, "", 20, 100, 74, 4, A% + 128, 11
- NEWCOLOR A%
- PRINTW I$ + "in the window's title box.", 1, 100
- INPTWIND "@** Input Your Name **", P$, 14, 100, 30, A% + AADD%, "", RTR$, RK%, 112
- IF RK% = 0 THEN GOTO DONEIWIND
- PRINTW I$ + "to the left of the field in the window.", 1, 100
- PRINTW "** Date format must be: " + DATETYPE$(DFORMAT%) + " (1901 to 2099) to exit field **", 2, 100
- INPTWIND "DATE:", "D", 15, 100, 10, A% + AADD%, "", RTR2$, RK%, 11
- IF RK% = 0 THEN GOTO DONEIWIND
- IF DEC$ = "" THEN
- CLRWIND
- GETANS "Number of decimal places to return for next Input Window ( 0-6 ) ?", "0123456", ANS$, 21, 100, A%, 0
- DEC$ = ANS$
- IF ANS$ = CHR$(27) THEN GOTO DONEIWIND
- END IF
- PRINTW " " + I$ + "without a window!!! ", 1, 100
- PRINTW "** The number with " + DEC$ + " decimals must fit to exit the field.**", 2, 100
- IF A% = 15 THEN ADD% = 97 ELSE ADD% = 0
- INPTWIND "Now Input a Number:", DEC$, 15, 100, 15, A% + AADD% + ADD% + 1000, "", RTR1$, RK%, 0
- IF RK% = 0 THEN GOTO DONEIWIND
- RSTRWIND 15, 1
- MAKEWIND 2, "@**** The Data Entered Was:****", 14, 100, 41, 5, A%, 12
- PRINTW "NAME: " + RTR$, 1, 2
- PRINTW "DATE: " + RTR2$, 2, 2
- PRINTW "NUMBER: " + RTR1$, 3, 2
- GETANS "Press (E) to Edit Data or (R) to Return to Main Menu.", "RE", ANS$, 21, 100, A% + 128, 11
- RSTRWIND 2, 1
- IF ANS$ = "E" THEN GOTO START.EDIT
-
- DONEIWIND:
- RSTRWIND 15, 1
- RSTRWIND 20, 1
- RTR$ = "": RTR1$ = "": DEC$ = "": RTR2$ = ""
- '----------------------------------------------------------------------------
- CASE ELSE
-
- END SELECT
- '----------------------------- WINDOW PRINT DEMO ----------------------------
- CASE 3 'PRINT IN A WINDOW
- SELECT CASE WIND%
- CASE 1
- MAKEWIND 1, "@Window #1", 4, 6, 30, 15, A%, 142
- PRINTW "(*** SAMPLE ****)", 11, 100
- B% = 71: IF A% = 15 THEN B% = 112
- MAKEWIND 2, "@Window #2", 4, 45, 30, 15, B%, 142
- PRINTW "(*** SAMPLE ****)", 11, 100
-
- GA$ = "to print in Window #1."
- GOSUB Press
-
- CHNGWIND 1
- PRINTW " Text can be printed in", 2, 3
- PRINTW "multiple windows. WIND-", 3, 3
- PRINTW "OWS R-E-Z remembers the", 4, 3
- PRINTW "color of text printed in", 5, 3
- PRINTW "the window and uses the", 6, 3
- PRINTW "same color the next time", 7, 3
- PRINTW "text is printed.", 8, 3
-
- GA$ = "to print in Window #2."
- GOSUB Press
-
- CHNGWIND 2
- PRINTW "* Text can be centered *", 1, 100
- PRINTW "CENTERED TEXT", 2, 100
- PRINTW "Single or double lines can", 4, 2
- PRINTW "be printed................", 5, 2
- LINEW 6, 1
- LINEW 7, 2
- PRINTW "A window's interior can be", 8, 2
- PRINTW "cleared with any color....", 9, 2
-
- GA$ = "to clear Window #1 with a new color."
- GOSUB Press
-
- B% = 95: IF A% = 15 THEN B% = 112
- CHNGWIND 1
- NEWCOLOR B%: CLRWIND
- PRINTW "(* New print-to color *)", 11, 100
-
- GA$ = "to print in Window #1 with the new print-to color"
- GOSUB Press
-
- PRINTW "When a window is cleared", 2, 3
- PRINTW "The color of text subse-", 3, 3
- PRINTW "quently printed, matches", 4, 3
- PRINTW "the print-to color speci-", 5, 3
- PRINTW "ied when the window was", 6, 3
- PRINTW "cleared.", 7, 3
-
- GA$ = "....."
- GOSUB Press
-
- B% = 92: IF A% = 15 THEN B% = 7
- NEWCOLOR B%
- PRINTW "The text's color can be", 8, 100
- PRINTW "changed at any time !!!!", 9, 100
-
- GOSUB Press
-
- RSTRWIND 1, 1: RSTRWIND 2, 1
-
-
- '---------------- TOGGLE FAST FROM ON TO OFF - OR OFF TO ON -----------------
-
- CASE 3
- B$ = "is set to SLOW"
- CALL CHNGPULL(3, 4, 0)
- FAST% = 0
- GOTO PRINTSPEED
-
- CASE 4
- B$ = "is set to FAST"
- CALL CHNGPULL(3, 3, 0)
- FAST% = 1
- PRINTSPEED:
- A% = 113: GOSUB COL
- MAKEWIND 1, "@***** Print " + B$ + " *****", 100, 100, 67, 6, A%, 112
- IF B$ = "is set to FAST" THEN
- PRINTW "Windowing and print speed are set to fast. This may cause snow", 1, 2
- PRINTW "or screen flicker if certain CGA display adaptors are used....", 2, 2
- ELSE
- PRINTW "Windowing and print speed are set to slow if a CGA display ad-", 1, 2
- PRINTW "aptor is present. This will eliminate screen snow or flicker.", 2, 2
- END IF
- A% = A% + 128
- GETANS "Press any key.......", "", ANS$, 15, 28, A%, 12
- RSTRWIND 1, 1
- '---------------------------------------------------------------------------
- CASE ELSE
-
- END SELECT
- GOSUB SETPARAMETERS
- GOTO PREMAIN.MENU2
- '--------------------------- DIRECTORY ROUTINES -----------------------------
- CASE 4
- A% = 23
- GOSUB COL
- MAKEWIND 10, "@**** Directory Demonstration ****", 3, 100, 70, 10, A%, 111
- PRINTW "Directory routines permit files from any path to be placed in an", 1, 100
- PRINTW "array. All, or selected files, can be found. Wildcards (*?) are", 2, 100
- PRINTW "permitted. Searches can include files with any combination of", 3, 100
- PRINTW "attributes. To suppliment functions included in QuickBASIC rout-", 4, 100
- PRINTW "ines to find disk size, free disk space, the current drive and", 5, 100
- PRINTW "path are included.", 6, 3
-
- A% = A% + 128
- GETANS "Press any key.....", "", "", 15, 100, A%, 11
- A% = A% - 128
- RSTRWIND 10, 1
- DISKINST:
- MAKEWIND 10, "@[ Instructions ]", 3, 100, 45, 13, A%, 11
- PRINTW "Input the path for the directory search.", 1, 100
- PRINTW "When prompted input the file attributes", 2, 100
- PRINTW "for the search.", 3, 2
- PRINTW "Attributes are......", 4, 100
- PRINTW "A - archived", 5, 6
- PRINTW "H - hidden", 6, 6
- PRINTW "R - read only", 7, 6
- PRINTW "S - system", 8, 6
- PRINTW "D - sub-directory", 9, 6
- PRINTW "O - other - no attribute", 10, 6
- PRINTW "V - volumn - must be root directory!", 11, 6
-
- PATH2$ = PATH$
- GETPATH:
- INPTWIND "@PATH: FORMAT = DRIVE:\DIRECTORY\....( WILDCARDS PERMITTED )", "U", 19, 100, 63, A%, "1234567890QWERTYUIOPLKJHGFDSAZXCVBNM\:?*_.", PATH2$, RK%, 111
- IF RK% = 0 THEN GOTO DONEDIR
- IF PATH2$ <> "" THEN
- PATH$ = PATH2$
- ELSE
- DOSOUND
- RSTRWIND 10, 1
- GOTO OVER
- END IF
- GETTYPE:
- TYPE$ = ""
- INPTWIND " FILE ATTRIBUTES (A/H/R/S/O/D/V):", "U", 19, 100, 7, A%, "AHRSODV", TYPE$, RK%, 111
- IF RK% = 0 THEN GOTO DONEDIR
- IF TYPE$ = "" THEN RSTRWIND 10, 1: GOTO OVER
-
- IF MID$(PATH$, 2, 1) = ":" THEN 'DRIVE WAS SPECIFIED
- DR% = ASC(UCASE$(PATH$)) - 64
- ELSE 'DRIVE NOT SPECIFIED - USE CURRENT DRIVE.
- GETDISK DR%: PATH$ = CHR$(DR% + 64) + ":" + PATH$
- END IF
-
- ON ERROR GOTO DISKERROR 'ALWAYS TRAP FOR ERRORS WHEN
- 'ACESSING A DISK.
- FINDDIR PATH$, TYPE$ + "L", F% 'PUT DIRECTORY IN DIREC$. "L" FOR LONG DIR
- DISKSIZE DR%, size&, free& 'GET DISK ROOM AND FREE ROOM.
- ON ERROR GOTO 0
- RSTRWIND 10, 1
- MAKEWIND 10, "@PATH: " + PATH$, 3, 100, 74, 17, A%, 111
- PRINTW "DISK SIZE =" + STR$(size&) + " BYTES", 11, 100
- PRINTW "BYTES FREE =" + STR$(free&) + " BYTES", 12, 100
- PRINTW "FILE ATTRIBUTES: " + TYPE$, 13, 100
-
- IF F% = 0 THEN 'NO DIRECTORY ENTRIES
- A% = A% + 128
- GETANS "NO ENTRIES. CONTINUE... (Y/N)?", "YN", ANS$, 21, 100, A%, 11
- A% = A% - 128
- RSTRWIND 10, 1
- IF ANS$ <> "Y" THEN GOTO OVER
- GOTO DISKINST
- ELSE 'DIRECTORY ENTRIES EXISTED
- PRINTW "[ DIRECTIONS: SELECT FILE WITH SCROLL BAR AND PRESS ENTER.]", 9, 100
- RTRN$ = "A"
- MAKEWIND 11, "", 6, 100, 16, 6, 112, 11
- HIATTR% = 0: RTRN% = 0
- SCRLWIND DIREC$(), F%, RTRN$, RTRN%, HIATTR% 'PUT DIREC$() IN WINDOW #1
- CHNGWIND 10
- LINEW 9, 0
- END IF
-
- RTRN$ = DIREC$(RTRN%)
-
- IF RTRN% = 0 THEN RSTRWIND 11, 1: RSTRWIND 10, 1: GOTO OVER
-
- FATTR% = DIRINFO(RTRN%).ATTR
-
- T$ = "File: ": IF FATTR% = 8 THEN T$ = "Volumn: " ELSE IF FATTR% = 16 THEN T$ = "Directory: "
- MAKEWIND 13, " " + T$ + RTRN$, 14, 100, 44, 7, 112, 112
- PRINTW "SIZE:" + STR$(DIRINFO(RTRN%).size) + " bytes", 1, 15
- PRINTW "DATE: " + DIRINFO(RTRN%).date, 2, 15
- PRINTW "TIME: " + DIRINFO(RTRN%).TIME, 3, 15
- GETANS "[ Repeat directory search (Y/N)? ]", "YN", ANS$, 20, 100, 143, 0
- RK% = 1
- DONEDIR:
- RSTRWIND 13, 1
- RSTRWIND 11, 1
- RSTRWIND 10, 1
-
- IF ANS$ <> "Y" OR RK% = 0 THEN GOTO OVER
- GOTO DISKINST
-
- DISKERROR:
- IF PREFLAG% = 1 THEN PATH$ = CURRDISK$
- SELECT CASE ERR
- CASE 75, 76
- E$ = "PATH NOT FOUND"
- CASE 71
- E$ = "DRIVE NOT READY"
- CASE 72
- E$ = "DISK MEDIA ERROR"
- CASE 57
- E$ = "I/O ERROR"
- CASE 68
- E$ = "DRIVE NOT AVAILABLE"
- CASE ELSE
- E$ = "UNIDENTIFIED ERROR"
- END SELECT
- A% = A% + 128
- GETANS "DRIVE " + LEFT$(PATH$, 2) + ". " + E$ + ". Press any key...", "", "", 21, 100, A%, 11
- A% = A% - 128
- IF PREFLAG% = 1 THEN RESUME REALSTART
- RSTRWIND 10, 1
- RESUME DISKINST
-
- OVER:
- ERASE DIREC$: DIREC$ = "" 'GET MEMORY BACK
-
- ON ERROR GOTO 0
- '------------------------------ COLOR ---------------------------------------
- CASE 5
- CHNGPULL 5, 1, 0 ' ALL SELECTIONS ACTIVE
- CHNGPULL 5, 2, 0
- CHNGPULL 5, 3, 0
- DEMOATTR% = 112 ' DEFAULT B/W
- NOHI% = 0 ' DEFAULT IS HI-INTEN
- SHADCOL% = 7
- IF WIND% = 2 THEN
- DEMOATTR% = 0 ' FLAG FOR COLOR
- SHADCOL% = 8 ' SHADOW DIM FOR COLOR
- ELSEIF WIND% = 3 THEN
- NOHI% = 1 ' SET NO HI-INTENSITY FLAG
- END IF
- GOSUB SETPARAMETERS
- GOTO PREINTRO
- '------------------------ SOUND = CLICK OR BEEP OR OFF --------------------
-
- CASE 6
- SELECT CASE WIND%
- CASE 1 ' TOGGLE SOUND
- B$ = "BEEP": SND% = 2
- GOTO DOSOUND
- CASE 2
- B$ = "CLICK": SND% = 1
- GOTO DOSOUND
- CASE 3
- B$ = "OFF": SND% = 0
- GOTO DOSOUND
- CASE ELSE
- END SELECT
-
- DOSOUND:
- CALL CHNGPULL(6, 1, 0)
- CALL CHNGPULL(6, 2, 0)
- CALL CHNGPULL(6, 3, 0)
- GOSUB SETPARAMETERS
- A% = 23
- GOSUB COL
- GETANS "The sound for all routines is set to " + B$ + ". Press any key.....", "", "", 100, 100, A%, 11
-
- '----------------------------- NO CASE ELSE ---------------------------------
-
- CASE 7
- RESTORE ORDERDATA
- A% = 151: B% = 25
- REDIM INPT%(A%), INPT$(B%)
- y% = 1: FLD% = 1
- DO
- READ INPT%(y%)
- IF INPT%(y%) = 9999 THEN EXIT DO
- y% = y% + 1
- FOR X% = 1 TO 5
- READ INPT%(y%)
- y% = y% + 1
- NEXT
- READ INPT$(FLD%)
- FLD% = FLD% + 1
- LOOP
- ORDERDATA:
- DATA 10007,5,14,32,15,99,""
- DATA 10007,7,14,32,15,99,""
- DATA 10007,9,14,32,15,99,""
- DATA 10007,11,14,32,15,99,""
- DATA 10010,13,14,5,15,99,""
- DATA 10008,5,56,10,15,99,""
- DATA 11017,7,69,1,15,99,"YN"
- DATA 10000,9,69,5,15,99,""
- DATA 30002,11,69,4,15,99,""
- DATA 30007,15,25,20,15,99," "
- DATA 30007,15,58,20,15,99,""
- DATA 11017,17,33,1,15,99,"YN"
- DATA 10007,22,24,20,15,99,"1234567890 "
- DATA 10007,22,63,5,15,99,"1234567890/"
- DATA 9999
- CALL SETINPT(2, 80, "10", INPT%(), INPT$(), 0) ' SET UP MULTI-INPUT SCREEN #2 AND
- ERASE INPT%, INPT$ ' ERASE TEMPORARY ARRAYS
-
- A% = 23: GOSUB COL: IF A% = 15 THEN A% = 112
-
- FLD% = 1: AUTOEXIT% = 0
-
- MAKEWIND 1, "@[ F1 = ABORT ] *** WINDOWS R-E-Z Order Form *** [ F10 = Print ]", 100, 100, 80, 25, A%, 101
- PRINTW "Name....... Date.....", 2, 2
- PRINTW "Address.... Registered User (Y/N).", 4, 2
- PRINTW "Address.... Registration Number..", 6, 2
- PRINTW "City/State. Registered Version...", 8, 2
- PRINTW "Zip Code... ( Enter 0 if not USA )", 10, 2
- PRINTW "Programming Language.. Disk Size............", 12, 2
-
-
- PRINTW "Hard Copy Documentation (Y/N). ( Same as on disk. Lazer printed. Three ) ", 14, 2
- PRINTW "( ring binder - $15.00 - USA orders only.)", 15, 36
-
- PRINTW "TERMS: Check/ money order/ Visa/ MC. Fees detailed on hard copy order form.", 17, 2
- PRINTW "Visa / Master card # Expiration date:", 19, 2
-
- NEWCOLOR 15
- PREYN$ = ORDER$(7)
- PREORDER:
-
- I$ = ""
-
- SELECT CASE FLD%
- CASE 1
- I$ = "Input your name."
- CASE 2, 3, 4
- I$ = "Input your address."
- CASE 5
- I$ = "Input your zip code."
- CASE 6
- I$ = "Enter today's date. (" + DATETYPE$(DFORMAT%) + ")"
- CASE 7
- I$ = "Input Y if you are a registered user or N if not."
- CASE 8
- I$ = "If you are a registered user input your registation number."
- CASE 9
- I$ = "CHOICES:/ / 3.10/ 3.20/ 3.30/ 3.30/ 3.40/ 3.50/ 3.60/ 4.00/ 4.01/ 4.10"
- GOSUB SPINST
- CASE 10
- I$ = "CHOICES: QuickBASIC 4.++ / BASIC 7.0 - PDS / BASIC 7.1 - PDS "
- GOSUB SPINST
- CASE 11
- I$ = "CHOICES: 5.25 inch - 360k / 3.5 inch - 720k"
- GOSUB SPINST
- CASE 12
- I$ = "Enter Y for hard copy documentation or N for none."
- CASE 13
- I$ = "Enter Visa/Master Card number if using same."
- CASE 14
- I$ = "Enter Visa/Master card expiration date. ( mm/yy )"
- CASE ELSE
- END SELECT
- IF FLD% < 9 OR FLD% > 11 THEN I$ = "INSTRUCTIONS: " + I$
-
- PRINTW I$ + SPACE$(76 - LEN(I$)), 21, 100
-
- MULTINPT 2, FLD%, EXIT$, AUTOEXIT%, RKEY%, ORDER$()
-
- IF EXIT$ = "FIXED" THEN ' Space bar - fields 9,10,11
-
- SELECT CASE AUTOEXIT%
- CASE 9 ' Space bar - field 9
- VERS% = VERS% + 1: IF VERS% = 10 THEN VERS% = 1
- ORDER$(9) = VER$(VERS%) ' change version
-
- CASE 10 ' Space bar - field 10
- LAN% = LAN% + 1: IF LAN% = 4 THEN LAN% = 1
- ORDER$(10) = LAN$(LAN%) ' change language
-
- CASE 11 ' Space bar - field 11
- DSIZE% = DSIZE% + 1: IF DSIZE% = 3 THEN DSIZE% = 1
- ORDER$(11) = DISK$(DSIZE%) ' change disk type
- CASE ELSE
- END SELECT
- GOTO PREORDER
-
- END IF
-
- ' Delete the space bar instruction window if the field is not a
- ' "multi-choice field or MULTINPT is exited via a function key.
- ' ( EXIT$ <> "AUTO" )
-
- IF AUTOEXIT% >= 9 AND AUTOEXIT% <= 11 THEN
- IF FLD% < 9 OR FLD% > 11 OR EXIT$ <> "AUTO" THEN
- RSTRWIND 3, 1
- WFLAG% = 0
- END IF
- END IF
-
- IF EXIT$ = "AUTO" THEN ' Was not a F1 or F10 as EXIT$ = "AUTO".
- GOTO PREORDER ' AUTOEXIT% can't = 0 so single field
- END IF ' only will update ( for speed ).
- ' Program can get here if cursor movement
- ' key is pressed on fixed-choice field or
- ' any other field
-
- IF EXIT$ = "F10" THEN ' F10 key was pressed to exit MULTINPT
- FERR% = 0
- FOR X% = 1 TO 14 ' check for blank fields
- SELECT CASE X%
- CASE 1, 4, 5, 6, 7, 12 ' fields require entry
- IF ORDER$(X%) = "" THEN
- FERR% = 1
- EXIT FOR
- END IF
- CASE 8, 9 ' fields 8 & 9 require entry if field 7 = "Y"
- IF ORDER$(7) = "Y" AND ORDER$(X%) = "" THEN
- FERR% = 1
- EXIT FOR
- ELSE
- IF ORDER$(7) = "N" AND ORDER$(X%) <> "" THEN
- FERR% = 2
- EXIT FOR
- END IF
- END IF
- CASE 14 ' field 14 requires entry if field 13 has entry
- IF ORDER$(13) <> "" AND ORDER$(14) = "" THEN
- FERR% = 1
- EXIT FOR
- END IF
- CASE ELSE
- END SELECT
- NEXT
-
- IF FERR% = 1 THEN ' a blank field was found
- CALL GETANS("BLANK FIELD: Entry required. Press any key...", "", "", 100, 100, 112, 11)
- FLD% = X%: AUTOEXIT% = 1: GOTO PREORDER
- ELSEIF FERR% = 2 THEN
- CALL GETANS("Field must be blank if Registered user field = N. Press any key...", "", "", 100, 100, 112, 11)
- FLD% = X%: AUTOEXIT% = 1: GOTO PREORDER
- END IF
-
-
- GETANS "Prepare your printer. Press any key when ready...", "", OANS$, 18, 100, 143, 2
- IF OANS$ = CHR$(27) THEN GOTO PREORDER
-
- ON ERROR GOTO PRINTERROR
- LI$ = STRING$(76, "-")
- LPRINT
- LPRINT TAB(4); LI$
- LPRINT TAB(28); "WINDOWS R-E-Z ORDER FORM"
- LPRINT TAB(34); "Version 4.10"
- LPRINT TAB(4); LI$
- LPRINT
- FOR P% = 1 TO 4
- LPRINT " " + ORDER$(P%);
- IF P% = 1 THEN LPRINT TAB(53); "Date: " + ORDER$(6);
- IF P% = 2 THEN LPRINT TAB(53); "Registered User: " + ORDER$(7);
- IF P% = 3 THEN LPRINT TAB(53); "Registration Number: " + ORDER$(8)
- IF P% = 4 THEN
- LPRINT " " + ORDER$(5);
- LPRINT TAB(53); "Registered Version: " + ORDER$(9)
- ELSE
- LPRINT : LPRINT
- END IF
- NEXT
- LPRINT
- LPRINT TAB(4); LI$
- LPRINT
- LPRINT " Programming Language: " + ORDER$(10)
- LPRINT
- LPRINT " Disk Size: " + ORDER$(11)
- LPRINT
- LPRINT TAB(4); LI$
- LPRINT
- LPRINT " Visa / Master card # " + ORDER$(13); TAB(55); "Expiration Date: " + ORDER$(14)
- LPRINT
- LPRINT TAB(4); LI$
- LPRINT
- LPRINT TAB(35); "Registration / Update fee: -------- ";
- IF ORDER$(7) = "N" THEN
- FEE$ = "$30.00": FEE = 30
- ELSE
- IF ORDER$(9) = "4.10" THEN
- FEE$ = "$15.00": FEE = 15
- ELSE
- FEE$ = "$20.00": FEE = 20
- END IF
- END IF
- LPRINT FEE$
- LPRINT
- LPRINT TAB(35); "Hard copy documentation charge ---- ";
- IF ORDER$(12) = "Y" THEN
- FEE$ = "$15.00": FEE = FEE + 15
- ELSE
- FEE$ = ""
- END IF
- LPRINT FEE$
- LPRINT
- LPRINT TAB(35); "Shipping and Handling-------------- $2.50"
- LPRINT
- FEE$ = STR$(FEE + 2.5): MID$(FEE$, 1) = "$"
-
- LPRINT TAB(35); " TOTAL CHARGE --------- ";
- LPRINT USING "$##.##"; FEE + 2.5
- LPRINT
- LPRINT TAB(4); LI$
- LPRINT
- LPRINT " Make checks and money orders payable to: CONNECT Software"
- LPRINT
- LPRINT " Send completed order form to: CONNECT Software"
- LPRINT TAB(37); "6192 Fawn Meadow"
- LPRINT TAB(37); "Farmington, NY 14425"
- LPRINT
- LPRINT
- LPRINT " Orders paid with a credit card or money order will be shipped within "
- LPRINT " two weeks of receipt. Orders paid with checks will be shipped within"
- LPRINT " three weeks of receipt."
- LPRINT
- LPRINT " Phone Orders - 6:OOpm - 9:00pm EST Monday - Friday"
- LPRINT " - 1:OOpm - 5:00pm EST Saturday - Sunday"
- LPRINT " - (716) 924-3439"
- LPRINT
- LPRINT " Call person to person for RICH - CONNECT SOFTWARE"
-
- LPRINT TAB(4); LI$
- LPRINT CHR$(12)
- DONEORDER:
- ON ERROR GOTO 0
-
- END IF
-
-
- RSTRWIND 1, 1 ' It was a function key
- GOTO PREMAIN.MENU
- CASE ELSE
-
- END SELECT
-
- GOTO MAIN.MENU
-
- PRINTERROR:
- GETANS "PRINTER ERROR: (R)etry or (A)bort.", "RA", OANS$, 100, 100, 143, 2
- IF OANS$ = "R" THEN RESUME ELSE RESUME DONEORDER
-
- SPINST:
- IF WFLAG% = 0 THEN
- CALL MAKEWIND(3, "", 18, 100, 75, 3, 240, 1)
- NEWCOLOR 15
- CALL PRINTW("Press SPACE BAR for selection. Press cursor movement key to exit field.", 1, 100)
- CHNGWIND 1
- WFLAG% = 1
- END IF
- RETURN
-
- '------ SUB FOR COLOR OR MONO DISPLAY \ SUB FOR PRESS ANY KEY ---------------
-
- COL:
- IF DEMOATTR% = 112 THEN A% = 15
- RETURN
-
- Press:
- GETANS "Press any key " + GA$, "", ANS$, 22, 100, A% + 128, 41
- RETURN
- NEWSTR:
- SA% = INSTR(S$, "@")
- IF SA% THEN S$ = LEFT$(S$, SA% - 1) + MID$(S$, SA% + 1)
- RETURN
-
- SETPARAMETERS:
- CALL SETWIND(FAST%, SND%, SHADCOL%, NOHI%, DECPOINT%, SCROLLARROW%, DFORMAT%)
- IF Q% = 1 THEN Q% = 0: RETURN
- IF DEMOATTR% = 112 THEN A% = 112 ELSE A% = 120
- IF FAST% = 1 THEN W% = 4 ELSE W% = 3
- CALL CHNGPULL(3, W%, A%) ' DISABLE SELECTION FOR FAST PRINT.
- IF SND% = 1 THEN W% = 2 ELSE IF SND% = 2 THEN W% = 1 ELSE W% = 3
- CALL CHNGPULL(6, W%, A%) ' DISABLE SELECTION FOR BEEP/CLICK/NO SOUND
- IF NOHI% = 1 THEN W% = 3 ELSE IF SHADCOL% = 8 THEN W% = 2 ELSE W% = 1
- CALL CHNGPULL(5, W%, A%) ' DISAPLE SELECTION FOR COLOR OR B/W
- RETURN
-
-