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