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