home *** CD-ROM | disk | FTP | other *** search
/ CD Actual 14 / CDACTUAL.iso / cdactual / demobin / share / program / Basic / VWEZ60.ZIP / DEMO.BAS < prev    next >
Encoding:
BASIC Source File  |  1992-11-11  |  68.5 KB  |  1,794 lines
  1. '!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
  2. '!!!!!!!!!!!! ** [ READ THIS ] ** !!!!!!!!  ** [ READ THIS ] !!!!!!!!!!!!!!!
  3. '!       BASIC MODULE, DEMPART2.BAS MUST BE LOADED WITH THIS MODULE        !
  4. '***************************************************************************
  5. '**** THIS PROGRAM MUST BE USED WITH ONE OF THE FOLLOWING LIBRARIES:    ****
  6. '***************************************************************************
  7. '**** For QB4.5 unenhanced version use QBUNEN.QLB                     ****
  8. '**** For BASIC 7.1 unenhanced version use PDSUNEN.QLB                  ****
  9. '**** For VBDOS 1.0 unenhanced version use VBUNEN.QLB                   ****
  10. '**** For QB4.50 enhanced version use QBALL45.QLB or QBNER45.QLB        ****
  11. '**** For BASIC 7.1 enhanced version use PDSALL71.QLB or PDSNER71.QLB   ****
  12. '**** For VBDOS 1.0 enhanced version use VBALL.QLB or VBNER.QLB         ****
  13. '**** Load QB, QBX, or VBDOS with the /L option and the correct library ****
  14. '***************************************************************************
  15. '----------------------------------------------------------------------------
  16. '---------------------- Windows R-E-Z Demonstration -------------------------
  17. '---------------------- CONNECT Software ------------------------------------
  18. '---------------------- Nov. 01, 1992 ---------------------------------------
  19. '----------------------------------------------------------------------------
  20. '---------------------- Copyright 1988,1989,1990,1991,1992 ------------------
  21. '---------------------- By: CONNECT Software --------------------------------
  22. '---------------------- All rights reserved ---------------------------------
  23. '----------------------------------------------------------------------------
  24. '            **** VER 6.00 ------- LAST UPDATE ------- 11/01/1992 ****
  25. '****************************************************************************
  26. DECLARE SUB B4INPT (INPTEXIT$, RESTRICT$)
  27. DECLARE SUB B4SCRL (EXIT$, MARK$, TAGCOL%, NOREFRESH%)
  28. DECLARE SUB BOXW (TR%, LC%, WD%, NR%, BORDER%)
  29. DECLARE FUNCTION CHOICEBAR% (CHOICE$(), TR%, LC%, WD%, ATTR%, HATTR%, EXIT$)
  30. DECLARE FUNCTION CHOICEWIND% (TITLE$, TX$(), CH$(), TR%, LC%, ATTR%, HCOL%, ESCEXIT%, BORDER%)
  31. DECLARE SUB CHNGPULL (BAR%, WIND%, ATTR%)
  32. DECLARE SUB CHNGWIND (W%)
  33. DECLARE SUB CLEARKB ()
  34. DECLARE SUB CLRWIND ()
  35. DECLARE SUB CUROFF ()
  36. DECLARE SUB DELWIND (W%)
  37. DECLARE SUB DISKSIZE (DISK%, DISKSZE&, FREESPACE&)
  38. DECLARE SUB DOSOUND ()
  39. DECLARE FUNCTION FINDPATH$ ()
  40. DECLARE SUB FINDDIR (PATH$, TYPE$, F%)
  41. DECLARE SUB GETANS (TEXT$, CHOICE$, ANS$, TR%, LC%, WATTR%, FATTR%, BORDER%)
  42. DECLARE FUNCTION GETCUR& ()
  43. DECLARE FUNCTION GETDISK% ()
  44. DECLARE SUB INFOFIXED (FIXED$)
  45. DECLARE SUB INFOLINE (TR%, LC%, WD%, ATTR%)
  46. DECLARE SUB INPTINIT (DTYPE%, ISDOT%, STARTAT1%, NOBLANK%, SND%)
  47. DECLARE SUB INPTWIND (PROMPT$, CODE$, TR%, LC%, WD%, WATTR%, FATTR%, RTRN$, RK%, BUT%, BRD%)
  48. DECLARE FUNCTION GETAKEY% ()
  49. DECLARE FUNCTION LBUTTON% ()
  50. DECLARE SUB LINEW (ROW%, TYP%)
  51. DECLARE SUB MAKEFIELD (SCRN%, FLD%, SCODE%, STR%, SLC%, SWD%, SBASEATTR%, SACTATTR%, MATTR%, RES$, EXTO$, HOT%, CURPOS%, BRACKET%)
  52. DECLARE SUB MAKEWIND (W%, LABEL$, TR%, LC%, WD%, NR%, ATTR%, BORDER%)
  53. DECLARE FUNCTION MARKED% (RTRN$, START%)
  54. DECLARE FUNCTION MOUSECOL% ()
  55. DECLARE SUB MOUSEINIT ()
  56. DECLARE FUNCTION MOUSEINMULT% (MULTSCRN%)
  57. DECLARE FUNCTION MOUSEINWIND% (WIND%)
  58. DECLARE SUB MOUSELIMITS (TROW%, BROW%, LCOL%, RCOL%)
  59. DECLARE FUNCTION MOUSEON% (ONFLAF%)
  60. DECLARE SUB MOUSEPOS (ROW%, COL%)
  61. DECLARE FUNCTION MOUSEROW% ()
  62. DECLARE SUB MOUSESHOW ()
  63. DECLARE SUB MULTINPT (SCRN%, TOFLD%, OPT$, FROMFLD%, RKEY%, RTRN$(), SELFLD%)
  64. DECLARE SUB NEWCOLOR (ATTR%)
  65. DECLARE FUNCTION PEEKASM& (S&, O&, BYVAL N%)
  66. DECLARE SUB PRINTINFO (I$)
  67. DECLARE SUB PRINTW (TEXT$, TR%, LC%)
  68. DECLARE SUB PRINTWHOT (TEXT$, TR%, LC%, HOTCHAR%, ATTR%)
  69. DECLARE SUB PULLDOWN (INFO$(), A%, B%, EXIT$, RKEY%, ATTR%, HATTR%, BORDER%)
  70. DECLARE FUNCTION RBUTTON% ()
  71. DECLARE SUB RESAVE ()
  72. DECLARE SUB RSTRINFO (DELFLAG%)
  73. DECLARE SUB RSTRINPT (DELFLAG%)
  74. DECLARE SUB RSTRPULL (RSTRMBAR%)
  75. DECLARE SUB RSTRWIND (W%, DELFLAG%)
  76. DECLARE SUB SAVEWIND (W%, TR%, LC%, WD%, NR%)
  77. DECLARE SUB SCRLWIND (LIST$(), INFO$(), TOPLINE$, ENTRIES%, RTRN$, RTRN%, LI%, FC%, RKEY%, HIATTR%, SCROLLBAR%, BUT%)
  78. DECLARE SUB SETCUR (C&)
  79. DECLARE SUB SETDISK (DRIVE%, BADFLAG%)
  80. DECLARE SUB SETINPT (SCRN%, DISPLAYLEN%, EXIT$, HOTCOL%)
  81. DECLARE SUB SETPULL (TR%, LC%, WD%, PWIND$())
  82. DECLARE SUB SETWIND (FAST%, SND%, SHADCOL%, NOHIGH%, BRACKETATTR%)
  83. DECLARE SUB UPDATEFIELD (SCRN%, FLD%, TEXT$)
  84. DECLARE FUNCTION WAVAIL% (W%)
  85. DECLARE SUB WINDSTATUS ()
  86. '***************************************************************************
  87. DECLARE SUB SOUNDDEMO (WIND%)
  88. DECLARE SUB COLORDEMO (WIND%)
  89. DECLARE SUB PRINTDEMO ()
  90. DECLARE SUB INPUTWINDOWDEMO ()
  91. DECLARE SUB MULTINPUTDEMO2 ()
  92. DECLARE SUB MULTINPUTDEMO1 ()
  93. DECLARE SUB SETDATEDEMO ()
  94. DECLARE SUB SCROLLDEMO (W%)
  95. DECLARE SUB WINDOWDEMO ()
  96. DECLARE SUB GETANSDEMO ()
  97. DECLARE FUNCTION COL% (C%)
  98. DECLARE FUNCTION RELEASED% (SCRN%, TOFLD%)
  99. DECLARE FUNCTION NEWSEL% (MAXSEL%, SEL%, RK%, MSEL%, R$)
  100. DECLARE SUB CONTROLBOX ()
  101. DECLARE SUB GETFILE (P$, F$, RKEY%)
  102.  
  103.  
  104. DIM SHARED DEMOATTR%, DFORMAT%, COLCHOICE%, LOCHOICE%
  105. DIM SHARED SHADCOL%, DEMOFAST%, DEMOSOUND%, DEMONOHI%
  106. '--------------------------- DIMENSION ARRAYS -------------------------------
  107.  
  108. DIM SHARED DUMMY$(0 TO 0)                      ' NEEDED BY SCRLWIND ROUTINE
  109.  
  110. DIM SHARED MRTRN$(19)                          ' FOR MULTI-FIELD INPUT DEMO
  111. DIM SHARED COLCHOICE$(4), LOCHOICE$(4)         ' "                       "
  112.  
  113. MRTRN$(18) = "< F1=Exit >"
  114. MRTRN$(19) = "< F10=Help >"
  115. MRTRN$(5) = "RED"                              ' # 1 MULTI-FIELD INPUT SCREEN
  116. MRTRN$(6) = "NORTH"                            '  "
  117. COLCHOICE$(1) = "RED"                          '  "
  118. COLCHOICE$(2) = "PURPLE"                       '  "
  119. COLCHOICE$(3) = "YELLOW"                       '  "
  120. COLCHOICE$(4) = "GREEN"                        '  "
  121. LOCHOICE$(1) = "NORTH"                         '  "
  122. LOCHOICE$(2) = "SOUTH"                         '  "
  123. LOCHOICE$(3) = "EAST"                          '  "
  124. LOCHOICE$(4) = "WEST"                          '  "
  125. COLCHOICE% = 1: LOCHOICE% = 1                  '  "
  126.  
  127. DIM LAN$(3), DISK$(4), ORDER$(19)              ' FOR ORDER FORM
  128.  
  129. LAN$(1) = "QuickBASIC 4.5"                     '  "
  130. LAN$(2) = "BASIC 7.1 - PDS"                    '  "
  131. LAN$(3) = "VBDOS 1.0"
  132. LAN% = 1: ORDER$(9) = LAN$(1)                  '  "
  133.  
  134. DISK$(1) = "5.25 inch - 1.2M"                  '  "
  135. DISK$(2) = "5.25 inch - 360K"                  '  "
  136. DISK$(3) = "3.5 inch - 1.4M"                   '  "
  137. DISK$(4) = "3.5 inch - 720K"                   '  "
  138. DSIZE% = 1: ORDER$(10) = DISK$(1)              '  "
  139. ORDER$(14) = "< F1=Exit >": ORDER$(15) = "< F10=Print >"
  140.  
  141. '------ ARRAY REPRESENTING ALLOWABLE DATE FORMATS FOR INPUT ROUTINES --------
  142.  
  143. DIM SHARED DATETYPE$(5)
  144. DATETYPE$(1) = "mm-dd-yyyy"
  145. DATETYPE$(2) = "mm/dd/yyyy"
  146. DATETYPE$(3) = "dd-mm-yyyy"
  147. DATETYPE$(4) = "dd/mm/yyyy"
  148. DATETYPE$(5) = "dd.mm.yyyy"
  149. CLS
  150. CALL CUROFF
  151.  
  152. 'ON KEY(6) GOSUB TEST                ' USE TO TEST TRAPPING
  153. 'KEY(6) ON
  154. '----------------------------------------------------------------------------
  155. REALSTART:
  156. SETWIND 1, 1, 1, 0, 0
  157.  
  158. A% = 15
  159. ON ERROR GOTO DISKERROR
  160.    PATH$ = FINDPATH$                   ' FIND PRESENT DISK AND  PATH
  161. ON ERROR GOTO 0
  162.  
  163. '--------------------- SET DATA FOR SCROLL WINDOW DEMO ----------------------
  164. DIM SHARED SCROLL$(14)            ' READ DATA FOR SCROLL WINDOW DEMO
  165.  
  166. FOR X% = 1 TO 14                   '              "
  167.    READ SCROLL$(X%)                '              "
  168. NEXT
  169.  
  170. 'DATA FOR SCROLL WINDOW DEMO
  171. DATA This is a sample of a scroll window.
  172. DATA The A@RROW keys or different colored
  173. DATA letter can be pressed to make a sel-
  174. DATA ection.  REGULAR scroll windows exit
  175. DATA when ENTER is pressed.  AUTO-EXIT
  176. DATA scroll windows exit if the letter
  177. DATA pressed is found.  END / HOME / PGUP
  178. DATA and PGDN keys respond as ex@pected.
  179. DATA MARK scroll windows mark or unmark
  180. DATA items in the window with the "+"
  181. DATA or "-" keys.  The PRINT k@ey or the
  182. DATA SPACE B@AR  marks or unmarks all
  183. DATA items.  Press ECS to return to the
  184. DATA pulldown@ menu.
  185.  
  186. '-------------- SET DATA FOR VIRTUAL SCROLL WINDOW DEMO ---------------------
  187.  
  188. DIM SHARED ADDRESS$(1 TO 10)
  189. FOR X% = 1 TO 10                ' READ DATA FOR VIRTUAL SCROLL WINDOW DEMO
  190.    READ ADDRESS$(X%)
  191. NEXT
  192.  
  193. 'DATA FOR VIRTUAL SCROLL WINDOW DEMO
  194. DATA CONNECT Software        6192 Fawn Meadow      Farmington    NY    14425
  195. DATA Dell Computer Corp      9505 Arboretum Blvd   Austin        TX    78759
  196. DATA Micro Warehouse         1690 Oak St           Lakewood      NJ    08701
  197. DATA ZEOS                    530  Fifth Ave  NW    St Paul       MN    55112
  198. DATA Microsoft Press         21919 20th Ave SE     Bothell       WA    95041
  199. DATA Central Point Software  Greenbrier Pkwy       Oregon        OR    97006
  200. DATA Eastman Kodak Corp      343 State St          Rochester     NY    14650
  201. DATA National Instruments    6504 Bridge Pt Pkwy   Austin        TX    73730
  202. DATA Gateway Computers       610 Gateway Dr        N Souix City  SD    57049
  203. DATA Microsoft Corporation   One Microsoft Way     Redmond       VA    98052
  204.  
  205. '-------------------- SET DATA FOR PULLDOWN WINDOWS -----------------------
  206.  
  207. B% = 200: TEMP% = 0
  208. REDIM PWIND$(B%)                                   ' READ DATA FOR
  209.                                                    ' PULLDOWN MENUBAR AND
  210. WHILE PWIND$(TEMP%) <> "ENDPULL"                   ' PULLDOWN WINDOWS.
  211.   TEMP% = TEMP% + 1
  212.   READ PWIND$(TEMP%)
  213. WEND
  214.  
  215. 'PULLDOWN WINDOW #1
  216. DATA "Windows  ", Scroll - Get Answer and more         : 'MENUBAR & INFOLINE
  217.  
  218. ' ** NOTE: IF INFO-LINE IS NOT USED THIS WOULD BE THE FIRST DATA LINE:
  219. ' DATA Windows,
  220.  
  221. DATA Window Management System   (F1)              : 'WINDOW #1 SELECTIONS
  222. DATA Get answer windows         (F2)
  223. DATA Scroll windows                
  224. DATA -, Ex@it, ***
  225.  
  226. 'PULLDOWN WINDOW #2
  227. DATA "Set-up  ", "Set global parameters for WINDOW, INPUT, and SCROLL routines.
  228. DATA Control panel,***
  229.  
  230. 'PULLDOWN WINDOW #3
  231. DATA "Input  ", Single and Multi-field Input           : 'MENUBAR & INFOLINE
  232. DATA Multi-field input, Look familiar?                 : 'WINDOW'S ITEMS
  233. DATA Input windows, ***
  234.  
  235. 'PULLDOWN WINDOW #4
  236. DATA "Directory  ",Several Features                    : 'MENUBAR & INFOLINE
  237. DATA Directory routines,***                            : 'WINDOW'S ITEMS
  238.  
  239. DATA "Color  ", "Set for color, monochrome, or LCD displays"
  240. DATA  Black and white, Color, No hi-intensity (B/W),***
  241.  
  242. 'PULLDOWN WINDOW #6
  243. DATA "Order Me",*** Important!!! ***                   : 'MENUBAR & INFOLINE
  244. DATA  Order form ,***                                  : 'WINDOW'S ITEMS
  245.  
  246. DATA ENDPULL                                           : 'END OF PULLDOWN DATA
  247.  
  248. SETPULL 2, 8, 60, PWIND$()            ' SET UP PULLDOWN WINDOWS
  249.  
  250. ERASE PWIND$                          ' ERASE TEMPORARY ARRAY HOLD-
  251.                                       ' ING PULLDOWN WINDOW DATA.
  252.  
  253. '------------- SET DATA FOR INFO-LINE FOR PULLDOWN WINDOWS ------------------
  254. ' ** NOTE: THIS IS NOT REQUIRED IF INFO-LINE IS NOT USED
  255.  
  256. DIM SHARED PULLINFO$(14)                   ' INFO-LINE DATA
  257. FOR X% = 1 TO 14                           ' READ DATA FOR EACH PULLDOWN
  258.    READ PULLINFO$(X%)                      ' WINDOW'S INFO-LINE
  259. NEXT
  260.  
  261. 'INFO-LINE DATA FOR PULLDOWN WINDOW #1
  262. DATA "Make, save and restore windows.", Get a single key user response.
  263. DATA  Several types of scroll windows.,,End demonstration.
  264.  
  265. 'INFO-LINE DATA FOR PULLDOWN WINDOW #2
  266. DATA  Set user preferences..
  267.  
  268. 'INFO-LINE DATA FOR PULLDOWN WINDOW #3
  269. DATA Sample multi-field input screens.
  270. DATA Multi-field versatility., Variations of single field input windows.
  271.  
  272. 'INFO-LINE DATA FOR PULLDOWN WINDOW #4
  273. DATA Several useful directory routines.
  274.  
  275. 'INFO-LINE DATA FOR PULLDOWN WINDOW #5
  276. DATA Set for monochrome displays.,Set for color displays.
  277. DATA Set for displays (LCD) without hi-intensity.
  278.  
  279. 'INFO-LINE DATA FOR PULLDOWN WINDOW #6
  280. DATA Make an order form for WINDOWS R-E-Z.....
  281.  
  282. DIM SHARED SUBSCROLL$(5)
  283. SUBSCROLL$(1) = "Regular Scroll window"
  284. SUBSCROLL$(2) = "Auto-exit Scroll window"
  285. SUBSCROLL$(3) = "Mark Scroll window"
  286. SUBSCROLL$(4) = "Virtual Scroll window"
  287. SUBSCROLL$(5) = "List virtual scroll window"
  288.  
  289.  
  290. CALL INPTINIT(1, 1, 0, 1, 1)
  291.  
  292. '------------------------ SET UP FIRST INPUT SCREEN -------------------------
  293.  
  294. CALL SETINPT(1, 25, "012", 0)
  295.  
  296. FOR FLD% = 1 TO 19                        ' READ THE DATA FOR THE MULT-FIELD
  297.    READ CODE%, TR%, LC%, WD%, BASECOL%, ACTCOL%, MCOL%, RESTRICT$
  298.    CALL MAKEFIELD(1, FLD%, CODE%, TR%, LC%, WD%, BASECOL%, ACTCOL%, MCOL%, RESTRICT$, "", 0, 0, 0)
  299. NEXT
  300.  
  301. ' DATA FOR EACH FIELD   ---- ALL FIELDS ARE AUTO-EXIT
  302.  
  303. DATA 10000,6,5,10,15,15,15,""        : ' 0 decimal places
  304. DATA 10040,8,5,10,15,15,15,""        : ' "              " padded with 0's
  305. DATA 10001,6,20,10,15,15,15,""       : ' 1 decimal place
  306. DATA 10002,6,35,10,15,15,15,""       : ' 2 decimal places
  307.  
  308. DATA 30007,6,58,12,15,15,15,""       : ' fixed choice ( red blue .... )
  309. DATA 30007,8,58,12,15,15,15,""       : ' fixed choice ( north south ... )
  310.  
  311. DATA 10017,11,5,20,15,15,15,""       : ' upper case alpha/numeric
  312. DATA 10027,11,31,20,15,15,15,""      : ' lower case alpha/numeric
  313. DATA 10007,11,55,20,15,15,15,""      : ' alpha/numeric
  314.  
  315. DATA 11017,16,22,1,15,15,15,"MF"     : ' upper case restricted to M or F
  316. DATA 11017,16,38,1,15,15,15,"YN"     : ' upper case restricted to Y or N
  317.  
  318. DATA 11000,16,60,3,15,15,15,""       : ' first 3 digits of SS number
  319. DATA 11000,16,64,2,15,15,15,""       : ' next 2 digits of SS number
  320. DATA 11000,16,67,4,15,15,15,""       : ' Last 3 digits of SS number
  321.  
  322. DATA 11000,21,23,6,15,15,15,""       : ' A field of A+B=C - 0 digits decimal
  323. DATA 11000,21,38,6,15,15,15,""       : ' B field of A+B=C - 0 digits decimal
  324. DATA 100,21,53,7,15,15,15,""         : ' C field of A+B=C - ( protected )
  325.  
  326. DATA 30107,24,15,11,112,112,15,""    : ' F1=EXIT ( mouse selectable )
  327. DATA 30107,24,55,12,112,112,15,""    : ' F10=HELP ( mouse selectable )
  328.  
  329. '--------------------------- SET UP CONTROL BOX  ----------------------------
  330.  
  331. CALL SETINPT(5, 25, "EO", 127)
  332.  
  333. FOR FLD% = 1 TO 18                            ' READ THE DATA FOR THE MULT-FIELD
  334.    READ CODE%, TR%, LC%, WD%, BASECOL%, ACTCOL%, MCOL%, CURPOS%
  335.    CALL MAKEFIELD(5, FLD%, CODE%, TR%, LC%, WD%, BASECOL%, ACTCOL%, MCOL%, "", "", 0, CURPOS%, 1)
  336. NEXT
  337.  
  338. ' DATA FOR EACH FIELD
  339.     'CODE%,TR%,LC%,WD%,BASECOL%,ACTCOL%,MCOL%,CURPOS%
  340.  
  341. ' ALL FIELDS ARE AUTO-EXIT
  342.  
  343. DATA 30000, 6,4,3,112,112,112,2           : ' Click
  344. DATA 30000, 7,4,3,112,112,112,2           : ' Beep
  345. DATA 30000, 8,4,3,112,112,112,2           : ' No sound
  346.  
  347. DATA 30000, 12,4,5,112,112,112,2          : ' Slow print
  348.  
  349. DATA 30000, 6,28,3,112,112,112,2          : ' Start of text
  350. DATA 30000, 7,28,3,112,112,112,2          : ' End of text
  351.  
  352. DATA 30000, 11,28,3,112,112,112,2         : ' Erase and print
  353. DATA 30000, 12,28,3,112,112,112,2         : ' Prints
  354.  
  355. DATA 30000, 16,28,3,112,112,112,2         : ' Make default sound
  356. DATA 30000, 17,28,3,112,112,112,2         : ' No sound
  357.  
  358. DATA 30000, 21,28,3,112,112,112,2         : ' As a period
  359. DATA 30000, 22,28,3,112,112,112,2         : ' As a comma
  360.  
  361. DATA 10007,7,65,10,15,15,15,0             : ' Text
  362. DATA 10030,10,65,10,15,15,15,0            : ' Number
  363. DATA 10008,13,65,10,15,15,15,0            : ' Date
  364. DATA 30007,15,65,9,112,112,7,3            : ' < SOUND >
  365.  
  366. DATA 30007,18,65,10,112,7,7,5           : ' < Ok >
  367. DATA 30007,21,65,10,112,7,7,3           : ' < Cancel >
  368.  
  369. '--------------------- SET UP "FIND - CHANGE TO INPUT SCREEN-----------------
  370.  
  371. CALL SETINPT(3, 25, "E", 127)
  372.  
  373. FOR FLD% = 1 TO 11                      ' READ THE DATA FOR THE MULT-FIELD
  374.    READ CODE%, TR%, LC%, WD%, BASECOL%
  375.    READ ACTCOL%, MCOL%, RESTRICT$, EXITTO$, HOT%, CURPOS%, BRACKET%
  376.    CALL MAKEFIELD(3, FLD%, CODE%, TR%, LC%, WD%, BASECOL%, ACTCOL%, MCOL%, RESTRICT$, EXITTO$, HOT%, CURPOS%, BRACKET%)
  377. NEXT
  378.  
  379. ' DATA FOR EACH FIELD -- ALL FIELDS ARE AUTO-EXIT
  380.  
  381. DATA 10007,8,26,41,112,112,112,"","F",0,0,0   : 'Field 1 = Find What:
  382. DATA 10007,11,26,41,112,112,112,"","T",0,0,0  : 'Field 2 = Change To:
  383.  
  384. DATA 30007,14,13,25,112,112,112,"","M",5,2,0  : 'Field 3 = Match Upper/Lowercase
  385. DATA 30007,15,13,25,112,112,112,"","W",5,2,0  : 'Field 4 = Whole Word
  386.  
  387. DATA 30007,14,45,21,112,112,112,"","1",5,2,0  : 'Field 5 = Active Window
  388. DATA 30007,15,45,21,112,112,112,"","2",5,2,0  : 'Field 6 = Current Module
  389. DATA 30007,16,45,21,112,112,112,"","3",5,2,0  : 'Field 7 = All Modules
  390.  
  391. DATA 30007,19,13,19,112,112,7,"","V",12,3,1   : 'Field 8 = Find and Verify
  392. DATA 30007,19,33,14,112,112,7,"","C",3,3,1    : 'Field 8 = Change All
  393. DATA 30007,19,48,10,112,112,7,"","",0,3,1     : 'Field 10 = Cancel
  394. DATA 30007,19,59,8,112,112,7,"","H",3,3,1     : 'Field 11 = Help
  395.  
  396. '--------- READ DATA FOR THE ORDER FORM INPUT SCREEN AND SET UP SAME -------
  397.  
  398. CALL SETINPT(4, 25, "10", 0)
  399.  
  400. FOR FLD% = 1 TO 15                  ' READ THE DATA FOR THE MULT-FIELD
  401.    READ CODE%, TR%, LC%, WD%, BASECOL%, ACTCOL%, MCOL%, RESTRICT$
  402.    CALL MAKEFIELD(4, FLD%, CODE%, TR%, LC%, WD%, BASECOL%, ACTCOL%, MCOL%, RESTRICT$, EXTO$, 0, 0, 0)
  403. NEXT
  404.                    '***** FIELD DATA FOR ORDER FORM  ******
  405.  
  406. DATA 10007,5,14,32,15,15,15,""              : ' name - upper case
  407. DATA 10007,7,14,32,15,15,15,""              : ' address - upper case
  408. DATA 10007,9,14,32,15,15,15,""              : ' address - upper case
  409. DATA 10007,11,14,32,15,15,15,""             : ' city/state - upper case
  410. DATA 10010,13,14,5,15,15,15,""              : ' zip - padded w/0's
  411. DATA 10008,5,56,10,15,15,15,""              : ' date
  412. DATA 10017,7,69,1,15,15,15,"YN"             : ' registered user ( Y or N )
  413. DATA 10000,9,69,5,15,15,15,""               : ' registration number
  414. DATA 30007,15,25,20,15,15,15,""             : ' programming language
  415. DATA 30007,15,58,20,15,15,15,""             : ' disk size
  416. DATA 11017,17,33,1,15,15,15,"YN"            : ' hard copy docs ( Y or N )
  417. DATA 10007,22,24,20,15,15,15,"1234567890 "  : ' Visa/MC card number
  418. DATA 10007,22,63,5,15,15,15,"1234567890/"   : ' expiration date
  419.  
  420. DATA 30107,2,7,11,112,112,15,""             : ' F1=ABORT (mouse selectable)
  421. DATA 30107,2,62,13,112,112,15,""            : ' F10=PRINT (mouse selectable)
  422.  
  423. '------------------------- WINDOW, MOUSE INITIALIZATION --------------------
  424. DEMOATTR% = 112: SHADCOL% = 7: DEMONOHI% = 0
  425. JUNK% = MOUSEON%(1)
  426.  
  427. REDIM TEXT$(6)
  428. TEXT$(1) = ""
  429. TEXT$(2) = "@QuickBASIC 4.5 / BASIC 7+ / Visual Basic for DOS User's Interface"
  430. TEXT$(3) = "@Copyright 1988 - 1992 by:"
  431. TEXT$(4) = "@CONNECT Software"
  432. TEXT$(5) = "@All rights reserved"
  433. TEXT$(6) = ""
  434. REDIM CHOICE$(3)
  435. CHOICE$(1) = "Color": CHOICE$(2) = "Monochrome": CHOICE$(3) = "LCD (B/W)"
  436.  
  437. SELECT CASE CHOICEWIND%("@WINDOWS R-E-Z -- VERSION 6.00", TEXT$(), CHOICE$(), 100, 100, 112, 127, 0, 111)
  438.      CASE 1                   ' COLOR
  439.         CHNGPULL 5, 2, 120
  440.         DEMOATTR% = 0
  441.         SHADCOL% = 8
  442.      CASE 2                   ' MONOCHROME
  443.         CHNGPULL 5, 1, 112
  444.      CASE 3
  445.         CHNGPULL 5, 3, 112     ' NO-HIGH intensity
  446.         DEMONOHI% = 1
  447.    END SELECT
  448. SETWIND 1, 1, SHADCOL%, DEMONOHI%, 15
  449. RSTRWIND 2, 1
  450. CALL CUROFF
  451. DEMOFAST% = 1
  452. DEMOSOUND% = 1
  453. DATETYPE$ = "mm-dd-yyyy"       ' REPRESENTS DATE FORMAT #1
  454. DFORMAT% = 1                   ' DATE FORMAT #1 = mm-dd-yyyy
  455.  
  456. '----------------------------- INTRODUCTION SCREEN --------------------------
  457.  
  458. PREINTRO:
  459.    IF SHADCOL% = 7 THEN A% = 112 ELSE A% = 116
  460.  
  461.    MAKEWIND 0, "@WINDOWS R-E-Z Version 6.00  --- 11/01/1992", 1, 1, 80, 25, A%, 102
  462.  
  463.    FOR XX% = 1 TO 21 STEP 2
  464.       PRINTW "WINDOWS R-E-Z ────── WINDOWS R-E-Z ────── WINDOWS R-E-Z ────── WINDOWS R-E-Z", XX%, 2
  465.       IF XX% <> 21 THEN PRINTW STRING$(76, 176), XX% + 1, 2
  466.    NEXT
  467.    IF DEMOATTR% = 112 THEN INFOATTR% = 15 ELSE INFOATTR% = 31
  468.    INFOLINE 24, 2, 78, INFOATTR%
  469.  
  470. '-------------- MAIN MENU WINDOW ---- USES PULLDOWN ROUTINE -----------------
  471.  
  472. MAIN.MENU:
  473.  
  474.    A% = COL%(111)
  475.    MAKEWIND 2, "@WINDOWS R-E-Z", 4, 50, 25, 7, A%, 111
  476.    PRINTW "Version 6.00", 1, 100
  477.    PRINTW "CONNECT Software", 2, 100
  478.    PRINTW "Nov. 1, 1992", 3, 100
  479.    
  480.    MAKEWIND 1, "@***** Instructions *****", 14, 100, 75, 8, A%, 111
  481.    PRINTW "To demonstrate most of the features  included with WINDOW R-E-Z use the", 1, 2
  482.    PRINTW "PULLDOWN WINDOWS.   Use the arrow keys, mouse, or press the appropriate", 2, 2
  483.    PRINTW "letter to make a selection.   Instuctions  for most of the routines are", 3, 2
  484.    PRINTW "printed on the info-line at the bottom of the display...", 4, 2
  485.  
  486.    HATTR% = 124
  487.    A% = COL%(113): IF A% = 15 THEN A% = 112: HATTR% = 127
  488. PULL:
  489.    INFOFIXED " Demonstration: "
  490.    PULLDOWN PULLINFO$(), BAR%, WIND%, "12", RKEY%, A%, HATTR%, 11' PULLDOWN WINDOWS
  491.    INFOFIXED ""
  492.    IF RKEY% = 1 THEN BAR% = 1: WIND% = 1
  493.    IF RKEY% = 2 THEN BAR% = 1: WIND% = 2
  494.  
  495.    IF (BAR% = 1 AND WIND% = 3) OR (BAR% = 1 AND WIND% = 5) THEN
  496.       'NOTHING
  497.    ELSE                                '  NOT SCROLL WINDOW DEMO OR EXIT
  498.       RSTRPULL 1                       ' RESTORE AREA UNDER PULLDOWN WINDOW.
  499.       RSTRWIND 2, 1                    ' RESTORE "CONNECT SOFTWARE" WINDOW.
  500.       RSTRWIND 1, 1                    ' RESTORE PULLDOWN INSTRUCTION WINDOW.
  501.    END IF
  502.  
  503. SELECT CASE BAR%
  504.  
  505. '------------------ "WINDOWS" OPTION FROM MENUBAR --------------------------
  506.  
  507.    CASE 1
  508.       SELECT CASE WIND%
  509.          CASE 1                           ' WINDOW MANAGEMENT SYSTEM
  510.             CALL WINDOWDEMO
  511.          CASE 2                           ' GET ANSWER DEMO
  512.             CALL GETANSDEMO
  513.          CASE 3                           ' SCROLL WINDOW DEMO
  514.             CALL SCROLLDEMO(WASESC%)
  515.             IF WASESC% = 1 THEN GOTO PULL ' ESC EXITED SCROLL DEMO
  516.                                           ' RE-ENTER PULLDOWN WITH PULLDOWN
  517.                                           ' WINDOW 1 ACTIVE.
  518.  
  519.          CASE 5:                          ' EXIT WAS SELECTED
  520.             PRINTINFO ("Press < Yes > to quit or < No > to continue.  Press ENTER to accept...")
  521.             REDIM TEXT$(0), CHOICE$(2)
  522.             CHOICE$(1) = "No": CHOICE$(2) = "Yes"
  523.             SELECT CASE CHOICEWIND%("@ End this Demonstration..", TEXT$(), CHOICE$(), 7, 26, 112, 127, 1, 112)
  524.               CASE 2            ' YES
  525.                 CLS : END
  526.               CASE ELSE         ' NO OR ESC
  527.                 RSTRPULL 0: GOTO PULL
  528.             END SELECT
  529.          CASE ELSE
  530.       END SELECT
  531.  
  532. '------------------- "CONTROL BOX" OPTION FROM MENUBAR ---------------------
  533.   CASE 2
  534.     CALL CONTROLBOX
  535.  
  536. '--------------------- "INPUT" OPTION FROM MENUBAR--------------------------
  537.   CASE 3                                  ' INPUT ROUTINES
  538.      SELECT CASE WIND%
  539.         CASE 1                            ' MULTI-FIELD INPUT
  540.            CALL MULTINPUTDEMO1
  541.         CASE 2                            ' "CHANGE" MULTI-FIELD INPUT
  542.            CALL MULTINPUTDEMO2
  543.         CASE 3                            'INPUT WINDOW DEMO
  544.            CALL INPUTWINDOWDEMO
  545.         CASE ELSE
  546.     END SELECT
  547.  
  548. '----------------------- "DIRECTORY" OPTION FROM MENUBAR  ------------------
  549.   CASE 4
  550.      DELWIND 1
  551.      CALL GETFILE(P$, F$, RKEY%)
  552.      IF RKEY% <> 27 THEN
  553.         REDIM C$(1): C$(1) = "OK"
  554.         REDIM T$(4)
  555.         T$(2) = "  Path: " + P$: T$(3) = "  File: " + F$
  556.         PRINTINFO " Select OK...."
  557.         A% = COL%(31)
  558.         J% = CHOICEWIND%("@ **** Selections ****", T$(), C$(), 100, 100, A%, 0, 0, 112)
  559.      END IF
  560.      RSTRWIND 4, 1
  561.  
  562. '---------------------------------- COLOR ----------------------------------
  563.   CASE 5
  564.     CHNGPULL 5, -1, 0                           ' make all active
  565.     CHNGPULL 5, WIND%, 112                      ' make selected inactive
  566.     SHADCOL% = 7
  567.     DEMOATTR% = 112
  568.     DEMONOHI% = 0
  569.     RSTRINFO 1
  570.     SELECT CASE WIND%
  571.       CASE 2
  572.         CHNGPULL 5, 2, 120
  573.         SHADCOL% = 8
  574.         DEMOATTR% = 0
  575.       CASE 3
  576.         DEMONOHI% = 1
  577.       CASE ELSE
  578.     END SELECT
  579.     SETWIND DEMOFAST%, DEMOSOUND%, SHADCOL%, DEMONOHI%, 15
  580.     GOTO PREINTRO
  581. '-------------------------------- ORDER FORM -------------------------------
  582.  
  583.   CASE 6
  584.     RSTRINFO 0
  585.     CURINFO& = GETCUR&
  586.     A% = COL%(31): IF A% = 15 THEN A% = 112
  587.    
  588.     TOFLD% = 1: FROMFLD% = 0
  589.  
  590.     MAKEWIND 1, "@*** WINDOWS R-E-Z  Order Form ***", 100, 100, 80, 25, A%, 101
  591.     PRINTW "Name.......                                 Date.....", 2, 2
  592.     PRINTW "Address....                                 Registered User (Y/N).", 4, 2
  593.     PRINTW "Address....                                 Registration Number..", 6, 2
  594.     PRINTW "City/State.", 8, 2
  595.     PRINTW "Zip Code...       ( Enter 0 if not USA )", 10, 2
  596.     PRINTW "Programming Language..                      Disk Size............", 12, 2
  597.  
  598.  
  599.     PRINTW "Hard Copy Documentation (Y/N).    ( Same as on disk. Lazer printed. Three  ) ", 14, 2
  600.     PRINTW "( ring binder - $15.00 - USA orders only.)", 15, 36
  601.  
  602.     PRINTW "TERMS: Check/ money order/ Visa/ MC.  Fees detailed on hard copy order form.", 17, 2
  603.     PRINTW "Visa / Master card #                        Expiration date:", 19, 2
  604.  
  605.     NEWCOLOR 15
  606.     PREYN$ = ORDER$(7)
  607.  
  608.     J$ = SPACE$(76)
  609.  
  610. PREORDER:
  611.  
  612.     SELECT CASE TOFLD%
  613.       CASE 1
  614.          I$ = "Input your name."
  615.       CASE 2, 3, 4
  616.          I$ = "Input your address."
  617.       CASE 5
  618.          I$ = "Input your zip code."
  619.       CASE 6
  620.          I$ = "Enter today's date. (" + DATETYPE$(DFORMAT%) + ")  Must be valid to exit field!"
  621.       CASE 7
  622.          I$ = "Input Y if you are a registered user or N if not."
  623.       CASE 8
  624.          I$ = "If you are a registered user input your registation number."
  625.       CASE 9
  626.          I$ = "CHOICES:  QuickBASIC 4.5 / VBDOS 1.00 / BASIC 7.1 - PDS"
  627.          GOSUB SPINST
  628.       CASE 10
  629.          I$ = "CHOICES: 5.25 in. 1.2M / 5.25 in. 360k / 3.5 in. 1.4M / 3.5 in. 720k"
  630.          GOSUB SPINST
  631.       CASE 11
  632.          I$ = "Enter Y for hard copy documentation or N for none."
  633.       CASE 12
  634.          I$ = "Enter Visa/Master Card number if using same."
  635.       CASE 13
  636.          I$ = "Enter Visa/Master card expiration date. ( mm/yy )"
  637.       CASE ELSE
  638.     END SELECT
  639.       IF TOFLD% < 9 OR TOFLD% > 11 THEN I$ = "INSTRUCTIONS: " + I$
  640.  
  641.     LSET J$ = I$
  642.     PRINTW J$, 21, 100
  643.  
  644.     MULTINPT 4, TOFLD%, "", FROMFLD%, RKEY%, ORDER$(), SELFIELD%
  645.     IF SELFIELD% = 14 THEN RKEY% = 1
  646.     IF SELFIELD% = 15 THEN RKEY% = 10
  647.     IF (FROMFLD% = TOFLD%) AND RKEY% = 100 THEN RKEY% = 32
  648.  
  649.     IF RKEY% = 32 THEN                              ' Space bar - fields 9,10,11
  650.       SELECT CASE FROMFLD%
  651.         CASE 9                                     ' Space bar - field 10
  652.             LAN% = LAN% + 1: IF LAN% = 4 THEN LAN% = 1
  653.             ORDER$(9) = LAN$(LAN%)                 ' change language
  654.         CASE 10                                     ' Space bar - field 11
  655.             DSIZE% = DSIZE% + 1: IF DSIZE% = 5 THEN DSIZE% = 1
  656.             ORDER$(10) = DISK$(DSIZE%)              ' change disk type
  657.         CASE ELSE
  658.       END SELECT
  659.       GOTO PREORDER
  660.     END IF
  661.  
  662.   ' Delete the space bar instruction window if the field is not a
  663.   ' "multi-choice field" or MULTINPT is exited via a function key.
  664.  
  665.    IF FROMFLD% >= 9 AND FROMFLD% <= 10 THEN
  666.       IF TOFLD% < 9 OR TOFLD% > 10 OR RKEY% < 11 THEN
  667.         RSTRWIND 3, 1
  668.       END IF
  669.    END IF
  670.  
  671.    IF RKEY% > 10 THEN            ' Was not a F1 or F10
  672.       GOTO PREORDER              ' FROMFLD% can't = 0 so single field
  673.    END IF                        ' only will update ( for speed ).
  674.                                  ' Program can get here if cursor movement
  675.                                  ' key is pressed on fixed-choice field or
  676.                                  ' any other field
  677.  
  678.    IF RKEY% = 10 THEN            ' F10 key was pressed to exit MULTINPT
  679.       FERR% = 0
  680.       FOR XX% = 1 TO 14          ' check for blank fields
  681.          SELECT CASE XX%
  682.             CASE 1, 4, 5, 6, 7, 11      ' fields require entry
  683.                IF ORDER$(XX%) = "" THEN
  684.                   FERR% = 1
  685.                   EXIT FOR
  686.                END IF
  687.             CASE 8              ' field 8  requireS entry if field 7 = "Y"
  688.                IF ORDER$(7) = "Y" AND ORDER$(XX%) = "" THEN
  689.                   FERR% = 1
  690.                   EXIT FOR
  691.                ELSE
  692.                   IF ORDER$(7) = "N" AND ORDER$(XX%) <> "" THEN
  693.                      FERR% = 2
  694.                      EXIT FOR
  695.                   END IF
  696.                END IF
  697.             CASE 13             ' field 14 requires entry if field 13 has entry
  698.                IF ORDER$(12) <> "" AND ORDER$(13) = "" THEN
  699.                   FERR% = 1
  700.                   EXIT FOR
  701.                END IF
  702.             CASE ELSE
  703.          END SELECT
  704.       NEXT
  705.  
  706.       IF FERR% = 1 THEN           ' a blank field was found
  707.          GETANS "BLANK FIELD: Entry required.  Press any key...", "", "", 100, 100, 112, 0, 11
  708.          TOFLD% = XX%: FROMFLD% = 1: GOTO PREORDER
  709.       ELSEIF FERR% = 2 THEN
  710.          GETANS "Field must be blank if Registered user field = N.  Press any key...", "", "", 100, 100, 112, 0, 11
  711.          TOFLD% = XX%: FROMFLD% = 1: GOTO PREORDER
  712.       END IF
  713.       OANS$ = ""
  714.       CLEARKB
  715.       GETANS "Prepare your printer.  Press any key when ready...", "", OANS$, 18, 100, 143, 143, 2
  716.       IF OANS$ = CHR$(27) THEN GOTO PREORDER
  717.  
  718.       ON ERROR GOTO PRINTERROR
  719.       LPRINT
  720.       LI$ = STRING$(76, "-")
  721.       LPRINT
  722.       LPRINT TAB(4); LI$
  723.       LPRINT TAB(28); "WINDOWS R-E-Z ORDER FORM"
  724.       LPRINT TAB(34); "Version 6.00"
  725.       LPRINT TAB(4); LI$
  726.       LPRINT
  727.       FOR P% = 1 TO 4
  728.         LPRINT "    " + ORDER$(P%);
  729.         IF P% = 1 THEN LPRINT TAB(53); "Date: " + ORDER$(6);
  730.         IF P% = 2 THEN LPRINT TAB(53); "Registered User: " + ORDER$(7);
  731.         IF P% = 3 THEN LPRINT TAB(53); "Registration Number: " + ORDER$(8)
  732.         IF P% = 4 THEN
  733.            LPRINT "   " + ORDER$(5);
  734.         ELSE
  735.            LPRINT : LPRINT
  736.         END IF
  737.       NEXT
  738.       LPRINT
  739.       LPRINT TAB(4); LI$
  740.       LPRINT
  741.       LPRINT "    Programming Language: " + ORDER$(9)
  742.       LPRINT
  743.       LPRINT "    Disk Size: " + ORDER$(10)
  744.       LPRINT
  745.       LPRINT TAB(4); LI$
  746.       LPRINT
  747.       LPRINT "    Visa / Master card # " + ORDER$(12); TAB(55); "Expiration Date: " + ORDER$(13)
  748.       LPRINT
  749.       LPRINT "    Signature:"
  750.       LPRINT "              -----------------------------------"
  751.       LPRINT TAB(4); LI$
  752.       LPRINT
  753.       LPRINT TAB(35); "Registration / Update fee: -------- ";
  754.       IF ORDER$(7) = "N" THEN
  755.          FEE$ = "$32.50": FEE = 32.5
  756.       ELSE
  757.          FEE$ = "$22.50": FEE = 22.5
  758.       END IF
  759.       LPRINT FEE$
  760.       LPRINT
  761.       LPRINT TAB(35); "Hard copy documentation charge ---- ";
  762.       IF ORDER$(11) = "Y" THEN
  763.          FEE$ = "$15.00": FEE = FEE + 15
  764.       ELSE
  765.          FEE$ = ""
  766.       END IF
  767.       LPRINT FEE$
  768.       LPRINT
  769.       LPRINT TAB(35); "Shipping and Handling--------------  $2.50"
  770.       LPRINT
  771.       FEE$ = STR$(FEE + 2.5): MID$(FEE$, 1) = "$"
  772.  
  773.       LPRINT TAB(35); "             TOTAL CHARGE --------- ";
  774.       LPRINT USING "$##.##"; FEE + 2.5
  775.       LPRINT
  776.       LPRINT TAB(4); LI$
  777.       LPRINT
  778.       LPRINT "    Make checks and money orders payable to: CONNECT Software"
  779.       LPRINT
  780.       LPRINT "    Send completed order form to:   CONNECT Software"
  781.       LPRINT TAB(37); "6192 Fawn Meadow"
  782.       LPRINT TAB(37); "Farmington, NY   14425"
  783.       LPRINT
  784.       LPRINT
  785.       LPRINT "    Orders paid with a credit card or money order will be shipped within "
  786.       LPRINT "    two weeks of receipt.  Orders paid with checks will be shipped within"
  787.       LPRINT "    three weeks of receipt."
  788.       LPRINT
  789.       LPRINT "    Phone Orders - 6:OOpm - 9:00pm EST  Weekdays and weekends."
  790.       LPRINT "                 - (716) 924-3439"
  791.       LPRINT
  792.       LPRINT "    Call person to person for RICH - CONNECT SOFTWARE"
  793.  
  794.       LPRINT TAB(4); LI$
  795.       LPRINT CHR$(12)
  796. DONEORDER:
  797.       ON ERROR GOTO 0
  798.  
  799.     END IF
  800.     
  801.     RSTRWIND 1, 1                  ' It was a function key
  802.     SETCUR (CURINFO&)
  803.  
  804.    CASE ELSE
  805.    
  806.  END SELECT
  807.  
  808.  GOTO MAIN.MENU
  809.  
  810. PRINTERROR:
  811.    OANS$ = ""
  812.    GETANS "PRINTER ERROR:  (R)etry or (A)bort.", "RA", OANS$, 100, 100, 143, 0, 2
  813.    IF OANS$ = "R" THEN RESUME ELSE RESUME DONEORDER
  814.  
  815. SPINST:
  816.   IF WAVAIL%(3) THEN
  817.     MAKEWIND 3, "", 18, 100, 75, 3, 240, 1
  818.     NEWCOLOR 15
  819.     PRINTW "Press SPACE BAR for selection. Press cursor movement key to exit field.", 1, 100
  820.     CHNGWIND 1
  821.   END IF
  822. RETURN
  823.  
  824. DISKERROR:
  825.   E$ = "DISK ERROR"
  826.   A% = A% + 128
  827.   GETANS "Disk Error.   Press any key...", "", "", 19, 100, A%, 0, 11
  828.   A% = A% - 128
  829. RESUME REALSTART
  830.  
  831. 'TEST:                      ' to test key trapping
  832. ' C& = GETCUR&
  833. ' PRINT "RWERWER"
  834. ' SETCUR C&
  835. 'RETURN
  836.  
  837. FUNCTION COL% (A%)
  838.   '------------------------------------------------------------------------
  839.   ' used by all routines to set color based on user's selection of color.
  840.   '------------------------------------------------------------------------
  841.  
  842.   ' DEMOATTR% IS SHARED - IT IS SET IN MAIN MODULE
  843.   ' DEMOATTR% = 112 IF BLACK AND WHITE OR NO HIGH INTENSITY
  844.  
  845.   IF DEMOATTR% = 112 THEN COL% = 15 ELSE COL% = A%
  846.  
  847. END FUNCTION
  848.  
  849. SUB CONTROLBOX
  850.  
  851.    STATIC PASS%, RTRN$()                 ' static vars.
  852.    STATIC ISFAST%, SETSND%, SETCURSOR%, SETERASE%, PRESSSND%, SETDECIMAL%
  853.   
  854.    C& = GETCUR&                          ' save cursor position/size in C&
  855.  
  856.    ' info-line is active from caller so this only changes it's color
  857.    INFOLINE 0, 0, 0, 15
  858.  
  859.    A% = COL%(31): IF A% = 15 THEN A% = 112    ' set contol box color
  860.  
  861.    IF PASS% = 0 THEN
  862.      ' --------------------------------------------------------------------
  863.      ' on first call to this sub -- do this
  864.      ' --------------------------------------------------------------------
  865.      REDIM RTRN$(18)
  866.      FOR X% = 1 TO 12: RTRN$(X%) = "( )": NEXT
  867.      RTRN$(5) = "(+)"                          ' cursor to 1st field pos = yes
  868.      SETERASE% = 1: RTRN$(8) = "(+)"           ' erase on 1st key = yes
  869.      ISFAST% = 1: RTRN$(4) = "[OFF]"           ' fast print for CGA = OFF
  870.      SETSND% = 1: RTRN$(2) = "(+)"             ' sound = click
  871.      PRESSSND% = 1: RTRN$(10) = "(+)"          ' sound for bad input = yes
  872.      SETDECIMAL% = 1: RTRN$(12) = "(+)"        ' decimal point = period
  873.      PASS% = 1                                 ' flag for 2nd pass
  874.      RTRN$(16) = "< SOUND >"                   ' test sound button
  875.      RTRN$(17) = "<   OK   >"                  ' ok button
  876.      RTRN$(18) = " < CANCEL > "                ' cancel button
  877.    END IF
  878.    RTRN$(13) = "": RTRN$(14) = "": RTRN$(15) = ""
  879.  
  880.    ' save - so original values can be restored if <ESC> or <CANCEL> exits.
  881.  
  882.    REDIM OLDRTRN$(18)
  883.    FOR X% = 1 TO 18: OLDRTRN$(X%) = RTRN$(X%): NEXT
  884.    ISFAST2% = ISFAST%: SETSND2% = SETSND%: SETCURSOR2% = SETCURSOR%
  885.    SETERASE2% = SETERASE%: PRESSSND2% = PRESSSND%
  886.    SETDECIMAL2% = SETDECIMAL%: DFORMAT2% = DFORMAT%
  887.  
  888.    GOSUB INPT.PARAMETERS
  889.    GOSUB GENERAL.PARAMETERS
  890.  
  891.    ' ------------------------ Make the input screen ------------------------
  892.  
  893.    CALL MAKEWIND(10, "@ * ENTER=ACCEPT *       *** Control Box ***       * ESC=CANCEL *", 100, 100, 80, 25, A%, 101)
  894.  
  895.    PRINTW "Set sound...........", 1, 3      ' sound box
  896.    BOXW 2, 2, 22, 5, 1
  897.    PRINTW "No sound", 3, 7
  898.    PRINTW "Click", 4, 7
  899.    PRINTW "Beep", 5, 7
  900.  
  901.    PRINTW "Slow print for CGA..", 7, 3     ' slow print for cga box
  902.    BOXW 8, 2, 22, 3, 1
  903.    PRINTW "Slow print", 9, 9
  904.  
  905.    PRINTW "Date format..", 11, 3
  906.    MAKEWIND 3, "", 15, 3, 14, 7, A%, 1     ' make the date scroll window
  907.    PRETYPE% = DFORMAT%
  908.    KIND$ = "V": NOREFRESH% = 0             ' display the scroll window
  909.    GOSUB SCROLLBOX                         ' this displays it/
  910.    KIND$ = "":  NOREFRESH% = 1             ' for future calls to sub SCROLLBOX
  911.                                            
  912.    CHNGWIND 10
  913.  
  914.    PRINTW "Set cursor on field entry ....", 1, 27  ' cursor position box
  915.    BOXW 2, 26, 32, 4, 1
  916.    PRINTW "To end of text", 3, 31
  917.    PRINTW "To start of text", 4, 31
  918.  
  919.    PRINTW "First valid character pressed.", 6, 27  ' blank on 1st key box
  920.    BOXW 7, 26, 32, 4, 1
  921.    PRINTW "Prints", 8, 31
  922.    PRINTW "Erases field and prints", 9, 31
  923.  
  924.    PRINTW "Pressing an invalid key.......", 11, 27 ' sound on invalid key box
  925.    BOXW 12, 26, 32, 4, 1
  926.    PRINTW "Makes no sound", 13, 31
  927.    PRINTW "Makes the default sound", 14, 31
  928.  
  929.    PRINTW "Print decimal designator as...", 16, 27 ' decimal point box
  930.    BOXW 17, 26, 32, 4, 1
  931.    PRINTW "A comma (non-USA) ", 18, 31
  932.    PRINTW "A period", 19, 31
  933.  
  934.    PRINTW "**** TEST ****", 1, 62                  ' test box
  935.    BOXW 2, 61, 16, 12, 1
  936.    PRINTW "Text......", 3, 64
  937.    PRINTW "Number....", 6, 64
  938.    PRINTW "Date......", 9, 64
  939.  
  940.    NEWCOLOR 112                                    ' ok/cancel buttons
  941.    BOXW 14, 63, 12, 3, 2
  942.    BOXW 17, 63, 12, 3, 2
  943.    NEWCOLOR A%
  944.  
  945.    TOFLD% = 1                                ' enter of 1st field
  946.    OPTION$ = "VIEW"                          ' view only
  947.    FROMFLD% = 0                              ' update all fields
  948.    GOSUB GETMULT                             ' display input fields
  949.    OPTION$ = "U"                             ' field order is user defined
  950.                                              ' for TAB & SHIFT/TAB
  951.    RKEY% = 0: FROMFLD% = 1                   ' update 1st field only
  952.  
  953.    '-----------------------------------------------------------------------
  954.    ' go from input fields to date scroll window until ESC, ENTER are pressed
  955.    ' or < OK >, < CANCEL > are selected.
  956.    '-----------------------------------------------------------------------
  957.    DO WHILE RKEY% <> 13 AND RKEY% <> 27
  958.                                              
  959.       GOSUB GETMULT                          ' enter MULTINPT
  960.  
  961.       DO WHILE LBUTTON%                      ' if left button is pressed...
  962.  
  963.          ' see if the mouse cursor is in an input field
  964.          INFIELD% = MOUSEINMULT%(5)
  965.          IF INFIELD% > 0 THEN TOFLD% = INFIELD%: GOSUB GETMULT
  966.  
  967.          ' see if the mouse cursor is in the scroll window
  968.          IF MOUSEINWIND%(3) > 0 THEN GOSUB SCROLLBOX
  969.       LOOP
  970.  
  971.       ' scroll window entered via UP,DOWN,TAB,SHIFT/TAB from MULTINPT
  972.       IF TOSCROLL% = 1 THEN GOSUB SCROLLBOX
  973.  
  974.    LOOP
  975.    ' -----------------------------------------------------------------------
  976.  
  977.    DELWIND 3                        ' remove saved scroll window from
  978.    CALL RSTRWIND(10, 1)             ' window memory and restore area under
  979.                                     ' control panel.
  980.  
  981.    IF RKEY% = 27 THEN
  982.    '----------------------------------------------------------------------
  983.    ' restore original values -- ESC was pressed or CANCEL was selected.
  984.    '----------------------------------------------------------------------
  985.      FOR X% = 1 TO 18: RTRN$(X%) = OLDRTRN$(X%): NEXT
  986.      ISFAST% = ISFAST2%: SETSND% = SETSND2%: SETCURSOR% = SETCURSOR2%
  987.      SETERASE% = SETERASE2%: PRESSSND% = PRESSSND2%
  988.      SETDECIMAL% = SETDECIMAL2%: DFORMAT% = DFORMAT2%
  989.    END IF
  990.  
  991.    ' set variables shared with main module
  992.    DEMOFAST% = ISFAST%: DEMOSOUND% = SETSND%
  993.    IF SHADCOL% = 8 THEN INFOLINE 0, 0, 0, 31   ' restore info-line color
  994.    SETCUR (C&)                                 ' restore cursor size/position
  995.  
  996.    EXIT SUB                                    ' get ouy
  997.  
  998. GETMULT:
  999.  
  1000.   IF RKEY% <> 13 AND RKEY% <> 27 THEN
  1001.     TOSCROLL% = 0
  1002.     INF$ = " Use the ARROW keys or MOUSE to select.  Use TAB, SHIFT/TAB or Mouse to move."
  1003.  
  1004.     ' -------- TOFLD% represents the field the cursor is entering -------
  1005.     SELECT CASE TOFLD%
  1006.       CASE 1 TO 3                     ' entering a "set sound" field
  1007.         TOFLD% = 1 + SETSND%          ' adjust to mark proper one
  1008.         RTRN$(TOFLD%) = "(+)"         ' "       "
  1009.       CASE 5, 6                       ' entering a "set cursor pos." field
  1010.         TOFLD% = 5 + SETCURSOR%       ' adjust to mark proper one
  1011.         RTRN$(TOFLD%) = "(+)"
  1012.       CASE 7, 8                       ' entering "blank on 1st char" field
  1013.         TOFLD% = 7 + SETERASE%        ' adjust to mark proper one
  1014.         RTRN$(TOFLD%) = "(+)"
  1015.       CASE 9, 10                      ' entering a "sound for bad" char field
  1016.         TOFLD% = 9 + PRESSSND%        ' adjust to mark proper one
  1017.         RTRN$(TOFLD%) = "(+)"
  1018.       CASE 11, 12                     ' entering a "set decimal pt" field
  1019.         TOFLD% = 11 + SETDECIMAL%     ' adjust to mark proper one
  1020.         RTRN$(TOFLD%) = "(+)"
  1021.       CASE 4, 16                      ' CGA PRINT, < SOUND > fileds
  1022.         INF$ = " Press SPACE bar or CLICK mouse to select.  TAB, SHIFT/TAB moves."
  1023.       CASE 17 TO 18                 ' <OK), <CANCEL> fields
  1024.         INF$ = " Press SPACE bar, ENTER or CLICK mouse to select.  TAB, SHIFT/TAB moves."
  1025.       CASE 13                         ' test TEXT field
  1026.         INF$ = " Enter text.."
  1027.       CASE 14                         ' test NUMBER field
  1028.         INF$ = " Enter a number..."
  1029.       CASE 15                         ' test DATE field
  1030.         INF$ = " * NOTE: DATE MUST BE VALID IN SPECIFIED FORMAT OR FIELD CAN NOT BE EXITED *"
  1031.     END SELECT
  1032.     PRINTINFO INF$                    ' print the info string
  1033.     
  1034.     MULTINPT 5, TOFLD%, OPTION$, FROMFLD%, RKEY%, RTRN$(), 0
  1035.     
  1036.     ' make ENTER on < CANCEL > the same as SPACE BAR on < CANCEL >
  1037.     IF RKEY% = 13 AND FROMFLD% = 18 THEN RKEY% = 32
  1038.  
  1039.     IF RKEY% = 100 THEN         ' left mouse button RELEASED in field
  1040.        FROMFLD% = TOFLD%
  1041.        SELECT CASE TOFLD%
  1042.          CASE 4, 16 TO 18       ' <SOUND>,<OK> or <CANCEL>
  1043.            RKEY% = 32           ' make same as SPCE BAR
  1044.          CASE ELSE
  1045.       END SELECT
  1046.     END IF
  1047.  
  1048.     SELECT CASE RKEY%
  1049.       CASE 16, 19, 100                  ' UP/DOWN ARROWS or MOUSE exited
  1050.          SELECT CASE FROMFLD%
  1051.  
  1052.            CASE 1 TO 3                  ' set sound fields
  1053.              FROMFLD% = 1 + SETSND%
  1054.               SETSND% = NEWSEL%(3, SETSND%, RKEY%, TOFLD% - 1, RTRN$(FROMFLD%))
  1055.              GOSUB GENERAL.PARAMETERS
  1056.              TOFLD% = FROMFLD%
  1057.  
  1058.            CASE 4                              ' set CGA print speed fields.
  1059.              IF RKEY% = 19 THEN TOSCROLL% = 1  ' if DOWN ARROW set flag
  1060.                                                ' to enter scroll window.
  1061.  
  1062.            CASE 5, 6                           ' set cursor entry position
  1063.              FROMFLD% = 5 + SETCURSOR%
  1064.              SETCURSOR% = NEWSEL%(2, SETCURSOR%, RKEY%, TOFLD% - 5, RTRN$(FROMFLD%))
  1065.              GOSUB INPT.PARAMETERS
  1066.              TOFLD% = FROMFLD%
  1067.  
  1068.            CASE 7, 8                    ' set erase on 1st valid key pressed
  1069.              FROMFLD% = 7 + SETERASE%
  1070.              SETERASE% = NEWSEL%(2, SETERASE%, RKEY%, TOFLD% - 7, RTRN$(FROMFLD%))
  1071.              GOSUB INPT.PARAMETERS
  1072.              TOFLD% = FROMFLD%
  1073.  
  1074.            CASE 9, 10                   ' set sound on bad key pressed
  1075.              FROMFLD% = 9 + PRESSSND%
  1076.              PRESSSND% = NEWSEL%(2, PRESSSND%, RKEY%, TOFLD% - 9, RTRN$(FROMFLD%))
  1077.              GOSUB INPT.PARAMETERS
  1078.              TOFLD% = FROMFLD%
  1079.  
  1080.            CASE 11, 12                  ' set decimal designator
  1081.              OLDSETDECIMAL% = SETDECIMAL%
  1082.              FROMFLD% = 11 + SETDECIMAL%
  1083.              SETDECIMAL% = NEWSEL%(2, SETDECIMAL%, RKEY%, TOFLD% - 11, RTRN$(FROMFLD%))
  1084.              IF SETDECIMAL% <> OLDSETDECIMAL% THEN
  1085.                 IF SETDECIMAL% = 0 THEN
  1086.                      D$ = ".": ND$ = ","
  1087.                 ELSE
  1088.                      D$ = ",": ND$ = "."
  1089.                 END IF
  1090.                 POSIT% = INSTR(RTRN$(14), D$)
  1091.                 IF POSIT% <> 0 THEN MID$(RTRN$(14), POSIT%, 1) = ND$
  1092.                 CALL UPDATEFIELD(5, 14, RTRN$(14))
  1093.                 GOSUB INPT.PARAMETERS
  1094.              END IF
  1095.              TOFLD% = FROMFLD%
  1096.            CASE ELSE
  1097.          END SELECT
  1098.  
  1099.       CASE 32                                   ' space bar exited MULTINPT
  1100.          SELECT CASE FROMFLD%
  1101.            CASE 4                               ' from set CGA print field
  1102.              IF ISFAST% = 0 THEN
  1103.                ISFAST% = 1: RTRN$(4) = "[OFF]"
  1104.              ELSE
  1105.                RTRN$(4) = "[ON ]": ISFAST% = 0
  1106.              END IF
  1107.              GOSUB GENERAL.PARAMETERS
  1108.            CASE 16                              ' from < SOUND > field
  1109.              DOSOUND
  1110.            CASE 17                              ' from < OK > field
  1111.              RKEY% = 13                         ' make same as ENTER
  1112.            CASE 18                              ' from < CANCEL > field
  1113.              RKEY% = 27                         ' make same as ESC
  1114.            CASE ELSE
  1115.          END SELECT
  1116.  
  1117.       CASE 14, 15                            ' TAB,SHIFT/TAB exited MULTINPT
  1118.         SELECT CASE FROMFLD%
  1119.         '--------------------------------------------------------------------
  1120.         ' all CASES adjust TOFLD% so cursor move to the correct field
  1121.         ' when MULTINPT is re-entered
  1122.         '--------------------------------------------------------------------
  1123.           CASE 1 TO 3
  1124.              IF RKEY% = 14 THEN TOFLD% = 18 ELSE TOFLD% = 4
  1125.           CASE 4
  1126.              IF RKEY% = 15 THEN TOSCROLL% = 1
  1127.           CASE 5, 6
  1128.             IF RKEY% = 14 THEN TOSCROLL% = 1 ELSE TOFLD% = 7
  1129.           CASE 7, 8
  1130.             IF RKEY% = 14 THEN TOFLD% = 5 ELSE TOFLD% = 9
  1131.           CASE 9, 10
  1132.             IF RKEY% = 14 THEN TOFLD% = 7 ELSE TOFLD% = 11
  1133.           CASE 11, 12
  1134.             IF RKEY% = 14 THEN TOFLD% = 9 ELSE TOFLD% = 13
  1135.           CASE ELSE
  1136.         END SELECT
  1137.  
  1138.       CASE 200                          ' MOUSE pressed out of all fields
  1139.                                         ' do nothing - above loop takes
  1140.                                         ' care or it
  1141.       CASE ELSE
  1142.         ' eliminate left/right arrows ctrl/end etc. as they will cause an
  1143.         ' exit for AUTOEXIT fields also.
  1144.  
  1145.         TOFLD% = FROMFLD%
  1146.     END SELECT
  1147.  
  1148.  END IF
  1149.  
  1150. RETURN
  1151.  
  1152. SCROLLBOX:                                ' date scroll window
  1153.   IF RKEY% <> 13 AND RKEY% <> 27 THEN
  1154.     CHNGWIND 10                           ' control box is active
  1155.     CALL PRINTW("▀▀▀▀▀▀▀▀▀▀▀▀", 12, 3)    ' show scroll window is active
  1156.     CHNGWIND 3                            ' make scroll window active
  1157.     OLDDFORMAT% = DFORMAT%                ' save to see if changed
  1158.     CALL CUROFF                           ' turn the cursor off
  1159.  
  1160.     ' exit on TAB,SHIFT/TAB,ENTER,left MOUSE button pressed out of window,
  1161.     ' or RIGHT ARROW and LEFT ARROW
  1162.  
  1163.     B4SCRL "TEROA", "", 0, NOREFRESH%
  1164.  
  1165.     ' print the fixed info string - same for all scroll selections
  1166.     INFOFIXED " Use the arrow keys to select - TAB or Mouse to move."
  1167.  
  1168.     ' enter the scroll window
  1169.     SCRLWIND DATETYPE$(), DUMMY$(), "", 5, KIND$, DFORMAT%, DFORMAT%, 1, RKEY%, 0, 1, 0
  1170.  
  1171.     INFOFIXED ""                               ' erase the fixed info string
  1172.     IF RKEY% = 14 THEN RKEY% = 0: TOFLD% = 4   ' SHIFT/TAB to slow CGA print
  1173.     IF RKEY% = 15 THEN RKEY% = 0: TOFLD% = 5   ' TAB to set cursor position
  1174.     CHNGWIND 10                                ' make the control box active
  1175.     CALL PRINTW("────────────", 12, 3)         ' show not in scroll window
  1176.     IF DFORMAT% <> OLDDFORMAT% THEN            ' date format was changed
  1177.         GOSUB INPT.PARAMETERS                  ' go reset it
  1178.         CALL UPDATEFIELD(5, 15, "")            ' erase the date field
  1179.         RTRN$(15) = ""                         ' erase text for the field
  1180.     END IF
  1181.   END IF
  1182.  
  1183. RETURN
  1184.  
  1185. GENERAL.PARAMETERS:
  1186.   SETWIND ISFAST%, SETSND%, SHADCOL%, DEMONOHI%, 15
  1187. RETURN
  1188.  
  1189. INPT.PARAMETERS:
  1190.   INPTINIT DFORMAT%, SETDECIMAL%, SETCURSOR%, SETERASE%, PRESSSND%
  1191. RETURN
  1192.  
  1193. END SUB
  1194.  
  1195. SUB GETANSDEMO
  1196.  
  1197.   A% = COL%(95)        ' COLOR GRAY/PURPLE OR B/W
  1198.   
  1199.   ' MAKE WINDOW 1 AND PRINT IN SAME.
  1200.  
  1201.   MAKEWIND 1, "@***** Get Answer Window Demonstration *****", 4, 100, 72, 9, A%, 132
  1202.   PRINTW "Get answer  windows are used to ask a question and wait for a single", 1, 100
  1203.   PRINTW "key response.  They can also be used to pause a program and wait for", 2, 100
  1204.   PRINTW "any key to be pressed.  Prompts may be windowed or un-windowed.  The", 3, 100
  1205.   PRINTW "area under the prompt or window is restored on exit. If the response", 4, 100
  1206.   PRINTW "is displayed, ENTER must be pressed to accept it....", 5, 2
  1207.   PRINTINFO " Press Y or N.  Press ENTER to accept...."
  1208.  
  1209.   ' Y, N or ESC are valid responses.. Displays "N" on entry as ANS$ = "N"
  1210.  
  1211.   ANS$ = "N"
  1212.   GETANS "Are you sure? (Y/N) " + S$, "YN", ANS$, 13, 100, A%, 15, 32
  1213.   IF ANS$ <> CHR$(27) THEN
  1214.     IF ANS$ = "Y" THEN TEMP$ = "YES" ELSE TEMP$ = "NO"
  1215.     GOSUB REPLY
  1216.  
  1217.     PRINTINFO " Press A, B or C..."
  1218.     ' A, B, C or ESC are valid.  No fiels displayed on entry as ABS$ = ""
  1219.     ANS$ = ""
  1220.     GETANS "Press A, B or C to continue" + S$, "ABC", ANS$, 13, 100, A%, 0, 32
  1221.   END IF
  1222.   IF ANS$ <> CHR$(27) THEN
  1223.     TEMP$ = ANS$: GOSUB REPLY
  1224.   END IF
  1225.   RSTRWIND 1, 1
  1226.   EXIT SUB
  1227.  
  1228. REPLY:
  1229.   PRINTINFO " Press any key....."
  1230.   GETANS "Your reply was: " + TEMP$ + ".   Press any key...", "", "", 13, 100, A% + 128, 0, 32
  1231. RETURN
  1232.  
  1233. END SUB
  1234.  
  1235. SUB INPUTWINDOWDEMO
  1236.  
  1237.    RSTRINFO 0               ' RESTORE AREA UNDER INFOLINE & KEEP IT ACTIVE.
  1238.    A% = COL%(32)            ' GREEN/GRAY OR B/W
  1239.  
  1240.    ' make window 15 and print in it
  1241.  
  1242.    MAKEWIND 15, "", 3, 100, 72, 7, A%, 12
  1243.    PRINTW "** ALPHA/NUMERIC INPUT WINDOW **", 1, 100
  1244.    LINEW 2, 1
  1245.    PRINTW "This example allows upper and lower case input. Exclusive upper case", 3, 2
  1246.    PRINTW "or lower case is available .   ALL input windows may use one ( OK ),", 4, 2
  1247.    PRINTW "two ( OK & CANCEL ), or no buttons.", 5, 2
  1248.  
  1249.    ' info-line
  1250.  
  1251.    PRINTINFO " Prompt in window's title box.  ENTER/ESC - OK/CANCEL to complete."
  1252.  
  1253.    ' input alpha/numeric
  1254.  
  1255.    INPTWIND "@** Input your name **", "A", 12, 100, 30, A%, A%, RTR$, RK%, 2, 112
  1256.  
  1257.    RSTRINPT 1                               ' restore area under input window
  1258.  
  1259.    IF RK% <> 27 THEN                        ' if ESC/CANCEL was not pressed.
  1260.  
  1261.      ' DATE INPUT.  DATETYPE$(DFORMAT%) IS SHARED VARIABLE WHICH SPECIFIES
  1262.      ' DATE FORMAT.
  1263.  
  1264.      ' clear window 15 ( the active window ) and print new twxt in same.
  1265.  
  1266.      CLRWIND
  1267.      PRINTW "** DATE INPUT WINDOW **", 1, 100
  1268.      LINEW 2, 1
  1269.      PRINTW "Ten date formats are available.   User's MUST input a valid date or", 3, 2
  1270.      PRINTW "the field must be blank to exit the field.   Invalid dates generate", 4, 2
  1271.      PRINTW "the default sound if an attempt is made to exit the field.", 5, 2
  1272.  
  1273.      ' new info-line text
  1274.      PRINTINFO " " + I$ + "Prompt to the left of the field in the window."
  1275.  
  1276.      ' input a date
  1277.  
  1278.      INPTWIND " DATE MUST = " + DATETYPE$(DFORMAT%) + " ( 1901 to 2099 ) to exit. ", "D", 15, 100, 10, A%, A%, RTR2$, RK%, 2, 11
  1279.  
  1280.      RSTRINPT 1                             ' restore area under input window
  1281.  
  1282.    END IF
  1283.  
  1284.    IF RK% <> 27 THEN                        ' if ESC/CANCEL was not pressed
  1285.  
  1286.      ' clear window 15 ( the active window ) and print new twxt in same.
  1287.  
  1288.      CLRWIND
  1289.      PRINTW "** NUMERIC INPUT WINDOW **", 1, 100
  1290.      LINEW 2, 1
  1291.      PRINTW "Although  this example is for a real number, numeric input  may be", 3, 2
  1292.      PRINTW "restricted to integers, or 1 to 6 decimal places.", 4, 2
  1293.      PRINTINFO " LOOK - no window or buttons!  Press ENTER to accept / ESC to cancel."
  1294.  
  1295.      ' input a number
  1296.  
  1297.      INPTWIND "INPUT A REAL NUMBER: ", "R", 15, 100, 15, A%, A%, RTR3$, RK%, 0, 0
  1298.  
  1299.      RSTRINPT 1                             ' restore area under input window
  1300.  
  1301.    END IF
  1302.  
  1303.    RSTRINFO 0                               ' restore area under info-line
  1304.    RSTRWIND 15, 1
  1305.    IF RK% <> 27 THEN                        ' WAS NOT ESC OR CANCEL
  1306.  
  1307.      ' display input text, date, and number in an "OK" choice window
  1308.  
  1309.      REDIM T$(3), C$(1)
  1310.      T$(1) = " NAME: " + RTR$
  1311.      T$(2) = " DATE: " + RTR2$
  1312.      T$(3) = " NUMBER: " + RTR3$
  1313.      C$(1) = "OK"
  1314.      JUNK% = CHOICEWIND%("@   **** The Data Entered Was:****   ", T$(), C$(), 100, 100, A%, 0, 1, 111)
  1315.    END IF
  1316.  
  1317. END SUB
  1318.  
  1319. SUB MULTINPUTDEMO1
  1320.  
  1321.    C& = GETCUR&                            ' save cursor position/size
  1322.  
  1323.    RSTRINFO 0                              ' restore area under info-line
  1324.    A% = COL(79): IF A% = 15 THEN A% = 112  ' color = gray/red or b/w
  1325.  
  1326.    ' use sub choicewind to display text
  1327.    
  1328.    REDIM T$(3), C$(1)
  1329.    T$(1) = "        Up to ten multi-field input screens may be defined using up to"
  1330.    T$(2) = " 150 input fields per screen.  Fields may be set to alpha/numeric num-"
  1331.    T$(3) = " eric, date, or protected. Complete editing features are incorporated."
  1332.    C$(1) = "OK"
  1333.    ANS% = CHOICEWIND%("@***** Multi-field Input Demonstration *****", T$(), C$(), 4, 4, A%, 0, 1, 112)
  1334.  
  1335.    ' MAKE AND PRINT IN THE INPUT SCREEN.
  1336.  
  1337.    MAKEWIND 15, "@*** Multi-field Input Demonstration ***", 1, 1, 80, 25, A%, 102
  1338.    NEWCOLOR 112
  1339.    PRINTW SPACE$(78), 21, 1
  1340.    PRINTW "-- Mouse selectable fields --", 21, 100
  1341.    NEWCOLOR A%
  1342.  
  1343. MAKEINPT:
  1344.    PRINTW "**** FIXED CHOICE FIELDS ****", 1, 48
  1345.    PRINTW "****** Press SPACE BAR ******.", 2, 48
  1346.    PRINTW "Decimal(0)     Decimal(1)     Decimal(2)", 2, 4
  1347.    PRINTW "Color...", 3, 48
  1348.    PRINTW "( Real number. Pad with zeros.)   Location.", 5, 15
  1349.    PRINTW "Alpha/num. Upper case     Alpha/num. Lower case       Alpha/numeric", 7, 4
  1350.    PRINTW "*** Auto-advance fields -- Cursor moves to the next field automatically ***", 10, 100
  1351.    PRINTW "(-- Restricted Input --)", 12, 14
  1352.    PRINTW "M or F:         Y or N:      SOC SECURITY #..   -  -", 13, 100
  1353.    PRINTW "* Auto-exit ( On change only ) and Auto-advance fields. (A,B ) *", 15, 100
  1354.    PRINTW "* Single field update on protected field C allows fast exit and return *", 16, 100
  1355.    PRINTW "A             +B             =C", 18, 20
  1356.    LINEW 20, 1
  1357.  
  1358.    FROMFLD% = 0                       ' update all fields on initial entry
  1359.    TOFLD% = 1                         ' start in field 1.
  1360.   
  1361.    DO                                 ' will do until F1 is pressed
  1362.        ' get multi-field input
  1363.       
  1364.       MULTINPT 1, TOFLD%, "", FROMFLD%, RKEY%, MRTRN$(), SF%
  1365.  
  1366.       ' mouse selected field 18 or 19
  1367.  
  1368.       IF SF% = 18 THEN RKEY% = 1   ' make F1=EXIT exit same as F1 pressed
  1369.       IF SF% = 19 THEN RKEY% = 10  ' make F10=HELP exit same as F10 pressed
  1370.  
  1371.       ' FROMFLD% = 15 or 16 if the cursor is leaving field 15 or 16 or
  1372.       ' if MULTINPT is exited with the cursor in either field.
  1373.  
  1374.       IF FROMFLD% = 15 OR FROMFLD% = 16 THEN
  1375.         ' add values of fields 15 and 16 and update field 17
  1376.  
  1377.          MRTRN$(17) = STR$(VAL(MRTRN$(15)) + VAL(MRTRN$(16)))
  1378.          IF MRTRN$(15) + MRTRN$(16) = "" THEN MRTRN$(17) = ""
  1379.          FROMFLD% = 17                         ' update 17 on entry
  1380.       END IF
  1381.  
  1382.       SELECT CASE RKEY%                         ' which key/feature exited???
  1383.          CASE 32, 100
  1384.  
  1385.           ' SPACE BAR pressed or MOUSE released in field
  1386.  
  1387.            SELECT CASE FROMFLD%                   ' Cursor is in
  1388.               CASE 5                            ' field 5
  1389.                                             
  1390.                 ' SPACE BAR pressed on --- MOUSE released in FIELD 5.
  1391.                 ' COLCHOICE$() is shared from module level.
  1392.                 ' change data in field 5.
  1393.  
  1394.                 IF TOFLD% = FROMFLD% THEN
  1395.                    COLCHOICE% = COLCHOICE% + 1
  1396.                    IF COLCHOICE% = 5 THEN COLCHOICE% = 1  ' past end
  1397.                    MRTRN$(5) = COLCHOICE$(COLCHOICE%)
  1398.                 END IF
  1399.                CASE 6
  1400.  
  1401.                 ' SPACE BAR pressed on --- MOUSE released in FIELD 6.
  1402.  
  1403.                 IF TOFLD% = FROMFLD% THEN
  1404.                   LOCHOICE% = LOCHOICE% + 1
  1405.                   IF LOCHOICE% = 5 THEN LOCHOICE% = 1     ' past end
  1406.                   MRTRN$(6) = LOCHOICE$(LOCHOICE%)
  1407.                 END IF
  1408.                CASE ELSE
  1409.  
  1410.                END SELECT
  1411.            CASE ELSE
  1412.       END SELECT
  1413.  
  1414.       IF RKEY% = 10 THEN GOSUB HELP    ' was F10 - go sub help
  1415.  
  1416.    LOOP UNTIL RKEY% = 1                ' was F1 or F1=EXIT was selected
  1417.    SETCUR (C&)                         ' restore cursor size/position
  1418.    RSTRWIND 15, 1                      ' restore area under input screen
  1419.    EXIT SUB
  1420.  
  1421. HELP:
  1422.    ' use choicewind for a HELP screen
  1423.  
  1424.    REDIM C$(1), T$(9)
  1425.    C$(1) = "OK"
  1426.    T$(1) = " Key(s):               Function:"
  1427.    T$(2) = " CTRL END/ CTRL HOME   Move to first or last field."
  1428.    T$(3) = " TAB/ SHIFT TAB        Move from field to field horizontally."
  1429.    T$(4) = " UP/ DOWN ARROW /ENTER Move from field to field. ( user defined order )"
  1430.    T$(5) = " BACKSPACE/ DELETE     Erase character to left of or under cursor."
  1431.    T$(6) = " LEFT/ RIGHT ARROW     Moves cursor from start to end of text."
  1432.    T$(7) = " INSERT                Toggle between insert and overstrike mode."
  1433.    T$(8) = " ESC/ CTRL E           Returns field to pre-edited state. / Erases field."
  1434.    T$(9) = " HOME/ END             Moves cursor to start or end of text."
  1435.    JUNK% = CHOICEWIND%("@***** Multi-field Input Instructions *****", T$(), C$(), 100, 100, 15, 0, 1, 112)
  1436. RETURN
  1437.  
  1438. END SUB
  1439.  
  1440. SUB MULTINPUTDEMO2
  1441.      RSTRINFO 0                               ' RESTORE AREA UNDER INFOLINE
  1442.      INFOLINE 0, 0, 0, 15
  1443.      C& = GETCUR&
  1444.  
  1445.      A% = COL%(23): IF A% = 15 THEN A% = 112  ' A%= COLOR -- B/W
  1446.      STATIC CHNGRTRN$(), ONSEARCH%, NOTFIRSTPASS%
  1447.      IF NOTFIRSTPASS% = 0 THEN
  1448.         REDIM CHNGRTRN$(11)                       ' FOR "CHANGE" MULTINPT
  1449.         CHNGRTRN$(3) = "[ ] Match Upper/Lowercase"
  1450.         CHNGRTRN$(4) = "[ ] Whole Word"
  1451.         CHNGRTRN$(5) = "(" + CHR$(4) + ") 1. Active Window"
  1452.         CHNGRTRN$(6) = "( ) 2. Current Module"
  1453.         CHNGRTRN$(7) = "( ) 3. All Modules"
  1454.         CHNGRTRN$(8) = "< Find and Verify >"
  1455.         CHNGRTRN$(9) = "< Change All >"
  1456.         CHNGRTRN$(10) = "< Cancel >"
  1457.         CHNGRTRN$(11) = "< Help >"
  1458.         ONSEARCH% = 5
  1459.         NOTFIRSTPASS% = 1
  1460.      END IF
  1461.  
  1462.      ' PRINT THE INPUT SCREEN IN WINDOW 15
  1463.  
  1464.      MAKEWIND 15, "@Multi-field Input.  Extensive use of fixed choice fields.", 1, 1, 80, 25, A%, 102
  1465.      MAKEWIND 0, "@ Change ", 6, 100, 59, 15, 112, 11
  1466.      LINEW 12, 1
  1467.  
  1468.      CALL BOXW(1, 14, 43, 3, 1)
  1469.      PRINTWHOT "Find What:", 2, 2, 1, 127
  1470.  
  1471.      CALL BOXW(4, 14, 43, 3, 1)
  1472.      PRINTWHOT "Change To:", 5, 2, 8, 127
  1473.  
  1474.      CALL BOXW(7, 32, 25, 5, 1)
  1475.      PRINTW " Search ", 7, 40
  1476.      TOFLD% = 1                   ' START IN FIELD ONE.
  1477.      FROMFLD% = 0                 ' UPDATE ALL FIELDS.
  1478.  
  1479. CHANGE:
  1480.      ' CURSOR TO FIELD 5 TO 7.  THIS IS THE "SEARCH" SCOPE
  1481.  
  1482.      IF TOFLD% > 4 AND TOFLD% < 8 THEN
  1483.          TOFLD% = ONSEARCH%
  1484.      END IF
  1485.  
  1486.      SELECT CASE TOFLD%                         ' PU INSTRUCTIONS IN A$
  1487.        CASE 1, 2                                ' ON ACTIVE (TOFLD%) FIELD.
  1488.          A$ = "Input data."
  1489.        CASE 3, 4
  1490.          A$ = "Press SPACE BAR to change."
  1491.        CASE 5, 6, 7
  1492.          A$ = "Press UP/DOWN arrow keys to change."
  1493.        CASE 8 TO 11
  1494.          A$ = "Press SPACE BAR/ENTER to select."
  1495.        CASE ELSE
  1496.          A$ = ""
  1497.      END SELECT
  1498.      A$ = A$ + " TAB = next field. ESC/ENTER exits."
  1499.  
  1500.      PRINTINFO " " + A$
  1501.  
  1502.      ' GET MULTIFIELD INPUT.  TOFLD% = THE ACTIVE FIELD ON ENTRY.  FROMFLD%
  1503.      ' REPRESENTS THE FIELD WHICH IS ACTIVE ON EXIT
  1504.  
  1505.      MULTINPT 3, TOFLD%, "U", FROMFLD%, RK%, CHNGRTRN$(), 0
  1506.  
  1507.      IF RK% = 50 THEN RK% = 100                  ' key character selection
  1508.      IF RK% = 300 THEN GOTO CHANGE               ' mouse release out of field
  1509.      IF RK% = 100 THEN FROMFLD% = TOFLD%
  1510.  
  1511.      IF FROMFLD% > 4 AND FROMFLD% < 8 THEN        ' Cursor from search window.
  1512.        IF RK% = 16 OR RK% = 19 OR RK% = 100 THEN  ' Was UP or DOWN arrow.
  1513.          IF RK% < 100 THEN
  1514.            IF TOFLD% = 4 THEN TOFLD% = 7          ' Keep cursor in the
  1515.            IF TOFLD% = 8 THEN TOFLD% = 5          ' search window.
  1516.          END IF
  1517.          MID$(CHNGRTRN$(ONSEARCH%), 2, 1) = " "   ' make it a blank
  1518.          FROMFLD% = ONSEARCH%                     ' blank this field
  1519.          ONSEARCH% = TOFLD%
  1520.          MID$(CHNGRTRN$(TOFLD%), 2, 1) = CHR$(4)  ' Only one choice is permitted.
  1521.         END IF
  1522.         IF RK% = 14 THEN TOFLD% = 4               ' Was SHIFT TAB
  1523.         IF RK% = 15 THEN TOFLD% = 8               ' Was TAB
  1524.      END IF
  1525.  
  1526.      SELECT CASE RK%
  1527.     
  1528.         ' RETURN CAUSED EXIT.
  1529.  
  1530.         CASE 13
  1531.           PICK$ = "ENTER"
  1532.           IF FROMFLD% >= 7 THEN PICK$ = CHNGRTRN$(FROMFLD%)
  1533.           GOTO PRINTRESULTS
  1534.  
  1535.         ' ESC CAUSED EXIT.
  1536.         CASE 27
  1537.           PICK$ = "ESC"
  1538.           GOTO PRINTRESULTS
  1539.  
  1540.         ' SPACE BAR CAUSED EXIT.
  1541.         CASE 32, 100
  1542.           IF FROMFLD% = 3 OR FROMFLD% = 4 THEN     ' EXITING FIELD 3 OR 4
  1543.              IF MID$(CHNGRTRN$(FROMFLD%), 2, 1) = " " THEN
  1544.                 X$ = "X"
  1545.              ELSE
  1546.                 X$ = " "
  1547.              END IF
  1548.              MID$(CHNGRTRN$(FROMFLD%), 2, 1) = X$
  1549.  
  1550.              'IF CHNGRTRN$(FROMFLD%) = "" THEN CHNGRTRN$(FROMFLD%) = "X" ELSE CHNGRTRN$(FROMFLD%) = ""
  1551.           ELSEIF FROMFLD% > 7 THEN              ' EXITING FIELD 8,9,10,11
  1552.              PICK$ = CHNGRTRN$(FROMFLD%)
  1553.              GOTO PRINTRESULTS
  1554.           ELSE                                  ' FIELD 5,6,7
  1555.           'NOTHING
  1556.           END IF
  1557.           
  1558.         CASE ELSE
  1559.      END SELECT
  1560.  
  1561.      GOTO CHANGE
  1562.  
  1563. PRINTRESULTS:
  1564.  
  1565.      ' PRINT THE RESULTS IN WINDOW 1.  GETANS WAITS FOR ANY KEY.
  1566.      REDIM T$(9)
  1567.      T$(1) = SPACE$(55)
  1568.      T$(2) = " Find What: = " + CHNGRTRN$(1)
  1569.      T$(3) = " Change To:  = " + CHNGRTRN$(2)
  1570.      IF MID$(CHNGRTRN$(3), 2, 1) = " " THEN S$ = "No" ELSE S$ = "Yes"
  1571.      T$(4) = " Match Upper/Lowercase = " + S$
  1572.      IF MID$(CHNGRTRN$(4), 2, 1) = " " THEN S$ = "No" ELSE S$ = "Yes"
  1573.      T$(5) = " Whole Word = " + S$
  1574.      SELECT CASE ONSEARCH%
  1575.        CASE 5
  1576.         S$ = "Active Window"
  1577.        CASE 6
  1578.         S$ = "Current Module"
  1579.        CASE ELSE
  1580.         S$ = "All Modules"
  1581.      END SELECT
  1582.      T$(7) = " Search Criteria = " + S$
  1583.      T$(9) = " Exit was via ...." + PICK$
  1584.      REDIM CHOICE$(1)
  1585.      CHOICE$(1) = "OK"
  1586.      PRINTINFO " Select OK to proceed..........."
  1587.  
  1588.     
  1589.      A% = CHOICEWIND%("@Results", T$(), CHOICE$(), 6, 11, 112, 112, 1, 111)
  1590.  
  1591.      SETCUR (C&)
  1592.  
  1593.      ' RESTORING WINDOW 15 RESTORES THE SCREEN TO IT'S
  1594.      ' STATE BEFORE THIS SUB WAS CALLED.
  1595.  
  1596.      RSTRWIND 15, 1
  1597.      INFOLINE 0, 0, 0, COL%(31)
  1598.  
  1599. END SUB
  1600.  
  1601. FUNCTION NEWSEL% (MAXSEL%, SEL%, RK%, MSEL%, RTRN$)
  1602.   SELECT CASE RK%
  1603.     CASE 16
  1604.       SEL% = SEL% - 1: IF SEL% < 0 THEN SEL% = MAXSEL% - 1
  1605.     CASE 19
  1606.       SEL% = SEL% + 1: IF SEL% = MAXSEL% THEN SEL% = 0
  1607.     CASE 100
  1608.       SEL% = MSEL%
  1609.   END SELECT
  1610.   RTRN$ = "( )"
  1611.   NEWSEL% = SEL%
  1612.  
  1613.  
  1614. END FUNCTION
  1615.  
  1616. SUB SCROLLDEMO (WASESC%)
  1617.  
  1618.    WASESC% = 0                                  ' WARNS CALLER ESC EXITED.
  1619.    A% = COL%(113): IF A% = 15 THEN A% = 112     ' BLUE/WHITE OR B/W
  1620.  
  1621.    ' MAKE A SCROLL WINDOW TO SELECT THE TYPE OF SCROLL WINDOW.
  1622.    CALL MAKEWIND(4, "", 5, 37, 38, 7, A%, 11)
  1623.  
  1624.    ' SAME INFO-LINE FOR ALL SELECTIONS.
  1625.    INFOFIXED " Pick a scroll window!  Press ESC to cancel...."
  1626.  
  1627.    IF A% = 112 THEN HATTR% = 127 ELSE HATTR% = 124
  1628.    SCROLLRTRN% = 1
  1629.    B4SCRL "ERM", "", 0, 0
  1630.    SCRLWIND SUBSCROLL$(), DUMMY$(), "", 5, "A", SCROLLRTRN%, 1, 1, RKEY%, HATTR%, 0, 0
  1631.    INFOFIXED ""
  1632.    RSTRWIND 4, 1                              ' RESTORE SCROLL WINDOW.
  1633.    IF RKEY% = 27 THEN WASESC% = 1: EXIT SUB   ' ESC
  1634.    RSTRWIND 2, 1                              ' RESTORE CONNECT SOFTWARE WIND.
  1635.    RSTRWIND 1, 1                              ' RESTORE MAIN INSTRUCT. WIND.
  1636.    RSTRPULL 1                                 ' RESTORE PULLDOWN WINDOW.
  1637.  
  1638.    SELECT CASE SCROLLRTRN%
  1639.      CASE 1                                   ' REGULAR SCROLL WINDOW PICKED
  1640.        OPT$ = "REGULAR SCROLL WINDOW"
  1641.      CASE 2                                   ' AUTO-EXIT  PICKED
  1642.        KIND$ = "A"
  1643.        OPT$ = "AUTO-EXIT SCROLL WINDOW"
  1644.      CASE 3                                   ' MARK PICKED
  1645.        KIND$ = "M": MARK% = 1
  1646.        OPT$ = "MARK SCROLL WINDOW"
  1647.      CASE 4, 5                                ' VIRTUAL OR LIST PICKED
  1648.        'title for virtual scroll windows
  1649.        TL$ = "NAME                    ADDRESS               CITY          ST.   ZIP"
  1650.        IF SCROLLRTRN% = 4 THEN TYP$ = "" ELSE TYP$ = "L"
  1651.      CASE ELSE
  1652.    END SELECT
  1653.  
  1654.    ' MAKE THE SCROLL WINDOW PICKED.
  1655.    A% = COL(23)
  1656.    IF A% = 15 THEN HIATTR% = 15 ELSE HIATTR% = 31
  1657.  
  1658.    MAKEWIND 2, "@" + OPT$, 3, 100, 47, 14, A%, 111
  1659.  
  1660.    RTRN% = 0
  1661.    IF A% = 15 THEN NEWCOLOR 7
  1662.  
  1663.    IF SCROLLRTRN% = 4 OR SCROLLRTRN% = 5 THEN
  1664.         ' VIRTUAL OR LIST SCROLL WINDOW
  1665.         INFOFIXED " LOOK!  You may scroll UP, DOWN, LEFT and RIGHT."
  1666.         IF SCROLLRTRN% = 4 THEN EX$ = "MC"
  1667.         B4SCRL EX$, "", 0, 0
  1668.         SCRLWIND ADDRESS$(), DUMMY$(), TL$, 10, TYP$, RTRN%, 1, 1, RKEY%, 0, 1, 1
  1669.    ELSE
  1670.        ' ALL OTHER SCROLL WINDOWS.  KIND$ DEFINES THE TYPE.
  1671.        INFOFIXED " Demonstration: " + OPT$ + ". Instuctions are in the scroll window!"
  1672.        RTRN% = 1
  1673.        B4SCRL "MC", "", 0, 0
  1674.        SCRLWIND SCROLL$(), DUMMY$(), "", 14, KIND$, RTRN%, 1, 1, RKEY%, HIATTR%, 1, 2
  1675.    END IF
  1676.    INFOFIXED ""
  1677.  
  1678.    IF RKEY% = 27 OR SCROLLRTRN% = 5 THEN GOTO DONESCROLL              ' ESC
  1679.  
  1680.    IF MARK% = 1 THEN                             ' WAS A MARK SCROLL WINDOW
  1681.       TR% = 100: TITLE$ = "@** THE MARKED ITEM(S) WERE: **"
  1682.       RSTRWIND 2, 1
  1683.    ELSE                                          ' ALL EXCEPT MARK.
  1684.       TR% = 14: TITLE$ = "@** The item selected was: **"
  1685.    END IF
  1686.  
  1687.    ' PRINT RESULTS
  1688.    REDIM TEXT$(3)
  1689.    REDIM CHOICE$(1): CHOICE$(1) = "OK"
  1690.  
  1691.    IF MARK% = 1 THEN                      ' PRINT "MARKED" SELECTIONS
  1692.       IF KIND$ = "" THEN
  1693.          TEXT$(2) = "@NO ITEMS WERE MARKED"
  1694.       ELSE
  1695.          M% = 0
  1696.          FOR X% = 1 TO LEN(KIND$)
  1697.            IF MID$(KIND$, X%, 1) <> " " THEN M% = M% + 1
  1698.          NEXT
  1699.          REDIM TEXT$(M%)
  1700.          START% = 1                    ' START SEARCH AT POSITION 1
  1701.          M% = 0
  1702.          DO
  1703.            B% = MARKED%(KIND$, START%)    ' B%= MARKED ITEM # IN SCROLL$()
  1704.            IF B% <> 0 THEN
  1705.               M% = M% + 1
  1706.               S$ = SCROLL$(B%): GOSUB NEWSTR
  1707.               TEXT$(M%) = " " + S$
  1708.            ELSE
  1709.               EXIT DO
  1710.            END IF
  1711.          LOOP
  1712.       END IF
  1713.    ELSE
  1714.       S$ = SCROLL$(RTRN%): GOSUB NEWSTR: TEXT$(2) = "@" + S$
  1715.       IF SCROLLRTRN% = 4 THEN TEXT$(2) = "@" + RTRIM$(LEFT$(ADDRESS$(RTRN%), 22)) + "...."
  1716.    END IF
  1717.    IF A% = 23 THEN A% = 31
  1718.    
  1719.    PRINTINFO " Click on OK or press ENTER, SPACEBAR, or ESC to proceed....."
  1720.    JUNK% = CHOICEWIND%(TITLE$, TEXT$(), CHOICE$(), TR%, 100, A%, 0, 1, 111)
  1721.  
  1722. DONESCROLL:
  1723.    RSTRWIND 2, 1
  1724.    EXIT SUB
  1725.  
  1726. NEWSTR:
  1727.    SA% = INSTR(S$, "@")
  1728.    IF SA% THEN S$ = LEFT$(S$, SA% - 1) + MID$(S$, SA% + 1)
  1729. RETURN
  1730.  
  1731. END SUB
  1732.  
  1733. SUB WINDOWDEMO
  1734.  
  1735.   PRINTINFO " Press the UP or DOWN arrow keys.  Press ESC to exit....."
  1736.   A% = COL%(79)                    ' RED/GRAY OR B/W
  1737.  
  1738.   ' MAKE INSTRUCTION WINDOW
  1739.   MAKEWIND 20, "@*** Window Demonstration Instructions ***", 2, 100, 72, 8, A%, 111
  1740.   PRINTW "Window memory is dynamically allocated and returned to BASIC when a", 1, 3
  1741.   PRINTW "window is restored.   Up to 20 windows may be stacked and restored.", 2, 3
  1742.   PRINTW "Window memory is outside of BASIC's normal 64K storage area.", 3, 3
  1743.   PRINTW "( NOTE: This is window number 20 )", 4, 100
  1744.  
  1745.   RANDOMIZE TIMER             ' RESET RANDOM SEED
  1746.   WIND% = 0                   ' WINDOW COUNTER
  1747.  
  1748. GETMAKE:
  1749.   TR% = INT(11 * RND + 11)               ' GET RANDOM VALUE FOR TOP ROW
  1750.   LC% = INT(60 * RND + 3)                ' GET RANDOM VALUE FOR LEFT COLUMN
  1751.   NR% = INT((25 - TR% - 3) * RND + 3)    ' GET RANDOM VALUE FOR NUMBER ROWS
  1752.   WI% = INT((80 - LC% - 16) * RND + 16)  ' GET RANDOM VALUE FOR WIDTH
  1753.   BO% = INT((2) * RND + 100) + 1         ' GET RANDOM VALUE FOR BORDER
  1754.   
  1755.   ' WAIT FOR ARROW KEY, ESC, OR MOUSE MOVEMENT WITH FUNTION GETKEY.
  1756.  
  1757.   DO
  1758.   k% = GETAKEY%
  1759.   LOOP WHILE k% = 0
  1760.   SELECT CASE k%
  1761.     CASE 27                              ' ESC
  1762.       FOR XX% = 19 TO 1 STEP -1
  1763.          RSTRWIND XX%, 1                 ' RESTORE ALL WINDOWS.
  1764.       NEXT
  1765.       RSTRWIND 20, 1
  1766.       EXIT SUB                           ' EXIT
  1767.  
  1768.     CASE 18432                           ' UP ARROW - MAKE WINDOWS
  1769.       IF WIND% < 19 THEN
  1770.         WIND% = WIND% + 1                ' INCREMENT COUNTER
  1771.         A% = WIND% * 16: IF A% = 128 OR A% = 256 THEN A% = 135  ' SET COLORS
  1772.         IF A% > 127 THEN A% = A% - 128                          '
  1773.         A% = COL(A%)                                            '
  1774.         IF A% = 15 THEN IF WIND% / 2 <> INT(WIND% / 2) THEN A% = 112  ' B/W
  1775.         IF NR% < 8 OR BO% = 100 THEN BO% = BO% - 100            ' BORDER
  1776.         MAKEWIND WIND%, "@Demo Window" + STR$(WIND%), TR%, LC%, WI%, NR%, A%, BO%
  1777.       ELSE
  1778.         DOSOUND
  1779.       END IF
  1780.  
  1781.     CASE 20480                          ' DOWN ARROW RESTORE WINDOWS.
  1782.       IF WIND% > 0 THEN
  1783.         RSTRWIND WIND%, 1
  1784.         WIND% = WIND% - 1               ' DECREMENT COUNTER
  1785.       ELSE
  1786.          DOSOUND
  1787.       END IF
  1788.     CASE ELSE
  1789.   END SELECT
  1790.   GOTO GETMAKE
  1791.  
  1792. END SUB
  1793.  
  1794.