'---------------------------------------------------------------------------- '------------------------------ Windows R-E-Z Demo -------------------------- '------------------------------ By: R.A.Magnanti ---------------------------- '------------------------------ May 21, 1990 -------------------------------- '---------------------------------------------------------------------------- ' ' **** VER 3.60 ------- LAST UPDATE ------- 05/21/1990 **** ' '*************************************************************************** '***************** THIS PROGRAM MUST BE USED WITH THE LIBRARY ************* '***************** QB4ALL.QLB OR PDSALL.QLB. LOAD QUICKBASIC ************* '***************** 4.00+ WITH THE COMMAND QB/L QB4ALL.QLB. ************* '***************** LOAD BASIC 7.0 ( PDS ) WITH THE COMMAND ************* '***************** QBX/L PDSALL.QLB. ************* '*************************************************************************** DECLARE SUB LINEW (ROW%, TYP%) DECLARE SUB CHNGPULL (BAR%, WIND%, ATTR%) DECLARE SUB GETANS (TEXT$, CHOICE$, ANS$, TR%, LC%, ATTR%) DECLARE SUB FINDPATH (PATH$) DECLARE SUB FINDDIR (PATH$, DIREC$, TYPE$, F%) DECLARE SUB FILLDIR (DIREC$, DIREC$()) DECLARE SUB DISKSIZE (DISK%, DISKSZE&, FREESPACE&) DECLARE SUB RESAVE () DECLARE SUB CLRWIND () DECLARE SUB SETSOUND (S%) DECLARE SUB DOSOUND () DECLARE SUB CHNGWIND (W%) DECLARE SUB NEWCOLOR (ATTR%) DECLARE SUB PRINTW (TEXT$, TR%, LC%) DECLARE SUB INPTWIND (PROMPT$, CODE$, TR%, LC%, WD%, ATTR%, RESTRICT$, RTRN$) DECLARE SUB MULTINPT (SCRN%, FLD%, EXIT$, AUTOEXIT%, RTRN$()) DECLARE SUB SETINPT (SCRN%, WD%, EXIT$, INPT%(), INPT$()) DECLARE SUB CHNGFAST () DECLARE SUB DELWIND (W%) DECLARE SUB PULLDOWN (A%, B%, ATTR%, HATTR%) DECLARE SUB SETPULL (BAR$, PWIND$()) DECLARE SUB SCRLWIND (W%, LIST$(), ENTRIES%, RTRN$, RTRN%, HIATTR%) DECLARE SUB GETANS (TEXT$, CHOICE$, ANS$, TR%, LC%, ATTR%) DECLARE SUB RSTRWIND (W%, DELFLAG%) DECLARE SUB MAKEWIND (W%, LABEL$, TR%, LC%, WD%, NR%, ATTR%, BORDER%) DECLARE SUB SETWIND (ROOM%, FST%) DECLARE SUB SAVEWIND (W%, TR%, LC%, WD%, NR%) DECLARE FUNCTION MARKED% (RTRN$, START%) DECLARE SUB GETDISK (DR%) REALSTART: PREFLAG% = 1: A% = 15 ON ERROR GOTO DISKERROR CALL FINDPATH(PATH$) PREFLAG% = 0 ON ERROR GOTO 0 WIDTH 80 CLS FASTPRINTFLAG% = 1 CALL SETWIND(32, 1) ' SET WINDOW SPACE TO 32000 BYTES AND MAKE ' "FAST" WINDOWS. SECOND ARGUMENT = 0 FOR ' SLOW WINDOWING IF CGA CARD PRESENT ELSE ' WINDOWING IS FAST '-------------------- SET DATA FOR MULTIPLE SCROLL WINDOWS ------------------ DIM SRTRN1$(4), SRTRN2$(5), SRTRN3$(4), SRTRN4$(1), SRTRN5$(1) DIM SWIND%(6), STR%(6), SLC%(6), SWID%(6), SNR%(6), SENTRIES%(6) 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%) END SELECT NEXT NEXT ' DATA FOR EACH SCROLL WINDOW AND TITLES ' WINDOW#,TOPROW,LEFT COLUMN,WIDTH,ROWS,ENTRIES, ITEMS....... DATA 16,5,16,12,8,4,COLONIAL,SPLIT,BI-LEVEL,RANCH DATA 17,5,36,10,9,5,WHITE,BLUE,TAN,BROWN,YELLOW DATA 18,5,54,12,8,4,NORTH,SOUTH,EAST,WEST DATA 19,14,24,14,3,1,"----OK----" DATA 20,14,43,14,3,1,"--CANCEL--" DATA 0,0,0,0,0,3," TYPE"," COLOR"," LOCATION" '--------------------- SET DATA FOR SCROLL WINDOW DEMO ---------------------- DIM SCROLL$(20) ' READ DATA FOR SCROLL WINDOW DEMO FOR X% = 1 TO 20 ' " READ SCROLL$(X%) ' " NEXT ' " '***** DATA FOR SCROLL WINDOW DEMO ***** DATA This is a sample of a scroll window. DATA Use the UP and DOWN arrow keys to DATA scroll through the window or press DATA the differently colored letter to DATA to make a selection. Press RETURN DATA or ENTER to return the selected DATA item if the scroll window is a REG- DATA ULAR scroll window. If AUTO-EXIT is DATA ON the item will be returned auto- DATA matically provided the differently DATA colored letter of an item was selec- DATA ted. Pressing the END KEY or HOME DATA KEY moves the scroll bar to the last DATA or first item in the list. With the DATA MARK option ON the "+" or "-" keys DATA mark or unmark individual items in DATA the scroll window. The PRINT key or DATA SPACE BAR 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 Sound Quit Version" ' 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 ( Single mark ),Regular Scroll window, Auto-exit Scroll window, Mark Scroll window,-,Get answer windows, *** DATA Multi-field input , Input window,*** DATA Print in a window, Print in M@ultiple windows,-,Slow print ( Eliminates screen snow or flicker ), Fast print,*** DATA Directory routines,*** DATA Beep,Click,No sound,*** DATA Quit,*** DATA WINDOWS R-E-Z -- Ver. 3.60,-, Last update = 05/21/1990,-,BY... R.A.Magnanti,*** DATA ENDPULL CALL SETPULL(BAR$, PWIND$()) ' SET UP PULLDOWN WINDOWS ERASE PWIND$ ' ERASE TEMPORARY ARRAY HOLD- ' ING PULLDOWN WINDOW DATA. '------- ONE METHOD TO SET FIELD DATA FOR MULTI-FIELD INPUT SCREEN. --------- '------- THIS SETS THE FIRST 2 ROWS OF MULTI-FIELD INPUT SCREEN #1. -------- A% = 700: REDIM INPT%(A%) ' INPT%() AND INPT$ HOLD DATA A% = 100: REDIM INPT$(A%) ' FOR FIELDS Y% = 1 ' Y% FOR INPT%() FLD% = 1 ' FLD% FOR INPT$() FOR Z% = 5 TO 65 STEP 15 ' COLUMNS FOR X% = 6 TO 8 STEP 2 ' ROWS INPT%(Y%) = INT((Z% - 5) / 15) ' CODE IF X% = 8 THEN INPT%(Y%) = INPT%(Y%) + 10 ' PADDED INPT%(Y% + 1) = X% ' TOP ROW INPT%(Y% + 2) = Z% ' LEFT COLUMN INPT%(Y% + 3) = 10 ' WIDTH INPT%(Y% + 4) = 15 ' ATTRIBUTE INPT%(Y% + 5) = 99 ' CHECK INPT$(FLD%) = "" ' RESTRICT$ Y% = Y% + 6: FLD% = FLD% + 1 NEXT NEXT '------------------- CONTINUE SETTING FIELD DATA ---------------------------- '---------- THIS TIME USING READ AND DATA STATEMENTS --------------------- 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 17,10,5,20,15,99,"" DATA 27,10,31,20,15,99,"" DATA 7,10,55,20,15,99,"" DATA 1017,14,22,1,15,99,"MF" DATA 1017,14,38,1,15,99,"YN" DATA 1010,14,60,3,15,99,"" DATA 1010,14,64,2,15,99,"" DATA 1010,14,67,4,15,99,"" DATA 21000,18,20,6,15,99,"" DATA 21000,20,20,6,15,99,"" DATA 100,22,20,7,15,99,"" DATA 21000,18,60,6,15,99,"" DATA 21000,20,60,6,15,99,"" DATA 100,22,60,7,15,99,"" DATA 9999 CALL SETINPT(1, 80, "120", INPT%(), INPT$()) ' SET UP MULTI-INPUT SCREEN #1 '----------------- SET DATA FOR SECOND MULTI-FIELD INPUT SCREEN ------------- 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 FOR SECOND MULTI-FIELD INPUT SCREEN ***** DATA 10007,9,20,40,15,99,"" DATA 10007,11,20,30,15,99,"" DATA 10007,13,20,30,15,99,"" DATA 10010,13,60,5,15,99,"" DATA 10008,15,27,10,15,99,"" DATA 11010,15,65,3,15,99,"" DATA 11010,15,69,2,15,99,"" DATA 10010,15,72,4,15,99,"" DATA 9999 CALL SETINPT(2, 80, "120", INPT%(), INPT$()) ' SET UP MULTI-INPUT SCREEN #2 AND ERASE INPT% ' ERASE TEMPORARY ARRAYS ERASE INPT$ '----------------------------- INTRODUCTION SCREEN -------------------------- MAKEWIND 0, "", 1, 1, 80, 25, 7, 1 A$ = "WINDOWS R-E-Z WINDOWS R-E-Z WINDOWS R-E-Z WINDOWS R-E-Z" FOR X% = 2 TO 22 STEP 2 PRINTW A$, X%, 2 NEXT INTRO: MAKEWIND 2, "@*** New for WINDOWS R-E-Z -- Version 3.60 ***", 2, 100, 76, 8, 112, 101 PRINTW "1. Single mark scroll windows facilitate MULTIPLE SCROLL WINDOWS.", 1, 4 PRINTW "2. The ability to disable or enable items in pulldown windows.", 2, 4 PRINTW "3. Line printing capabilities for windows.", 3, 4 PRINTW "4. Numerous additional features with a smaller library ( .QLB )!", 4, 4 MAKEWIND 1, "@WINDOWS R-E-Z Demonstration", 100, 100, 33, 7, 112, 102 PRINTW "By: R.A.Magnanti", 1, 100 PRINTW "May 21, 1990", 2, 100 ONE: GETANS " Color or Monochrome? (C/M)", "CM", ANS$, 15, 100, 240 IF ANS$ = CHR$(27) THEN GOTO ONE IF ANS$ = "M" THEN DEMOATTR% = 112 ELSE DEMOATTR% = 0 RSTRWIND 1, 1 RSTRWIND 2, 1 A% = 120: GOSUB COL CALL CHNGPULL(3, 5, A%) ' DISABLE SELECTION FOR FAST PRINT. CALL CHNGPULL(5, 2, A%) ' DISABLE SELECTION FOR "CLICK" SOUND. '-------------- MAIN MENU WINDOW ---- USES PULLDOWN ROUTINE ----------------- MAIN.MENU: A% = 23 GOSUB COL MAKEWIND 1, "@***** Instructions *****", 100, 100, 65, 12, A%, 102 PRINTW " This is an example of PULLDOWN WINDOWS supplied with", 1, 3 PRINTW "WINDOWS R-E-Z. Use the pulldown windows to see all of the", 2, 3 PRINTW "features available. Strike the first letter of the menubar", 3, 3 PRINTW "item or use the arrow keys to make a choice. Then press the", 4, 3 PRINTW "differently colored letter of the pulldown window item or", 5, 3 PRINTW "or use the arrow keys to select the demonstration you would", 6, 3 PRINTW "like to see. If the arrow keys are used to select an item", 7, 3 PRINTW "press the key to finalize the selection.", 8, 3 A% = 113: GOSUB COL: IF A% = 112 THEN HATTR% = 127 ELSE HATTR% = 116 PULL: PULLDOWN BAR%, WIND%, A%, HATTR% ' PULLDOWN WINDOWS IF BAR% = 0 OR BAR% = 7 THEN GOTO PULL ' ESC OR VERSION RSTRWIND 1, 1 SELECT CASE BAR% '--------------------------- SCROLL WINDOW DEMO ----------------------------- CASE 1 'WINDOWS OPTION FROM PULLDOWN MENUBAR SELECT CASE WIND% CASE 3 'MULTIPLE SCROLL WINDOWS - SINGLE MARK A% = 116: GOSUB COL MAKEWIND 14, "@Multiple Scroll Windows", 1, 1, 80, 25, A%, 102 A% = 79: GOSUB COL MAKEWIND 15, "@Instructions", 17, 100, 54, 9, A%, 102 PRINTW "Use the UP ARROW or DOWN ARROW to select an item.", 1, 2 PRINTW "Press TAB to move to the next scroll window or to", 2, 2 PRINTW "move to OK or CANCEL. Press ENTER or RETURN with", 3, 2 PRINTW "the scroll bar on OK or CANCEL to finalize or can-", 4, 2 PRINTW "the selections. ESC cancels all selections.", 5, 2 A% = 116: GOSUB COL FOR X% = 1 TO 5 ' MAKE WINDOWS FOR SCROLL WINDOWS CALL MAKEWIND(SWIND%(X%), ST$(X%), STR%(X%), SLC%(X%), SWID%(X%), SNR%(X%), A%, 101) NEXT KIND$ = "SV" ' FIRST PASS - ALL "VIEW" SCROLL ' WINDOWS ( PRINT AND EXIT ) MSCROLL: SCRLWIND 16, SRTRN1$(), 4, KIND$, R1%, 0 ' TYPE SCROLL WINDOW IF R1% = 0 THEN GOTO NOCHANGE ' WAS ESC SCRLWIND 17, SRTRN2$(), 5, KIND$, R2%, 0 ' COLOR SCROLL WINDOW IF R2% = 0 THEN GOTO NOCHANGE ' WAS ESC SCRLWIND 18, SRTRN3$(), 4, KIND$, R3%, 0 ' LOCATION SCROLL WINDOW IF R3% = 0 THEN GOTO NOCHANGE ' WAS ESC SCRLWIND 19, 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 SCRLWIND 20, 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 OR R5%=0 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 MAKEWIND 18, "@SELECTIONS:", 14, 100, 30, 7, A%, 102 PRINTW "TYPE: " + SRTRN1$(R1%), 1, 3 PRINTW "COLOR: " + SRTRN2$(R2%), 2, 3 PRINTW "LOCATION: " + SRTRN3$(R3%), 3, 3 GETANS "Press any key.....", "", "", 21, 100, A% + 128 CLRSCRL: RSTRWIND 14, 1 FOR X% = 20 TO 15 STEP -1 DELWIND X% NEXT 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 (ON)" GOTO SCROLLDEMO CASE 6 ' MARK RTRN$ = "M": OP% = 2: MARK% = 1 OPT$ = "MARK (ON)" GOTO SCROLLDEMO SCROLLDEMO: RSTRWIND 1, 1 IF RTRN$ = CHR$(27) THEN GOTO MAIN.MENU ' ESC A% = 116: GOSUB COL: IF A% = 112 THEN HIATTR% = 127 ELSE HIATTR% = 113 MAKEWIND 2, "@" + OPT$ + " SCROLL WINDOW", 4, 100, 40, 12, A%, 101 RTRN% = 0 SCRLWIND 2, SCROLL$(), 20, RTRN$, RTRN%, HIATTR% IF RTRN% = 0 THEN GOTO DONESCROLL ' ESC A% = 71: GOSUB COL IF MARK% = 1 THEN TR% = 1: NR% = 25: TEXT$ = "@The item(s) marked were:" RSTRWIND 2, 1 ELSE TR% = 16: NR% = 5: TEXT$ = "@The item selected was:" END IF MAKEWIND 3, TEXT$, TR%, 100, 40, NR%, A%, 102 IF MARK% = 1 THEN IF RTRN$ = "" THEN PRINTW "NO ITEMS WERE MARKED!", 10, 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 PRINTW SCROLL$(B%), TR%, 2 ELSE EXIT DO TR% = TR% + 1 LOOP END IF ELSE PRINTW SCROLL$(RTRN%), 1, 100 END IF A% = A% + 128 GETANS "Press any key.....", "", ANS$, 23, 100, A% 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 *****", 4, 8, 64, 8, A%, 102 PRINTW " Get answer windows can be used to ask a question and", 1, 100 PRINTW "wait for a valid single key from a selection of single keys", 2, 100 PRINTW "to be pressed. They can also be used to pause a program and", 3, 100 PRINTW "wait for any key to be pressed, as shown by:", 4, 2 A% = A% + 128 GETANS "Press any key.......", "", ANS$, 11, 30, A% GETANS "Are you sure? (Y/N)", "YN", ANS$, 11, 30, A% LOCATE , , 0 IF ANS$ = CHR$(27) THEN RSTRWIND 1, 1: GOTO MAIN.MENU A% = A% - 128 IF ANS$ = "Y" THEN TEMP$ = "YES" ELSE TEMP$ = "NO" MAKEWIND 2, "*** YOUR REPLY WAS: ***", 12, 28, 25, 3, A%, 2 PRINTW TEMP$, 1, 100 A% = 71: GOSUB COL A% = A% + 128 GETANS "Press any key........", "", ANS$, 15, 28, A% RSTRWIND 2, 1 RSTRWIND 1, 1 '---------------------------- WINDOW MANAGER DEMO --------------------------- CASE 1 'WINDOW MANAGER DEMO A% = 71: GOSUB COL MAKEWIND 20, "@***** Window Demonstration *****", 2, 4, 72, 14, A%, 102 PRINTW " Window memory is user defineable between 4000 bytes and 32000", 1, 2 PRINTW "bytes. All of this memory is outside of BASIC'S normal data storage", 2, 2 PRINTW "area leaving this area for the BASIC program's data. WINDOWS R-E-Z", 3, 2 PRINTW "manages the storage area when a window is made or saved. There is", 4, 2 PRINTW "no need for the programmer to place the saved window area in an", 5, 2 PRINTW "array or string with WINDOWS R-E-Z. A maximum of 20 windows may be", 6, 2 PRINTW "saved. WINDOWS R-E-Z reports any errors ( i.e. WINDOW WONT FIT ) it", 7, 2 PRINTW "encounters minimizing chances for programming mistakes. Windows may", 8, 2 PRINTW "have single lined, double lined, or no border. Window titles may be", 9, 2 PRINTW "on the top border or positioned in a box in the top of the window", 10, 2 A% = A% + 128 GETANS "Press any key.......", "", ANS$, 15, 28, A% RSTRWIND 20, 1 A% = A% - 128 MAKEWIND 20, "@***** Window Demonstration Instructions *****", 2, 5, 71, 6, A%, 2 PRINTW " Press the UP ARROW to generate up to 12 windows at random", 1, 2 PRINTW "locations. The area covered by the window is saved in memory. Press", 2, 2 PRINTW "the DOWN ARROW to remove windows and restore the screen in reverse", 3, 2 PRINTW "order. Press ESC to return to the main menu. ", 4, 2 RANDOMIZE TIMER MAXWIND% = 12 WIND% = 0 GETMAKE: TEMP$ = INKEY$: IF TEMP$ = "" THEN GOTO GETMAKE IF TEMP$ = CHR$(27) THEN FOR X% = 12 TO 1 STEP -1 CALL RSTRWIND(X%, 1) NEXT CALL RSTRWIND(20, 1) GOTO MAIN.MENU END IF TR% = INT((11 * RND) + 8): T% = TR% LC% = INT((59 * RND) + 1): l% = LC% NR% = INT(((27 - TR%) - 3) * RND + 3) WI% = INT(((82 - 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 THEN A% = 135 IF A% > 127 THEN A% = A% - 128 GOSUB COL 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 END SELECT '------------------------- MULTI FIELD INPUT DEMO --------------------------- CASE 2 'MULTI-FIELD INPUT DEMO SELECT CASE WIND% CASE 1 A% = 71: GOSUB COL MAKEWIND 20, "@***** Multi-field Input Demonstration *****", 2, 4, 72, 9, A%, 102 PRINTW " Up to ten multi-field input screens may be defined using up to", 1, 2 PRINTW "100 input fields per screen. Each field may vary in length from", 2, 2 PRINTW "1 to 79 characters. Fields may be designated as alpha/numeric, num-", 3, 2 PRINTW "eric with 0 to 6 decimal places, date, or protected (no entry).", 4, 2 PRINTW "Complete editing features are incorporated.", 5, 2 GETANS "Press any key.......", "", ANS$, 11, 100, A% + 128 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 D% = 105: REDIM RTRN$(D%), RTRN2$(D% - 90) RTRN2$(1) = "RICHARD A MAGNANTI" RTRN2$(2) = "6192 FAWN MEADOW" RTRN2$(3) = "FARMINGTON, NY" RTRN2$(4) = "14425" RTRN2$(5) = "10/31/1988" SCRN% = 1: FLD1% = 1: FLD2% = 1 MAKEINPT: AUTOEXIT% = 0 IF SCRN% = 1 THEN NEWCOLOR A% CLRWIND PRINTW "Decimal(0) Decimal(1) Decimal(2) Decimal(3) Decimal(4)", 2, 4 PRINTW "(---------------- Numeric and padded with leading zeros -------------) ", 4, 4 PRINTW "Alpha/num. Upper case Alpha/num. Lower case Alpha/numeric", 6, 4 PRINTW "*** Auto-advance fields -- Cursor moves to the next field automatically ***", 9, 100 PRINTW "(-- Restricted Input --)", 10, 14 PRINTW "A ( Fields are Decimal(0) ) D", 15, 17 PRINTW "+ +", 16, 17 PRINTW "B E", 17, 17 NEWCOLOR 15 PRINTW "*** PRESS F1 FOR MORE ***", 17, 28 PRINTW "*** AUTO-EXIT EXAMPLES. ***", 18, 28 NEWCOLOR A% PRINTW "=C =F", 19, 16 PRINTW "M or F: Y or N: SOC SECURITY #.. - -", 11, 100 PRINTW "** Auto-exit ( On change only ) and Auto-advance fields. (A,B,D,E) **", 13, 100 PRINTW "** Single field update (protected fields-C,F) allows fast exit and return **", 14, 100 PRINTW "If formatted number won't fit, field and input screen cannot be exited.", 21, 4 MAKE1: MULTINPT 1, FLD1%, EXIT$, AUTOEXIT%, RTRN$() IF AUTOEXIT% <> 0 THEN SELECT CASE AUTOEXIT% CASE 19, 20 AUTOEXIT% = 21 ' ONLY UPDATA THIS FIELD RTRN$(21) = STR$(VAL(RTRN$(19)) + VAL(RTRN$(20))) IF RTRN$(19) = "" AND RTRN$(20) = "" THEN RTRN$(21) = "" CASE 22, 23 AUTOEXIT% = 24 ' ONLY UPDATA THIS FIELD RTRN$(24) = STR$(VAL(RTRN$(22)) + VAL(RTRN$(23))) IF RTRN$(22) = "" AND RTRN$(23) = "" THEN RTRN$(24) = "" END SELECT IF EXIT$ = "AUTO" GOTO MAKE1 END IF IF EXIT$ = "F10" THEN GOSUB HELP: GOTO MAKE1 END IF IF SCRN% = 2 THEN NEWCOLOR A% 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 PRINTW "If date format is incorrect, field and input screen cannot be exited.", 14, 4 PRINTW "NAME..........", 6, 5 PRINTW "ADDRESS.......", 8, 5 PRINTW "CITY / STATE..", 10, 5 PRINTW "DATE...(mm/dd/yyyy).. SOC. SECURITY # ... - -", 12, 5 PRINTW "ZIP...", 10, 53 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$ = "INPUT TODAY'S DATE" CASE 6, 7, 8 I$ = "INPUT YOUR SOC. SEC. NUMBER" CASE ELSE END SELECT PRINTW "*** INSTRUCTIONS: " + I$ + " *** ", 21, 18 MULTINPT 2, FLD2%, EXIT$, AUTOEXIT%, RTRN2$() 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 SCRN% = 1 GOTO MAKEINPT END IF GOTO ALLDONE HELP: MAKEWIND 15, "@***** Multi-field Input Instructions *****", 100, 100, 75, 13, 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 NEWCOLOR 240 PRINTW "[ PRESS ANY KEY TO EXIT HELP ]", 9, 100 WHILE INKEY$ = "": WEND RSTRWIND 15, 1 CALL CHNGWIND(20) RETURN ALLDONE: CALL RSTRWIND(20, 1) VIEW PRINT 1 TO 25 ERASE RTRN$: ERASE RTRN2$ '------------------------------- INPUT WINDOW ------------------------------- CASE 2 'INPUT WINDOW DEMO A% = 32: GOSUB COL MAKEWIND 20, "@***** Input Window Demonstration *****", 3, 4, 72, 10, A%, 102 PRINTW " An input window can be used to prompt for, and receive an input", 1, 2 PRINTW "from the user. Input fields may be windowed, can have a length of", 2, 2 PRINTW "1 to 76 characters, and may be designated as alpha/numeric, date", 3, 2 PRINTW "or numeric with 0 to 6 decimal places. Full editing features are", 4, 2 PRINTW "incorporated. The area under the window is automatically saved.", 5, 2 PRINTW "It is restored upon exiting the procedure.", 6, 2 GETANS "Press any key.......", "", ANS$, 12, 100, A% + 128 RSTRWIND 20, 1 MAKEWIND 20, "@***** Input Window Instructions *****", 2, 100, 72, 12, A%, 102 PRINTW "Key(s): Function:", 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 PRINTW "CTRL E Erases (blanks) field .", 8, 2 START.EDIT: GETANS "Press for upper case - for lower case - for both.", "ULB", P$, 21, 100, A% IF P$ = CHR$(27) THEN GOTO DONEIWIND IF P$ = "B" THEN P$ = "A" MAKEWIND 15, "", 18, 100, 48, 3, A%, 1 PRINTW "Input prompts can printed be in a window....", 1, 100 INPTWIND "Input Your Name:", "W" + P$, 16, 100, 30, A% + 1128, "", RTR$ PRINTW " ...or printed on top of a window.... ", 1, 100 MAKEWIND 19, "@ *** Date Instructions ***", 22, 100, 66, 3, A%, 2 PRINTW "Date format must be: mm/dd/yy or mm/dd/yyyy (1980 to 2099)", 1, 2 INPTWIND "@ DATE ", "WD", 16, 100, 10, A% + 1128, "", RTR2$ RSTRWIND 19, 1 RSTRWIND 15, 1 IF DEC$ = "" THEN GETANS "Number of decimal places to return for next Input Window ( 0-6 ) ?", "0123456", ANS$, 22, 100, A% + 128 DEC$ = ANS$ IF ANS$ = CHR$(27) THEN GOTO DONEIWIND END IF MAKEWIND 15, "", 17, 100, 48, 3, A%, 1 PRINTW " ......or printed without a window!!! ", 1, 100 MAKEWIND 19, "@ *** Numeric Input Instructions ***", 21, 100, 64, 4, A%, 2 PRINTW "Enter any number. If the number with " + DEC$ + " decimals places will", 1, 2 PRINTW "not fit in the field the input routine can not be exited.", 2, 2 INPTWIND "Now Input a Number:", DEC$, 15, 100, 15, A% + 1000, "", RTR1$ RSTRWIND 15, 1 RSTRWIND 19, 1 MAKEWIND 2, "@**** The Data Entered Was:****", 17, 100, 41, 5, A%, 2 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$, 22, 100, A% + 128 RSTRWIND 2, 1 IF ANS$ = "E" THEN GOTO START.EDIT DONEIWIND: RSTRWIND 15, 1 RSTRWIND 20, 1 RTR$ = "": RTR1$ = "": DEC$ = "": RTR2$ = "" END SELECT '----------------------------- WINDOW PRINT DEMO ---------------------------- CASE 3 'PRINT IN A WINDOW A% = 48: GOSUB COL SELECT CASE WIND% CASE 1 MAKEWIND 1, "@*** Window Printing Demonstration ***", 3, 100, 58, 20, A%, 102 PRINTW "Printing in a window is easy with WINDOWS R-E-Z. Text ", 1, 2 PRINTW "can printed at any location in the window or centered:", 2, 2 PRINTW "CENTERED TEXT", 4, 100 PRINTW "Changing the text's color is easy also!", 6, 100 FOR X% = 2 TO 4 Y% = X% - 1: Z% = 128: IF DEMOATTR% = 112 THEN Y% = 0 IF Y% = 3 THEN Y% = 15 NEWCOLOR A% + Y%: PRINTW "COLORED TEXT", 6 + X%, 15 NEWCOLOR A% + Y% + Z%: PRINTW "COLORED TEXT", 6 + X%, 30 NEXT NEWCOLOR A% PRINTW "Single or double lines can be printed....", 11, 100 LINEW 12, 1 LINEW 13, 2 PRINTW "The text in all windows in this demonstration", 14, 100 PRINTW "was printed using the print routine supplied", 15, 100 PRINTW "with WINDOWS R-E-Z.", 16, 6 GETANS "Press any key .......", "", ANS$, 23, 100, A% + 128 RSTRWIND 1, 1 CASE 2 MAKEWIND 1, "@Window #1", 8, 6, 30, 15, A%, 102 PRINTW "(*** SAMPLE ****)", 11, 100 B% = 71: IF A% = 112 THEN B% = 7 MAKEWIND 2, "@Window #2", 8, 45, 30, 15, B%, 102 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 "A window's interior can be", 2, 2 PRINTW "cleared with any color....", 3, 2 GA$ = "to clear Window #1 with a new color." GOSUB Press B% = 95: IF A% = 112 THEN B% = 7 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% = 112 THEN B% = 112 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 4 B$ = "is set to SLOW" A% = 120: GOSUB COL CALL CHNGPULL(3, 4, A%) CALL CHNGPULL(3, 5, 0) CHNGFAST GOTO PRINTSPEED CASE 5 B$ = "is set to FAST" A% = 120: GOSUB COL CALL CHNGPULL(3, 5, A%) CALL CHNGPULL(3, 4, 0) CHNGFAST PRINTSPEED: A% = 113: GOSUB COL MAKEWIND 1, "@***** Print " + B$ + " *****", 100, 100, 67, 6, A%, 102 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% RSTRWIND 1, 1 END SELECT '--------------------------- DIRECTORY ROUTINES ----------------------------- CASE 4 A% = 23 GOSUB COL MAKEWIND 10, "@**** Directory Demonstration ****", 100, 100, 44, 16, A%, 101 PRINTW " Directory routines permit files from", 1, 100 PRINTW "any path to be placed in an array. All", 2, 100 PRINTW "files may be found or selected files can", 3, 100 PRINTW "can be found. Wildcards (*?) are permit-", 4, 100 PRINTW "ed. Searches can include files with any", 5, 100 PRINTW "combination of attributes ( hidden, read", 6, 100 PRINTW "only, system, or ordinary files ). Sub-", 7, 100 PRINTW "directory listings may also be found. To", 8, 100 PRINTW "suppliment functions included in QUICK-", 9, 100 PRINTW "BASIC routines to find disk size, free", 10, 100 PRINTW "disk space, the default drive and path", 11, 100 PRINTW "are included.", 12, 2 A% = A% + 128 GETANS "Press any key.....", "", "", 22, 100, A% A% = A% - 128 RSTRWIND 10, 1 DISKINST: MAKEWIND 10, "@**** Instructions ****", 100, 100, 45, 14, A%, 101 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 "H - hidden", 5, 15 PRINTW "R - read only", 6, 15 PRINTW "S - system", 7, 15 PRINTW "O - ordinary", 8, 15 PRINTW "D- sub-directory", 9, 15 PATH2$ = PATH$ GETPATH: INPTWIND "!@PATH: FORMAT = DRIVE:\DIRECTORY\....( WILDCARDS PERMITTED )", "WU", 22, 100, 63, A%, "1234567890QWERTYUIOPLKJHGFDSAZXCVBNM\:?*_.", PATH2$ IF PATH2$ <> "" THEN PATH$ = PATH2$ ELSE DOSOUND RSTRWIND 10, 1 GOTO OVER END IF GETTYPE: TYPE$ = "" INPTWIND "FILE ATTRIBUTES (H/R/S/O/D):", "WU", 22, 100, 5, A%, "HRSOD", TYPE$ 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$, DIREC$, TYPE$, F% 'PUT DIRECTORY IN DIREC$. REDIM DIREC$(F%) 'MAKE ARRAY, DIREC$(), WITH F% ELEMENTS. FILLDIR DIREC$, DIREC$() 'FILL ARRAY WITH INFO IN STRING, DIREC$. DISKSIZE DR%, SIZE&, FREE& 'GET DISK ROOM AND FREE ROOM. RSTRWIND 10, 1 MAKEWIND 10, "@PATH: " + PATH$, 100, 100, 74, 17, A%, 101 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% 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.", 1, 100 RTRN$ = "A" MAKEWIND 11, "", 100, 100, 16, 8, 15, 1 HIATTR% = 0 SCRLWIND 11, DIREC$(), F%, RTRN$, RTRN%, HIATTR% 'PUT DIREC$() IN WINDOW #1 END IF RTRN$ = DIREC$(RTRN%) ERASE DIREC$: DIREC$ = "" 'GET MEMORY BACK IF RTRN% = 0 THEN RSTRWIND 11, 1: RSTRWIND 10, 1: GOTO OVER A% = A% + 128 GETANS RTRN$ + " WAS SELECTED. REPEAT DIRECTORY SEARCH... (Y/N)?", "YN", ANS$, 21, 100, A% A% = A% - 128 RSTRWIND 11, 1 RSTRWIND 10, 1 IF ANS$ <> "Y" 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% A% = A% - 128 IF PREFLAG% = 1 THEN RESUME REALSTART RSTRWIND 10, 1 RESUME DISKINST OVER: ON ERROR GOTO 0 '----------------- ESC KEY PRESSED BACK-UP TO INTRO SCREEN ------------------ CASE 0 GOTO INTRO '--------------------- ALL DONE, BYE, GOOD NIGHT IRENE ---------------------- CASE 6 END 'EXIT PROGRAM" '------------------------ SOUND = CLICK OR BEEP OR OFF -------------------- CASE 5 SELECT CASE WIND% CASE 1 ' TOGGLE SOUND B$ = "BEEP": B% = 2 GOTO DOSOUND CASE 2 B$ = "CLICK": B% = 1 GOTO DOSOUND CASE 3 B$ = "OFF": B% = 0 GOTO DOSOUND END SELECT DOSOUND: A% = 120: GOSUB COL CALL CHNGPULL(5, 1, 0) CALL CHNGPULL(5, 2, 0) CALL CHNGPULL(5, 3, 0) CALL CHNGPULL(5, WIND%, A%) A% = 23 GOSUB COL SETSOUND B% GETANS "The sound for all routines is set to " + B$ + ". Press any key.....", "", "", 100, 100, A% '----------------------------- NO CASE ELSE --------------------------------- CASE ELSE END SELECT GOTO MAIN.MENU '------ SUB FOR COLOR OR MONO DISPLAY \ SUB FOR PRESS ANY KEY --------------- COL: IF DEMOATTR% = 112 THEN A% = 112 RETURN Press: CALL GETANS("Press any key " + GA$, "", ANS$, 22, 100, A% + 128) RETURN