home *** CD-ROM | disk | FTP | other *** search
/ CD Actual 14 / CDACTUAL.iso / cdactual / demobin / share / program / Basic / QWINDO.ZIP / QWDEMO.BAS < prev    next >
Encoding:
BASIC Source File  |  1990-01-01  |  55.4 KB  |  1,089 lines
  1. '============================================================================
  2. '         QUICKWINDOWS Demonstration/Tutorial Program Version 2.1
  3. '                     Modified for QuickBASIC 4.x
  4. '                  Entire contents Copyright 1989/1990 by
  5. '                      Software Interphase, Inc.
  6. '============================================================================
  7. '
  8. '  This demonstration program will give you a general idea on how to use
  9. '  most of the QuickWindows functions. Note that this demo works only with
  10. '  QuickBASIC 4.5.
  11. '
  12. DECLARE SUB swclear () : DECLARE SUB swcattr () : DECLARE SUB swbuttonget ()
  13. DECLARE SUB swattr () : DECLARE SUB srevscrn () : DECLARE SUB sputscrn ()
  14. DECLARE SUB sputch () : DECLARE SUB sgetscrn () : DECLARE SUB sgetch ()
  15. DECLARE SUB sdmascrn () : DECLARE SUB sbox8set () : DECLARE SUB sattrscrn ()
  16. DECLARE SUB swdelrow () : DECLARE SUB swcsrpos () : DECLARE SUB swcsron ()
  17. DECLARE SUB swcsroff () : DECLARE SUB swcopystr () : DECLARE SUB swcolor ()
  18. DECLARE SUB swcls () : DECLARE SUB swcloseall () : DECLARE SUB swclose ()
  19. DECLARE SUB swhint () : DECLARE SUB swinput () : DECLARE SUB swsetcsr ()
  20. DECLARE SUB swselect () : DECLARE SUB swrevline () : DECLARE SUB swrev ()
  21. DECLARE SUB swrattr () : DECLARE SUB swprint () : DECLARE SUB swopen ()
  22. DECLARE SUB swlocate () : DECLARE SUB swlint () : DECLARE SUB swinsrow ()
  23. DECLARE SUB swvscroll () : DECLARE SUB smsetpos () : DECLARE SUB swmouse ()
  24. DECLARE SUB smouse () : DECLARE SUB smhide () : DECLARE SUB smshow ()
  25. DECLARE SUB sminit () : DECLARE SUB swwrap () : DECLARE SUB smsety ()
  26. DECLARE SUB smsetx () : DECLARE SUB smbrel () : DECLARE SUB smbpress ()
  27. DECLARE SUB smpenoff () : DECLARE SUB smpenon () : DECLARE SUB smratio ()
  28. DECLARE SUB smenuon () : DECLARE SUB smenuoff () : DECLARE SUB smenubar ()
  29. DECLARE SUB smenuset () : DECLARE SUB smenuoption () : DECLARE SUB spopmenu ()
  30. DECLARE SUB spopmenuh () : DECLARE SUB spopmenu1 () : DECLARE SUB prompt ()
  31. DECLARE SUB savescrn () : DECLARE SUB restorescrn () : DECLARE SUB shelpmenu ()
  32. DECLARE SUB spopmenuv ()
  33.  
  34. DEFINT A-Z
  35. COMMON SHARED accept$(), menu$(), function$(), bar$(), text$()
  36. COMMON SHARED x(), y(), l(), edits(), scrn(), kb(), cattr()
  37. COMMON SHARED s1(), s2(), s3(), s4(), s5(), s6(), s8(), s9()
  38. COMMON SHARED s10(), s11(), sc1(), mouse.status
  39. REM $DYNAMIC
  40. DIM SHARED accept$(10), menu$(101), function$(100), bar$(10), text$(30)
  41. DIM SHARED x(10), y(10), l(10), edits(10), scrn(2100), kb(10), cattr(10)
  42. DIM SHARED s1(400), s2(400), s3(300), s4(400), s5(1700), s6(1100), s8(1000)
  43. DIM SHARED s9(700), s10(500), s11(1800), sc1(300)
  44. CALL QWINIT(4)
  45. CALL WCLOSEALL: CALL MINIT(mouse.status, num.buttons): num.functions = 63
  46. blue = 1: CALL TSTMONO(mono%)
  47. IF mono% = 1 THEN blue = 2: 'If monochrome card, offset blue color by 1
  48.                 '(to get rid of underlining)
  49. COLOR 15, 1, 1: CLS : RESTORE TITLE: READ n, x1, y1, x2, y2
  50. FOR i = 0 TO n - 1: READ s5(i): NEXT i
  51. CALL BOX(x1 + 1, y1 + 1, x2 + 1, y2 + 1, 2, 0, "")
  52. CALL PUTSCRN(x1, y1, x2, y2, s5())
  53. LOCATE y2 + 3, 1
  54. PRINT "  Feel free to share the QuickWindows library with anyone.  This library"
  55. PRINT "  is the most comprehensive windowing library ever released for shareware"
  56. PRINT "  for Microsoft QuickBASIC (3.x, 4.x) and BASIC (6.0, 7.0) compilers."
  57. PRINT "  Use any of the source code in this demo program in your own programs."
  58. PRINT "  The demo source code gives you some helpful hints when using the"
  59. PRINT "  QuickWindows Library.  If you are interested in a more advanced version"
  60. PRINT "  of QuickWindows, ask us about QuickWindows Advanced and Designer QW."
  61. PRINT
  62. PRINT "  QuickWindows is a trademark of Software Interphase, Inc.  The QuickWindows"
  63. PRINT "  Library is copyrighted 1987-1990 by Software Interphase, Inc.";
  64. COLOR 7, 1, 1: LOCATE 25, 25: PRINT "--- Press ENTER to continue ---";
  65. WHILE INKEY$ <> CHR$(13): WEND: COLOR 15, 1, 1: CLS
  66. PRINT "  QuickWindows is a full-featured, text window management library for Microsoft"
  67. PRINT "  QuickBASIC and BASIC compilers.  Over 60 functions give you the ability to"
  68. PRINT "  create windows, pop-up and pull-down menus, and interface to a Microsoft"
  69. PRINT "  compatible mouse. ": PRINT : COLOR 11, 1, 1
  70. PRINT "   *  Saves you hours of valuable programming time": PRINT
  71. PRINT "   *  Fast!  Written entirely in assembly language": PRINT
  72. PRINT "   *  Efficient!  Uses less than 24K of object code": PRINT
  73. PRINT "   *  Easy to use!  High level interface provides you with"
  74. PRINT "      simple commands to open and write to a window": PRINT
  75. PRINT "   *  Automatically detects both the CGA and MGA cards, or"
  76. PRINT "      EGA cards emulating the CGA/MGA text modes": PRINT : COLOR 15, 1, 1
  77. PRINT "  Comes complete with the library of over 60 functions, a fully-documented"
  78. PRINT "  manual, many programming examples, and the source code to this demo to"
  79. PRINT "  show you how to use QuickWindows.  Support the author and register"
  80. PRINT "  your copy of QuickWindows today.": PRINT : COLOR 14, 1, 1
  81. PRINT "  A registration form will appear when you QUIT the QuickWindows demo."
  82. COLOR 7, 1, 1: LOCATE 25, 25: PRINT "--- Press ENTER to continue ---";
  83. WHILE INKEY$ <> CHR$(13): WEND: COLOR 15, 1, 1: CLS
  84.  
  85.  
  86. demo:
  87. COLOR 7, 1, 1: CLS : RESTORE FUNCTION.LIST
  88. FOR i = 0 TO num.functions - 1: READ function$(i): NEXT i
  89. CALL BOX8SET(223, 223, 223, 0, 0, 0, 0, 0, 0, 0, 0, 0): y = 2: func = 0
  90. CALL BOX(2, 2 + y, 38, 10 + y, 1, 0, "")
  91. CALL WOPEN(1, 1 + y, 37, 9 + y, 8, &H3C, "FUNCTION", s1(), 1)
  92. CALL BOX(43, 2 + y, 80, 10 + y, 1, 0, "")
  93. CALL WOPEN(42, 1 + y, 79, 9 + y, 8, &H3C, "OUTPUT", s2(), 2)
  94. CALL BOX(2, 13 + y, 80, 15 + y, 1, 0, "")
  95. CALL WOPEN(1, 12 + y, 79, 14 + y, 8, &H4C, "SYNTAX", s3(), 3)
  96. CALL BOX(2, 18 + y, 80, 22 + y, 1, 0, "")
  97. CALL WOPEN(1, 17 + y, 79, 21 + y, 8, &H74, "", s4(), 4)
  98. CALL WCOLOR(4, &H70): CALL WCLS(4)
  99. CALL WPRINT(4, "  QuickWindows Demo and~    Tutorial Program~      Version 2.0")
  100. CALL WCOLOR(3, &H4E): CALL WCLS(3)
  101. CALL WPRINT(3, "All function syntax will be displayed in this window.")
  102. CALL WCOLOR(2, &H3B): CALL WCLS(2)
  103. CALL WPRINT(2, "~ Any output or demonstrations will~ appear in this window or use")
  104. CALL WPRINT(2, "~ the entire screen")
  105. CALL WCOLOR(1, &H3B): CALL WCLS(1)
  106. CALL WPRINT(1, "~Function definitions are shown here")
  107. GOSUB BUTTONSET: focus = 1: GOTO MAIN
  108.  
  109. FUNCTION.LIST:
  110. DATA ATTRSCRN,BOX,BOX8SET,DMASCRN,GETCH,GETSCRN,PUTCH,PUTSCRN,REVSCRN,VSCROLL
  111. DATA WATTR,WBOX,WBUTTONGET,WBUTTONSET,WCATTR,WCLEAR,WCLOSE,WCLOSEALL,WCLS
  112. DATA WCOLOR,WCOPYSTR,WCSROFF,WCSRON,WCSRPOS,WDELROW,WHINT,WINPUT,WINSROW
  113. DATA WLINT,WLOCATE,WOPEN,WPRINT,WRATTR,WREV,WREVLINE,WSELECT,WSETCSR
  114. DATA WVSCROLL,WWRAP
  115. DATA MINIT,MSHOW,MHIDE,MOUSE,WMOUSE,MSETPOS,MBPRESS,MBREL,MSETX,MSETY,MRATIO
  116. DATA MPENON,MPENOFF
  117. DATA MENUBAR,MENUGET,MENUOFF,MENUON,MENUOPTION,MENUSET,POPMENU,POPMENU1
  118. DATA POPMENUH,POPMENUV,HELPMENU
  119.  
  120. BUTTONSET:
  121. '****************************************************************************
  122. ' Define command input buttons.  Also resets any highlighting of buttons
  123. ' on every subsequent calls here.
  124. '
  125. CALL MHIDE: 'Turn off mouse cause there will be a screen write
  126. CALL WBUTTONSET(4, 1, 15104, 0, &H78 + blue, 2, &H70 + blue, 28, 0, "F1-Proceed"): 'Define button 1
  127. CALL WBUTTONSET(4, 2, 15360, 0, &H78 + blue, 2, &H70 + blue, 45, 0, "F2-Select"): 'Define button 2
  128. CALL WBUTTONSET(4, 3, 15616, 0, &H78 + blue, 2, &H70 + blue, 61, 0, "F3-Quit"): 'Define button 3
  129. RETURN
  130.  
  131.  
  132. NOMOUSE:
  133. CALL WPRINT(2, "~  Cannot continue with the~  demonstration because there is")
  134. CALL WPRINT(2, "~  no mouse installed on this~  system."): GOTO MAIN
  135.  
  136.  
  137. MAIN:
  138. CALL WBUTTONGET(focus, 1, 3, result)
  139. IF focus < 1 THEN focus = 3 ELSE IF focus > 3 THEN focus = 1
  140. IF result = 0 THEN GOTO MAIN ELSE GOSUB BUTTONSET: CALL MHIDE
  141. IF result = 1 THEN
  142.   func = func + 1
  143.   IF func > num.functions THEN GOTO ORDERFRM
  144.   GOTO MAIN1
  145. ELSEIF result = 2 THEN
  146.   CALL WOPEN(4, 2, 76, 23, 2, &H74, "", s5(), 5)
  147.   CALL WLOCATE(5, 3, 17)
  148.   CALL WPRINT(5, "Keyboard:  Use arrows to highlight Function and press ENTER")
  149.   CALL WPRINT(5, "~   Mouse:  Move mouse cursor on top of Function and press left button")
  150.   CALL WOPEN(7, 4, 73, 18, 1, &H74, "", s6(), 6)
  151.   CALL WCOLOR(6, &H70 + blue): CALL WCLS(6): i = func: IF i = 0 THEN i = 1
  152.   CALL POPMENUH(6, i - 1, 13, num.functions, &H75, VARPTR(function$(0)), result, flag)
  153.   CALL MHIDE: CALL WCLOSE(6): CALL WCLOSE(5): IF flag <> 1 THEN GOTO MAIN
  154.   func = result + 1: GOTO MAIN1
  155. ELSEIF result = 3 THEN
  156.   GOTO ORDERFRM
  157. END IF
  158. GOTO MAIN
  159.  
  160. ORDERFRM:
  161.   COLOR 7, 1, 1: CLS
  162.   PRINT TAB(24); "QUICKWINDOWS REGISTRATION FORM": PRINT
  163.   PRINT "     Use this handy form to register your copy of QuickWindows today."
  164.   PRINT "  Registration entitles you to receive a full printed manual and"
  165.   PRINT "  technical support.  Your support will go a long way to helping us"
  166.   PRINT "  provide you with better service.  The assembly source is also available."
  167.   PRINT ""
  168.   PRINT "  ___  1. Software Registration only (no printed manual) ........... $35"
  169.   PRINT "  ___  2. Software Registration with printed manual ................ $50"
  170.   PRINT "  ___  3. Software Registration with source code and manual ........ $75"
  171.   PRINT "  ___  4. Send me info on your QuickWindows Advanced and Designer QW packages."
  172.   PRINT "  ___  5. Send me info on your full-featured QuickComm Communications Library."
  173.   PRINT ""
  174.   PRINT "  Press SHIFT+PRTSC to send this form to your printer."
  175.   PRINT : PRINT STRING$(80, "="): PRINT
  176.   PRINT "  Company Name ____________________________"
  177.   PRINT "  Name ____________________________________         Mail Check/MO to:"
  178.   PRINT "  Address _________________________________"
  179.   PRINT "  City, State, Zip ________________________         Software Interphase, Inc."
  180.   PRINT "  Telephone _______________________________         5 Bradley Street, Suite 4A"
  181.   PRINT "  QuickBASIC/BASCOM version _______________         Providence, RI 02908-2304"
  182.   WHILE INKEY$ = "": WEND
  183.   END
  184.  
  185.  
  186. MAIN1:
  187. 'i! = FRE(""): LOCATE 25, 1: PRINT "Free string space: "; i!; : 'monitors free string space
  188. CALL WCLS(1): CALL WCLS(2): CALL WCLS(3): LOCATE 1, 1: 'Home physical cursor out of the way (if it's on)
  189.  
  190. IF func = 1 THEN CALL sattrscrn
  191. IF func = 2 THEN GOTO sbox
  192. IF func = 3 THEN CALL sbox8set
  193. IF func = 4 THEN CALL sdmascrn
  194. IF func = 5 THEN CALL sgetch
  195. IF func = 6 THEN CALL sgetscrn
  196. IF func = 7 THEN CALL sputch
  197. IF func = 8 THEN CALL sputscrn
  198. IF func = 9 THEN CALL srevscrn
  199. IF func = 10 THEN GOTO svscroll
  200. IF func = 11 THEN CALL swattr
  201. IF func = 12 THEN GOTO swbox
  202. IF func = 13 THEN CALL swbuttonget
  203. IF func = 14 THEN GOTO swbuttonset
  204. IF func = 15 THEN CALL swcattr
  205. IF func = 16 THEN CALL swclear
  206. IF func = 17 THEN CALL swclose
  207. IF func = 18 THEN CALL swcloseall
  208. IF func = 19 THEN CALL swcls
  209. IF func = 20 THEN CALL swcolor
  210. IF func = 21 THEN CALL swcopystr
  211. IF func = 22 THEN CALL swcsroff
  212. IF func = 23 THEN CALL swcsron
  213. IF func = 24 THEN CALL swcsrpos
  214. IF func = 25 THEN CALL swdelrow
  215. IF func = 26 THEN CALL swhint
  216. IF func = 27 THEN GOTO swinput
  217. IF func = 28 THEN CALL swinsrow
  218. IF func = 29 THEN CALL swlint
  219. IF func = 30 THEN CALL swlocate
  220. IF func = 31 THEN CALL swopen
  221. IF func = 32 THEN CALL swprint
  222. IF func = 33 THEN CALL swrattr
  223. IF func = 34 THEN CALL swrev
  224. IF func = 35 THEN CALL swrevline
  225. IF func = 36 THEN CALL swselect
  226. IF func = 37 THEN CALL swsetcsr
  227. IF func = 38 THEN CALL swvscroll
  228. IF func = 39 THEN CALL swwrap
  229. IF func = 40 THEN CALL sminit
  230. IF func = 41 THEN CALL smshow
  231. IF func = 42 THEN CALL smhide
  232. IF func = 43 THEN CALL smouse
  233. IF func = 44 THEN CALL swmouse
  234. IF func = 45 THEN CALL smsetpos
  235. IF func = 46 THEN CALL smbpress
  236. IF func = 47 THEN CALL smbrel
  237. IF func = 48 THEN CALL smsetx
  238. IF func = 49 THEN CALL smsety
  239. IF func = 50 THEN CALL smratio
  240. IF func = 51 THEN CALL smpenon
  241. IF func = 52 THEN CALL smpenoff
  242. IF ((func > 39) AND (func < 53) AND (mouse.status = 0)) THEN GOTO NOMOUSE
  243. IF func = 53 THEN CALL smenubar
  244. IF func = 54 THEN GOTO smenuget
  245. IF func = 55 THEN CALL smenuoff
  246. IF func = 56 THEN CALL smenuon
  247. IF func = 57 THEN CALL smenuoption
  248. IF func = 58 THEN CALL smenuset
  249. IF func = 59 THEN CALL spopmenu
  250. IF func = 60 THEN CALL spopmenu1
  251. IF func = 61 THEN CALL spopmenuh
  252. IF func = 62 THEN CALL spopmenuv
  253. IF func = 63 THEN CALL shelpmenu
  254. GOTO MAIN
  255.  
  256.  
  257. TITLE:
  258. DATA 936,2,1,79,12   : 'number of elements, (x1,y1)-(x2-y2)
  259. DATA 14368,14368,14368,14368,14368,14368,14368,14368,14368,14368,14368,14368,14368
  260. DATA 14368,14368,14368,14368,14368,14368,14368,14368,14368,14368,14368,14368,14368
  261. DATA 14368,14368,14368,14368,14368,14368,14368,14368,14368,14368,14368,14368,14368
  262. DATA 14368,14368,14368,14368,14368,14368,14368,14368,14368,14368,14368,14368,14368
  263. DATA 14368,14368,14368,14368,14368,14368,14368,14368,14368,14368,14368,14368,14368
  264. DATA 14368,14368,14368,14368,14368,14368,14368,14368,14368,14368,14368,14368,14368
  265. DATA 14368,14368,16091,16091,16091,16091,16091,14368,14368,16091,14368,14368,14368
  266. DATA 16091,14368,14368,16091,14368,14368,16091,16091,16091,16091,16091,14368,14368
  267. DATA 16091,14368,14368,14368,16091,14368,14368,16091,14368,14368,14368,16091,14368
  268. DATA 14368,16091,14368,14368,16091,16091,16091,16091,16091,14368,14368,16091,16091
  269. DATA 16091,16091,14368,14368,14368,16091,16091,16091,16091,16091,14368,14368,16091
  270. DATA 14368,14368,14368,16091,14368,14368,16091,16091,16091,16091,16091,14368,14368
  271. DATA 14368,14368,16091,14368,14368,14368,16091,14368,14368,16091,14368,14368,14368
  272. DATA 16091,14368,14368,16091,14368,14368,16091,14368,14368,14368,14368,14368,14368
  273. DATA 16091,14368,16092,16095,14368,14368,14368,16091,14368,14368,14368,16091,14368
  274. DATA 14368,16091,14368,14368,16091,14368,15904,14368,16091,14368,14368,16091,14368
  275. DATA 14368,14368,16091,14368,14368,16091,14368,14368,14368,16091,14368,14368,16091
  276. DATA 14368,14368,14368,16091,14368,14368,16091,14368,14368,14368,14368,14368,14368
  277. DATA 14368,14368,16091,14368,14368,14368,16091,14368,14368,16091,14368,14368,14368
  278. DATA 16091,14368,14368,16091,14368,14368,16091,14368,14368,14368,14368,14368,14368
  279. DATA 16091,16091,14368,14368,14368,14368,14368,16091,14368,14368,14368,16091,14368
  280. DATA 14368,16091,14368,14368,16091,14368,15904,14368,16091,14368,14368,16091,14368
  281. DATA 14368,14368,16091,14368,14368,16091,14368,14368,14368,16091,14368,14368,16091
  282. DATA 14368,14368,14368,16091,14368,14368,16091,16091,16091,16091,16091,14368,14368
  283. DATA 14368,14368,16091,14368,14368,16092,16091,14368,14368,16091,14368,14368,14368
  284. DATA 16091,14368,14368,16091,14368,14368,16091,14368,14368,14368,14368,14368,14368
  285. DATA 16091,14368,16095,16092,14368,14368,14368,16091,14368,16091,14368,16091,14368
  286. DATA 14368,16091,14368,14368,16091,14368,15904,15904,16091,14368,14368,16091,14368
  287. DATA 14368,14368,16091,14368,14368,16091,14368,14368,14368,16091,14368,14368,16091
  288. DATA 14368,16091,14368,16091,14368,14368,14368,14368,14368,14368,16091,14368,14368
  289. DATA 14368,14368,16091,16091,16091,16091,16091,14368,14368,16091,16091,16091,16091
  290. DATA 16091,14368,14368,16091,14368,14368,16091,16091,16091,16091,16091,14368,14368
  291. DATA 16091,14368,14368,14368,16091,14368,14368,16091,16091,16091,16091,16091,14368
  292. DATA 14368,16091,14368,14368,16091,14368,14368,14368,16091,14368,14368,16091,16091
  293. DATA 16091,16091,14368,14368,14368,16091,16091,16091,16091,16091,14368,14368,16091
  294. DATA 16091,16091,16091,16091,14368,14368,16091,16091,16091,16091,16091,14368,14368
  295. DATA 14368,14368,14368,14368,14368,14368,14368,14368,14368,14368,14368,14368,14368
  296. DATA 14368,14368,14368,14368,14368,14368,14368,14368,14368,14368,14368,14368,14368
  297. DATA 14368,14368,14368,14368,14368,14368,14368,14368,14368,14368,14368,14368,14368
  298. DATA 14368,14368,14368,14368,14368,14368,14368,14368,14368,14368,14368,14368,14368
  299. DATA 14368,14368,14368,14368,14368,14368,14368,14368,14368,14368,14368,14368,14368
  300. DATA 14368,14368,14368,14368,14368,14368,14368,14368,14368,14368,14368,14368,14368
  301. DATA 14368,14368,14368,14368,14368,14368,14368,14368,14368,14368,14368,14368,14368
  302. DATA 14368,14368,14368,14368,14368,14368,14368,14368,14368,14368,14368,14368,14368
  303. DATA 14368,14368,14368,14368,14368,14368,14368,14368,14368,14368,14368,14368,14368
  304. DATA 14368,14368,14368,14368,14368,14368,14368,14368,14368,14368,14368,14368,14368
  305. DATA 14368,14368,14368,14368,14368,14368,14368,14368,14368,14368,14368,14368,14368
  306. DATA 14368,14368,14368,14368,14368,14368,14368,14368,14368,14368,14368,14368,14368
  307. DATA 14368,14368,14368,14368,14368,14368,14368,14368,14368,14368,14368,14368,14368
  308. DATA 14368,14368,14368,14368,15191,15136,15177,15136,15182,15136,15172,15136,15183
  309. DATA 15136,15191,15136,15136,15136,15181,15136,15169,15136,15182,15136,15169,15136
  310. DATA 15175,15136,15173,15136,15181,15136,15173,15136,15182,15136,15188,15136,15136
  311. DATA 15136,15180,15136,15177,15136,15170,15136,15186,15136,15169,15136,15186,15136
  312. DATA 15193,14368,14368,14368,14368,14368,14368,14368,14368,14368,14368,14368,14368
  313. DATA 14368,14368,14368,14368,14368,14368,14368,14368,14368,14368,14368,14368,14368
  314. DATA 14368,14368,14368,14368,14368,14368,14368,14368,14368,14368,14368,14368,14368
  315. DATA 14368,14368,14368,14368,14368,14368,14368,14368,14368,14368,14368,14368,14368
  316. DATA 14368,14368,14368,14368,14368,14368,14368,14368,14368,14368,14368,14368,14368
  317. DATA 14368,14368,14368,14368,14368,14368,14368,14368,14368,14368,14368,14368,14368
  318. DATA 14368,14368,14368,14368,14368,14368,14368,14368,14368,14368,14368,14368,14368
  319. DATA 14368,14368,14368,14368,14368,14368,14368,14368,14368,14368,14368,14368,14368
  320. DATA 14368,14368,14368,14368,14368,14368,14368,14368,14368,14368,14368,14368,14368
  321. DATA 14368,14368,14368,14368,14368,14368,15174,15136,15183,15136,15186,15136,15136
  322. DATA 15136,15170,15136,15169,15136,15187,15136,15177,15136,15171,14368,14368,14368
  323. DATA 14368,14368,14368,14368,14368,14368,14368,14368,14368,14368,14368,14368,14368
  324. DATA 14368,14368,14368,14368,14368,14368,14368,14368,14368,14368,14368,14368,14368
  325. DATA 14368,14368,14368,14368,14368,14368,14368,14368,14368,14368,14368,14368,14368
  326. DATA 14368,14368,14368,14368,14368,14368,14368,14368,14368,14368,14368,14368,14368
  327. DATA 14368,14368,14368,14368,14368,14368,14368,14368,14368,14368,14368,14368,14368
  328. DATA 14368,14368,14368,14368,14368,14368,14368,14368,14368,14368,14368,14368,14368
  329. DATA 14368,14368,14368,14368,14368,14368,14368,14368,14368,14368,14368,14368,14368
  330. DATA 14368,14368,14368,14368,14368,14368,14368,14368,14368,14368,14368,14368,14368
  331. DATA 0,0,0,0,0,0,0,0,0,0,0,0,0
  332.  
  333. swinput:
  334. '--------------------------------- WINPUT -----------------------------------
  335.   CALL WPRINT(3, "  WINPUT (window_id,input_string,rel_pos,edits,exits,accept$,kb,flag)")
  336.   CALL WPRINT(1, "  WINPUT~~  Very versatile window input~  routine.")
  337.   CALL WPRINT(2, "  Use WINPUT and create your own~  database input routines.  A")
  338.   CALL WPRINT(2, "~  sample video database and WINPUT~  options follow...")
  339.   CALL prompt: CALL savescrn: CLS
  340.   CALL BOX(4, 2, 74, 21, 6, 0, ""): id = 6
  341.   CALL BOX8SET(223, 223, 223, 0, 0, 0, 0, 0, 0, 0, 0, 0)
  342.   CALL WOPEN(5, 1, 75, 20, 8, &H34, "", s6(), id): CALL WCOLOR(id, &H3B)
  343.   CALL WCLS(id)
  344.   CALL WPRINT(id, "              Here is a list of the 'edits' parameter bits~")
  345.   CALL WPRINT(id, "~ Bit 0    Keep original value of input_string when entering WINPUT")
  346.   CALL WPRINT(id, "~ Bit 1    Accept letters and spaces")
  347.   CALL WPRINT(id, "~ Bit 2    Accept numbers")
  348.   CALL WPRINT(id, "~ Bit 3    Accept +-. characters")
  349.   CALL WPRINT(id, "~ Bit 4    Accept all ASCII characters")
  350.   CALL WPRINT(id, "~ Bit 5    Convert inputted lowercase letters to uppercase")
  351.   CALL WPRINT(id, "~ Bit 6    Convert inputted uppercase letters to lowercase")
  352.   CALL WPRINT(id, "~ Bit 7    Beep if exceeding maximum field size during input")
  353.   CALL WPRINT(id, "~ Bit 8    Allow INS/DEL editing within field")
  354.   CALL WPRINT(id, "~ Bit 9    Allow HOME to position cursor at beginning of field")
  355.   CALL WPRINT(id, "~ Bit 10   Allow END to position cursor at the end of field")
  356.   CALL WPRINT(id, "~ Bit 11   Allow inserting while inputting (CNTRL-END toggles mode")
  357.   CALL WPRINT(id, "~ Bit 12   Cancel edits if exited by exit-type keys")
  358.   CALL WPRINT(id, "~ Bit 13   Normal exit when field buffer is full")
  359.   CALL WPRINT(id, "~ Bit 14   Exit if first mouse button is pressed")
  360.   CALL prompt: CALL WCLS(id)
  361.   CALL WPRINT(id, "        List of 'exit' parameter options")
  362.   CALL WPRINT(id, "~~ Bits 0-9   Exit if one of the function keys F1-F10 pressed")
  363.   CALL WPRINT(id, "~ Bit 10     Exit if up-arrow pressed")
  364.   CALL WPRINT(id, "~ Bit 11     Exit if down-arrow pressed")
  365.   CALL WPRINT(id, "~ Bit 12     Exit if CNTRL-PGUP pressed")
  366.   CALL WPRINT(id, "~ Bit 13     Exit if CNTRL-PGDN pressed")
  367.   CALL WPRINT(id, "~ Bit 14     Exit if ESC pressed")
  368.   CALL prompt: CALL WCLS(id)
  369.   CALL WPRINT(id, STRING$(16, 196) + " SAMPLE VIDEO DATABASE INPUT SCREEN " + STRING$(17, 196))
  370.   CALL WLOCATE(id, 0, 17)
  371.   CALL WPRINT(id, SPACE$(12) + "Press F1 for help or ESC to exit this screen")
  372. WINPUT1:
  373.   RESTORE WINPUT1: CALL WCOLOR(id, &H3E)
  374.   FOR i = 1 TO 5
  375.     READ x, y, a$: CALL WLOCATE(id, x, y): CALL WPRINT(id, a$ + ":")
  376.   NEXT i
  377.   DATA 2,3,"Video Title   ",2,5,"Year Produced ",2,7,"Classification"
  378.   DATA 2,9,"Tape ID",2,11,"Summary"
  379. WINPUT2:
  380.   numflds = 5: relpos = 1: exits = 16384 + 1: 'exits: set up exit for ESC or F1 keys (2^14 + 2^0)
  381.   text$(1) = "Star Trek - The Motion Picture": text$(2) = "1978": text$(5) = ""
  382.   text$(3) = "Sci-Fi": text$(4) = "9B": 'imagine this video data coming from a file
  383.   CALL WCOLOR(id, &H3F)
  384.   FOR i = 1 TO numflds
  385.     READ x(i), y(i), l(i), edits(i), accept$(i)
  386.     CALL WLOCATE(id, x(i), y(i)): CALL WPRINT(id, text$(i))
  387.   NEXT i
  388.   DATA 18,3,30,18305,""               : 'field 1 - Normal input
  389.   DATA 18,5,4,18331,""                : 'field 2 - Allow numbers only
  390.   DATA 18,7,16,18337,""               : 'field 3 - Convert lowercase to upper
  391.   DATA 11,9,4,18337,"0123456789ABCDE" : 'field 4 - Convert l/U and accept only numbers and A-E
  392.   DATA 11,11,74,18305,""              : 'field 5 - Normal input.  Notice wrap around when input exceeds length of window
  393. WINPUT3:
  394.   CALL MSHOW: GOSUB SCRN.INP:          'main s/r for database input/edit screen
  395.   IF flag <> 0 THEN GOTO WINPUT3 ELSE CALL MHIDE: CALL WCSROFF(id)
  396.                         : 'HELP routine (F1 pressed)
  397.   IF kb = 15104 THEN
  398.     CALL WOPEN(15, 3, 65, 17, 1, &H74, "", s8(), 8): CALL WCOLOR(8, &H70 + blue)
  399.     CALL WPRINT(8, "~      General Help for WINPUT processing")
  400.     CALL WPRINT(8, "~~  Up/Down Arrows move to different fields")
  401.     CALL WPRINT(8, "~  Right/Left Arrows move cursor within field")
  402.     CALL WPRINT(8, "~  HOME puts cursor to beginning of field")
  403.     CALL WPRINT(8, "~  END positions cursor to end of field")
  404.     CALL WPRINT(8, "~  DEL deletes character at cursor position")
  405.     CALL WPRINT(8, "~  INS inserts space at cursor position")
  406.     CALL WPRINT(8, "~  CNTRL-END toggles Insert/Overtype mode")
  407.     CALL WPRINT(8, "~~           Next Page, press any key")
  408.     WHILE INKEY$ = "": WEND: CALL WCLS(8)
  409.     CALL WPRINT(8, "~  For a quick placement of the cursor anywhere")
  410.     CALL WPRINT(8, "~  within a field, place the mouse cursor on top")
  411.     CALL WPRINT(8, "~  of desired location and press left-most mouse")
  412.     CALL WPRINT(8, "~  button.  Then move the mouse cursor out of~  the way.")
  413.     CALL WPRINT(8, "~~~           Press any key to continue")
  414.     WHILE INKEY$ = "": WEND: CALL WCLOSE(8): GOTO WINPUT3
  415.   END IF
  416.   CALL WCLOSE(id): CALL restorescrn: GOTO MAIN
  417. '============================================================================
  418. SCRN.INP:
  419. '............................................................................
  420. ' Screen input routine
  421. '  A window (id) must be open before calling this routine
  422. '    Enter: x(),y() = relative starting location within window
  423. '           l() = length of field, numflds = number of fields
  424. '           relpos = starting relative position, id = window id
  425. '           edits() = edit option bits for each field, exits=exit mask
  426. '           accept$() = string to contain accepting character for each field
  427. '           text$() = contains length and field data
  428. '    Exit:  text$() possibly modified
  429. '           flag=0 if exited ok, -1 if ESC exit
  430. '
  431. IF relpos < 1 THEN relpos = numflds ELSE IF relpos > numflds THEN relpos = 1
  432. relstart = 1
  433. SCRN.INP1:
  434. i = relpos: i$ = STRING$(l(i), 32): LSET i$ = text$(i)
  435. CALL WLOCATE(id, x(i), y(i)): CALL WCSRON(id)
  436. CALL WINPUT(id, i$, relstart, edits(i), (exits OR &H4C00), accept$(i), kb, flag)
  437. text$(i) = i$: IF flag = 1 THEN relpos = relpos + 1: GOTO SCRN.INP
  438. IF flag = 0 THEN
  439.    IF kb = 27 THEN RETURN
  440.    IF kb = 20480 THEN relpos = relpos + 1: GOTO SCRN.INP
  441.    IF kb = 18432 THEN relpos = relpos - 1: GOTO SCRN.INP
  442.    RETURN
  443. END IF
  444. IF flag <> -3 THEN GOTO SCRN.INP
  445. y = INT(kb / 256): x = INT(kb MOD 256): FOR i = 1 TO numflds
  446. IF (x >= x(i)) AND (x < x(i) + l(i)) AND (y = y(i)) THEN relpos = i: relstart = x - x(i) + 1: GOTO SCRN.INP1
  447. NEXT i: IF y > y(numflds) THEN RETURN ELSE GOTO SCRN.INP
  448. '============================================================================
  449.  
  450. sbox:
  451. '--------------------------------- BOX --------------------------------------
  452.   CALL WPRINT(3, "  BOX (X1,Y1,X2,Y2,style,color,box_title)")
  453.   CALL WPRINT(1, "  BOX~~  Draw a box any size, any color,~  anywhere on the screen.")
  454.   CALL WPRINT(1, "~  Choose from 7 pre-defined box~  styles or design one of~  your own.")
  455.   CALL prompt: CALL savescrn: CLS : RESTORE sbox
  456.   FOR i = 1 TO 7
  457.     READ x, y: CALL BOX(x, y, x + 17, y + 7, i, &H18 + i, "STYLE #" + MID$(STR$(i), 2))
  458.   NEXT i
  459.   CALL prompt: CALL restorescrn: GOTO MAIN
  460.   DATA 1,1,20,1,40,1,60,1,1,10,20,10,40,10,60,10
  461.  
  462.  
  463. smenuget:
  464. '--------------------------------- MENUGET ----------------------------------
  465.   CALL WPRINT(3, "  MENUGET (menu_number,option_number,flag)")
  466.   CALL WPRINT(1, "  MENUGET~~  Returns menu number and option")
  467.   CALL WPRINT(1, "~  number if selected with a mouse~  or keyboard")
  468.   CALL WPRINT(2, "~ The pull-down menus must have~ been previously defined and turned")
  469.   CALL WPRINT(2, "~ on with the MENUBAR, MENUSET, and~ MENUON commands.")
  470.   CALL prompt: CALL savescrn
  471.   CLS : RESTORE smenuget: nummenus = 6: barattr = &H30
  472.   '...... Read in values for MENU BAR along the top of the screen............
  473.   FOR i = 0 TO nummenus - 1
  474.       READ bar$(i), kb(i)
  475.   NEXT i
  476.   CALL MENUBAR(nummenus, barattr, kb(), VARPTR(bar$(0)))
  477.   DATA File,15104,Edit,15360,View,15616,Search,15872,Midi,16128,Comm,16384
  478.   '           F1         F2         F3           F4         F5         F6
  479.   '...... Read in each of the menu options & xfer into internal storage......
  480.   FOR i = 1 TO nummenus
  481.     READ msize, menu$(0)
  482.     FOR j = 1 TO msize: READ a$: menu$(j) = "  " + a$: NEXT j
  483.     CALL MENUSET(i, msize, 2, 10, 15, 7, -1, VARPTR(menu$(0)))
  484.   NEXT i
  485.   DATA 7,"FILE",Load,Save,Open,Close,Print,Shell,Quit       : 'Menu 1
  486.   DATA 4,"",Undo,Cut,Copy,Paste                             : 'Menu 2
  487.   DATA 2,"",Options,Windows                                 : 'Menu 3
  488.   DATA 4,"",Find,Selected Text,Repeat Last Find,Change      : 'Menu 4
  489.   DATA 2,"",Record,Playback                                 : 'Menu 5
  490.   DATA 3,"",Receive File,Send File,Comm Parameters          : 'Menu 6
  491.   '....... Turn on menu bar .................................................
  492.   CALL MENUON
  493.   CALL WOPEN(1, 2, 80, 24, 2, 2, "MUSIC EDITOR", s6(), 8)
  494.   CALL WCOLOR(8, &H17): CALL WCLS(8)
  495.   CALL WPRINT(8, "~  This demonstration has been set up so that you can use the mouse")
  496.   CALL WPRINT(8, "~or the function keys (F1-F6) to select one of the menus along the top.")
  497.   CALL WPRINT(8, "~Once a menu pops down, you can use the left or right arrow keys")
  498.   CALL WPRINT(8, "~to pop down the previous or next menu respectively.")
  499.   CALL WPRINT(8, "~~  You may select one of the options in the menu by one of the ways:")
  500.   CALL WPRINT(8, "~    1. Move mouse cursor on top of option and press left-mouse button.")
  501.   CALL WPRINT(8, "~    2. Press the first letter of the option and press ENTER.")
  502.   CALL WPRINT(8, "~    3. Press up/down arrows to highlight the option and press ENTER.")
  503.   CALL WPRINT(8, "~~  If you do not wish to select any option, press the ESC key.")
  504.   CALL WPRINT(8, "~~  In the first menu, the 'Save' and 'Close' options are both")
  505.   CALL WPRINT(8, "~displayed as low-intensity, which means that they may not be selected.")
  506.   CALL WPRINT(8, "~Another standard feature of QuickWindow's pull-down menuing system!")
  507.   CALL MENUOPTION(1, 2, 0): CALL MENUOPTION(1, 4, 0): 'demonstrates disabling menu option
  508. MENUGET2:
  509.   CALL MENUGET(m, o, f): IF f = 0 THEN GOTO MENUGET2: 'If no activity from kb or mouse
  510.   '                                               then f is returned as a 0.
  511.   CALL WCLS(8): CALL WLOCATE(8, 0, 10)
  512.   a1$ = "SELECTED OPTION": IF f <> -1 THEN a1$ = "NO OPTION SELECTED"
  513.   CALL WPRINT(8, "Menu:   " + STR$(m) + "~Option: " + STR$(o) + "~Flag:  " + a1$)
  514.   CALL prompt: CALL WCLOSE(8): CALL MENUOFF: CALL restorescrn
  515.   GOTO MAIN
  516.  
  517.  
  518. swbuttonset:
  519. '--------------------------------- WBUTTONSET -------------------------------
  520.   CALL WPRINT(3, "  WBUTTONSET (window_id,button,kb,hstyle,hattr,lstyle,lattr,x,y,button$)")
  521.   CALL WPRINT(1, "  WBUTTONSET~~  Defines an input button.  Up to~  32 buttons may be defined.")
  522.   CALL prompt: CALL savescrn: CLS
  523.   PRINT "The Input Focus is the button that is highlighted.": PRINT
  524.   PRINT "Keyboard: To move the Input Focus, use the left or right arrows."
  525.   PRINT "          Press ENTER to make a selection.": PRINT
  526.   PRINT "Mouse:    Move the mouse cursor on top the desired button and press"
  527.   PRINT "          the left mouse button."
  528.   CALL WOPEN(1, 11, 80, 24, 2, &H71, "", s11(), 11): RESTORE WBUTTONSET1
  529.   FOR i = 4 TO 19
  530.     READ x, y: a$ = "  ": RSET a$ = MID$(STR$(i - 3), 2)
  531.     CALL WBUTTONSET(11, i, 0, 0, &H7C, 1, &H74, x, y, a$)
  532.   NEXT i
  533.   CALL WLOCATE(11, 40, 1): CALL WPRINT(11, "Make a selection....      "): focus = 4
  534. WBUTTONSET1:
  535.   CALL WBUTTONGET(focus, 4, 16, result)
  536.   IF focus < 4 THEN focus = 19 ELSE IF focus > 19 THEN focus = 4
  537.   IF result = 0 THEN GOTO WBUTTONSET1
  538.   CALL WLOCATE(11, 40, 1): CALL WPRINT(11, "You've selected button " + STR$(result - 3))
  539.   CALL WLOCATE(11, 40, 3): CALL WPRINT(11, "Press ANY key....")
  540.   WHILE INKEY$ = "": WEND: CALL WCLOSE(11): CALL restorescrn
  541.   GOTO MAIN
  542. DATA 1,0,9,0,17,0,25,0,1,3,9,3,17,3,25,3,1,6,9,6,17,6,25,6,1,9,9,9,17,9,25,9
  543.  
  544.  
  545. swbox:
  546. '--------------------------------- WBOX -------------------------------------
  547.   CALL WPRINT(3, "  WBOX (window_id,x1,y1,x2,y2,style,attribute)")
  548.   CALL WPRINT(1, "  WBOX~~  Draws a box within a given~  window.  Choose from 7 styles")
  549.   CALL WPRINT(1, "~  or design one of your own."): RESTORE swbox
  550.   FOR i = 0 TO 7
  551.     READ x, y: CALL WBOX(2, x, y, x + 7, y + 2, 2, &H38 + i)
  552.   NEXT i
  553.   GOTO MAIN
  554. DATA 0,0,9,0,18,0,27,0,0,4,9,4,18,4,27,4: 'relative coordinates to inside window
  555.  
  556.  
  557. svscroll:
  558. '------------------------------ VSCROLL -------------------------------------
  559.   CALL WPRINT(3, "  VSCROLL (X1,Y1,X2,Y2,num_times,attribute,direction_flag)")
  560.   CALL WPRINT(1, "  VSCROLL~~  Similar to BIOS functions~  6 and 7.  Causes part of the")
  561.   CALL WPRINT(1, "~  screen to scroll upward~  or downward.")
  562.   CALL prompt: CALL savescrn: CLS : PRINT : CALL BOX(20, 10, 60, 23, 1, &H17, "")
  563.   PRINT "A box is placed at (20,10)-(60,23).  All scrolling is done inside the box."
  564.   PRINT : PRINT "Press UP arrow to scroll upwards"
  565.   PRINT "      DOWN arrow to scroll downwards"
  566.   PRINT "      SPACE to pause": PRINT "      ESC to quit": direction = 0
  567.   RESTORE VSCROLL1: FOR i = 0 TO 103: READ sc1(i): NEXT i
  568.   CALL PUTSCRN(32, 12, 48, 17, sc1())
  569. VSCROLL1:
  570.   a$ = INKEY$: IF (LEN(a$) = 1) AND (a$ = CHR$(27)) THEN CALL restorescrn: GOTO MAIN
  571.   IF LEN(a$) = 1 AND a$ = CHR$(32) THEN direction = -1
  572.   IF a$ = MKI$(18432) THEN direction = 0 ELSE IF a$ = MKI$(20480) THEN direction = 1
  573.   IF direction = 0 THEN
  574.     CALL GETSCRN(21, 11, 59, 11, sc1())
  575.     CALL VSCROLL(21, 11, 59, 22, 1, &H1E, direction)
  576.     CALL PUTSCRN(21, 22, 59, 22, sc1())
  577.   ELSEIF direction = 1 THEN
  578.     CALL GETSCRN(21, 22, 59, 22, sc1())
  579.     CALL VSCROLL(21, 11, 59, 22, 1, &H1E, direction)
  580.     CALL PUTSCRN(21, 11, 59, 11, sc1())
  581.   END IF
  582.   FOR delay = 1 TO 1000: NEXT delay: GOTO VSCROLL1
  583. DATA 16091,16091,16091,16091,16091,16091,7712,7712,7712,7899,7712,7712,7712
  584. DATA 7712,7712,7899,7712,16091,5809,5809,5809,5809,16091,5809,7712,7712
  585. DATA 7899,5809,7712,7712,7712,7712,7899,5809,16091,5809,7712,7712,7712
  586. DATA 16091,5809,7712,7712,7899,5809,7712,7712,7712,7712,7899,5809,16091
  587. DATA 5809,7712,7712,7900,7899,5809,7712,7712,7899,5809,7712,7899,7712
  588. DATA 7712,7899,5809,16091,16091,16091,16091,16091,16091,5809,7712,7712,7899
  589. DATA 7899,7899,7899,7899,7899,7899,5809,7712,5809,5809,5809,5809,5809
  590. DATA 5809,7712,7712,7712,5809,5809,5809,5809,5809,5809,5809,0,0
  591.  
  592. REM $STATIC
  593. SUB prompt
  594.   '**************************************************************************
  595.   '  Prompt user to continue
  596.   '
  597.   CALL WOPEN(1, 19, 79, 23, 2, &H74, "", s11(), 11)
  598.   CALL WCOLOR(11, &H70 + blue)
  599.   CALL WCLS(11): CALL WPRINT(11, "~  Ready to continue:")
  600.   CALL WBUTTONSET(11, 4, 0, 0, &H78 + blue, 1, &H70 + blue, 36, 0, "OK")
  601.   focus1 = 4
  602. PROMPT1:
  603.   CALL WBUTTONGET(focus1, 4, 1, result): IF focus1 <> 4 THEN focus1 = 4
  604.   IF result = 0 THEN GOTO PROMPT1
  605.   CALL MHIDE: CALL WCLOSE(11)
  606. END SUB
  607.  
  608. SUB restorescrn
  609.   '**************************************************************************
  610.   '  Restore entire screen from array
  611.   '
  612.   CALL PUTSCRN(1, 1, 80, 24, scrn())
  613. END SUB
  614.  
  615. SUB sattrscrn
  616. '------------------------------ ATTRSCRN ------------------------------------
  617.   CALL WPRINT(3, "  ATTRSCRN (X1,Y1,X2,Y2,color)")
  618.   CALL WPRINT(1, "  ATTRSCRN~~  Changes the attribute for all~  or part of the screen")
  619.   CALL prompt: CALL savescrn: CLS : LOCATE 10, 23
  620.   PRINT "This effect is caused by ATTRSCRN.";
  621.   FOR i = 6 TO 0 STEP -1
  622.     CALL ATTRSCRN(21 - (i * 2), 9 - i, 58 + (i * 2), 11 + i, i * 16 + 7)
  623.   NEXT i
  624.   CALL prompt: CALL restorescrn
  625. END SUB
  626.  
  627. SUB savescrn
  628.   '**************************************************************************
  629.   '  Save entire screen into array so that demos may be performed without loss
  630.   '  of dialog windows
  631.   '
  632.   CALL GETSCRN(1, 1, 80, 24, scrn())
  633. END SUB
  634.  
  635. SUB sbox8set
  636. '------------------------------- BOX8SET ------------------------------------
  637.   CALL WPRINT(3, "  BOX8SET (TL,TR,TA,BL,BR,BA,sides,LTITLE,RTITLE,0,0,0)")
  638.   CALL WPRINT(1, "  BOX8SET~~  Define a style of box to be~  used in BOX, WBOX, WOPEN")
  639.   CALL WPRINT(1, "~  or any of the POP-UP or~  PULL-DOWN menus.")
  640.   CALL prompt: CALL savescrn: CLS
  641.   PRINT "Given the parameters for BOX8SET,": PRINT
  642.   PRINT "Top Left      = 213   "; CHR$(213): PRINT "Top Right     = 184   "; CHR$(184)
  643.   PRINT "Top Across    = 205   "; CHR$(205): PRINT "Bottom Left   = 212   "; CHR$(212)
  644.   PRINT "Bottom Right  = 190   "; CHR$(190): PRINT "Bottom Across = 205   "; CHR$(205)
  645.   PRINT "Sides         = 179   "; CHR$(179): PRINT "Left Title    = 181   "; CHR$(181)
  646.   PRINT "Right Title   = 198   "; CHR$(198)
  647.   CALL BOX8SET(213, 184, 205, 212, 190, 205, 179, 181, 198, 0, 0, 0)
  648.   CALL BOX(32, 7, 72, 17, 8, &H1E, "TITLE")
  649.   LOCATE 5, 36: PRINT "The following box can be made...";
  650.   CALL prompt: CALL restorescrn
  651. END SUB
  652.  
  653. SUB sdmascrn
  654. '-------------------------------- DMASCRN -----------------------------------
  655.   CALL WPRINT(3, "  DMASCRN (mode)")
  656.   CALL WPRINT(1, "  DMASCRN~~  Select mode that characters~  will be written to the display.")
  657.   CALL WPRINT(1, "~~  0 = Wait for retrace (no snow)~  1 = Direct writes (some snow)")
  658.   CALL prompt: CALL savescrn: CLS
  659.   PRINT "Observe Mode 1 - Some snow should be visible with CGA cards"
  660.   CALL DMASCRN(1)
  661.   FOR d = 1 TO 8000: NEXT d
  662.   CALL WOPEN(1, 3, 80, 24, 2, &H12, "", s11(), 11): CALL WCOLOR(11, &H17)
  663.   CALL WWRAP(11, 0)
  664.   FOR i = 1 TO 1000
  665.     CALL WPRINT(11, STR$(i))
  666.   NEXT i
  667.   LOCATE 1, 1: PRINT STRING$(78, 32)
  668.   LOCATE 1, 1: PRINT "Observe mode 0 - There should be very little snow"
  669.   FOR d = 1 TO 5000: NEXT d: CALL DMASCRN(0): CALL WCLS(11)
  670.   FOR i = 1 TO 1000
  671.     CALL WPRINT(11, STR$(i))
  672.   NEXT i
  673.   FOR d = 1 TO 5000: NEXT d: CALL WCLOSE(11): CALL prompt: CALL restorescrn
  674. END SUB
  675.  
  676. SUB sgetch
  677. '-------------------------------- GETCH -------------------------------------
  678.   CALL WPRINT(3, "  GETCH (row,col,character,attribute)")
  679.   CALL WPRINT(1, "  GETCH~~  Returns a character and its~  attribute for a given")
  680.   CALL WPRINT(1, "~  row (1-24) and column (1-80)")
  681. END SUB
  682.  
  683. SUB sgetscrn
  684. '------------------------------ GETSCRN -------------------------------------
  685.   CALL WPRINT(3, "  GETSCRN (X1,Y1,X2,Y2,array())")
  686.   CALL WPRINT(1, "  GETSCRN~~  Saves a portion of the screen~  into an array")
  687.   CALL prompt: CALL savescrn: CLS : CALL BOX(1, 1, 35, 6, 4, &H74, "")
  688.   COLOR 1, 7: LOCATE 3, 3: PRINT "This box will be moved by using"
  689.   LOCATE 4, 3: PRINT "the GETSCRN/PUTSCRN functions."
  690.   CALL GETSCRN(1, 1, 35, 6, sc1())
  691.   FOR i = 2 TO 40
  692.     CALL VSCROLL(i - 1, 1, 34 + i, 6, 0, &H11, 1): 'clear box
  693.     CALL PUTSCRN(1 + i, 1, 35 + i, 6, sc1())
  694.   NEXT i
  695.   COLOR 7, 1: CALL prompt: CALL restorescrn
  696. END SUB
  697.  
  698. SUB shelpmenu
  699. '--------------------------------- HELPMENU ---------------------------------
  700.   CALL WPRINT(3, "  HELPMENU (window_id,0,barattr,num_lines,menu$(),flag)")
  701.   CALL WPRINT(1, "  HELPMENU~~  Creates a pop-up help menu using~  the specified window id.")
  702.   CALL WPRINT(2, "~~  Works identical to POPMENUV but~  you cannot select an 'option'.")
  703.   CALL prompt: CALL savescrn: CLS
  704.   PRINT "Scroll through pages of text by...": PRINT
  705.   PRINT "  1. Pressing PgUp, PgDn, HOME, or END."
  706.   PRINT "  2. Placing mouse cursor before or after scroll"
  707.   PRINT "     pointer and clicking left mouse button.": PRINT
  708.   PRINT "Press ESC to exit."
  709.   barattr = 3: relpos = 0: numlines = 100: 'numlines limit is 255
  710.   FOR i = 0 TO numlines
  711.      menu$(i) = " Text line  " + MID$(STR$(i + 1), 2)
  712.   NEXT i
  713.   CALL WOPEN(22, 7, 60, 18, 2, &H12, "", s8(), 8)
  714.   CALL WCOLOR(8, &H17): CALL PUTCH(22, 7, &H7F, &H12)
  715.   CALL HELPMENU(8, 0, barattr, numlines, VARPTR(menu$(0)), flag)
  716.   CALL prompt: CALL WCLOSE(8): CALL restorescrn
  717. END SUB
  718.  
  719. SUB smbpress
  720. '--------------------------------- MBPRESS ----------------------------------
  721. '  Upon entry, the value of status determines which button is checked.
  722. '    If the value is 0, this means bit 0 or left-most button
  723. '    If the value is 1, bit 1 or right-most button is checked
  724. '
  725.   CALL WPRINT(3, "  MBPRESS (status,number,column,row)")
  726.   CALL WPRINT(1, "  MBPRESS~~  Returns number of button presses")
  727.   CALL WPRINT(1, "~  since last call to this function")
  728.   IF mouse.status = 0 THEN EXIT SUB
  729.   CALL WPRINT(2, "  See how many times you can~  press the left-most mouse")
  730.   CALL WPRINT(2, "~  button before the counter~  reaches 0.  Press any key to")
  731.   CALL WPRINT(2, "~  start the counter.")
  732.   CALL MSHOW: WHILE INKEY$ = "": WEND: CALL WCLS(2)
  733.   CALL MBPRESS(0, n, x, y)     'initialize internal mouse driver's counter to 0
  734.   FOR i = 10 TO 0 STEP -1
  735.     CALL WLOCATE(2, 16, 3): CALL WPRINT(2, STR$(i) + " "): CALL MSHOW
  736.     FOR delay = 1 TO 30000: NEXT delay
  737.   NEXT i
  738.   CALL WCLS(2): CALL MBPRESS(0, n, x, y)
  739.   CALL WPRINT(2, " You've pressed the mouse button~" + STR$(n) + " times")
  740. END SUB
  741.  
  742. SUB smbrel
  743. '--------------------------------- MBREL ------------------------------------
  744. '  Upon entry, the value of status determines which button is checked.
  745. '    If the value is 0, this means bit 0 or left-most button
  746. '    If the value is 1, bit 1 or right-most button is checked
  747. '
  748.   CALL WPRINT(3, "  MBREL (status,number,column,row)")
  749.   CALL WPRINT(1, " MBREL~~ Returns number of button releases")
  750.   CALL WPRINT(1, "~ since last call to this function")
  751.   IF mouse.status = 0 THEN EXIT SUB
  752.   CALL WPRINT(2, "  This function is identical to~  MBPRESS, but counts the number")
  753.   CALL WPRINT(2, "~  of button releases.  See MBPRESS~  for demonstration.")
  754. END SUB
  755.  
  756. SUB smenubar
  757. '--------------------------------- MENUBAR ----------------------------------
  758.   CALL WPRINT(3, "  MENUBAR (number_menus,bar_attribute,kb(),bar$())")
  759.   CALL WPRINT(1, "  MENUBAR~~  Defines a list of pull-down")
  760.   CALL WPRINT(1, "~  menus along the top of the~  screen")
  761.   CALL WPRINT(2, "~  See MENUGET for a complete~  demonstration of the pull-down")
  762.   CALL WPRINT(2, "~  menuing system.")
  763. END SUB
  764.  
  765. SUB smenuoff
  766. '--------------------------------- MENUOFF ----------------------------------
  767.   CALL WPRINT(3, "  MENUOFF")
  768.   CALL WPRINT(1, "  MENUOFF~~  Turns off the menu bar along the~  top and disables menu checking")
  769.   CALL WPRINT(2, "~  See MENUGET for a complete~  demonstration of the pull-down")
  770.   CALL WPRINT(2, "~  menuing system.")
  771. END SUB
  772.  
  773. SUB smenuon
  774. '--------------------------------- MENUON -----------------------------------
  775.   CALL WPRINT(3, "  MENUON")
  776.   CALL WPRINT(1, "  MENUON~~  Turns on the menu bar along the~  top and enables menu checking")
  777.   CALL WPRINT(2, "~  See MENUGET for a complete~  demonstration of the pull-down")
  778.   CALL WPRINT(2, "~  menuing system.")
  779. END SUB
  780.  
  781. SUB smenuoption
  782. '--------------------------------- MENUOPTION -------------------------------
  783.   CALL WPRINT(3, "  MENUOPTION (menu_number,option_number,mode)")
  784.   CALL WPRINT(1, "  MENUOPTION~~  Disables or enables an option~  for selection")
  785.   CALL WPRINT(2, "~  See MENUGET for a complete~  demonstration of the pull-down")
  786.   CALL WPRINT(2, "~  menuing system.")
  787. END SUB
  788.  
  789. SUB smenuset
  790.   '------------------------------- MENUSET ----------------------------------
  791.   CALL WPRINT(3, "  MENUSET (menu,options,style,battr,cattr_en,cattr_dis,mask,menu$())")
  792.   CALL WPRINT(1, "  MENUSET~~  Defines a list of options for")
  793.   CALL WPRINT(1, "~  specified menu number.  Can also~  define menu style and")
  794.   CALL WPRINT(1, "~  attributes.  Up to 16 options~  may be defined per menu.")
  795.   CALL WPRINT(2, "~  See MENUGET for a complete~  demonstration of the pull-down")
  796.   CALL WPRINT(2, "~  menuing system.")
  797. END SUB
  798.  
  799. SUB smhide
  800. '--------------------------------- MHIDE ------------------------------------
  801.   CALL WPRINT(3, "  MHIDE ")
  802.   CALL WPRINT(1, " MHIDE~~ Turns off the mouse cursor")
  803.   CALL WPRINT(1, "~~ The mouse driver tracks the~ position of the mouse even though")
  804.   CALL WPRINT(1, "~ the mouse cursor is off.")
  805.   IF mouse.status = 0 THEN EXIT SUB
  806.   CALL WPRINT(2, "~  Press any key to turn off~  the mouse cursor.")
  807.   CALL MSHOW: WHILE INKEY$ = "": WEND: CALL MHIDE
  808.   CALL WPRINT(2, "~~  Press any key to turn it~  back on.")
  809.   WHILE INKEY$ = "": WEND: CALL MSHOW
  810. END SUB
  811.  
  812. SUB sminit
  813. '--------------------------------- MINIT ------------------------------------
  814.   CALL WPRINT(3, "  MINIT (status,number_of_buttons)")
  815.   CALL WPRINT(1, "  MINIT~~  Initializes and tests if mouse~  driver is present")
  816.   CALL MINIT(s, b)
  817.   IF s = 0 THEN
  818.     CALL WPRINT(2, "~  The mouse driver is not installed~  on this system.")
  819.   ELSE
  820.     CALL WPRINT(2, "~  The mouse driver is installed")
  821.     CALL WPRINT(2, "~  and the mouse has " + MID$(STR$(b), 2) + " button" + MID$("s", 1, -(b > 1)) + ".")
  822.   END IF
  823. END SUB
  824.  
  825. SUB smouse
  826. '--------------------------------- MOUSE ------------------------------------
  827.   CALL WPRINT(3, "  MOUSE (button_status,column,row)")
  828.   CALL WPRINT(1, "  MOUSE~~  Returns the current position~  of the mouse cursor and")
  829.   CALL WPRINT(1, "~  button press status")
  830.   IF mouse.status = 0 THEN EXIT SUB
  831.   CALL WPRINT(2, "~  Move the mouse and observe the~  current positions below.  Press")
  832.   CALL WPRINT(2, "~  ESC to exit demo"): x1 = 0: y1 = 0: b1 = 0
  833. MOUSE1:
  834.   CALL MOUSE(b, x, y): CALL MSHOW: x = INT(x / 8): y = INT(y / 8)
  835.   IF INKEY$ = CHR$(27) THEN CALL WCLS(2): EXIT SUB
  836.   IF x = x1 AND y = y1 AND b = b1 THEN GOTO MOUSE1  'keeps cursor on while mouse is not moving
  837.   CALL WLOCATE(2, 0, 5)                             'because WPRINT turns off the mouse cursor
  838.   CALL WPRINT(2, "  row=" + MID$(STR$(y), 2) + "  column=" + MID$(STR$(x), 2) + "  button=" + MID$(STR$(b), 2) + "   ")
  839.   CALL MSHOW: x1 = x: y1 = y: b1 = b: GOTO MOUSE1
  840. END SUB
  841.  
  842. SUB smpenoff
  843. '--------------------------------- MPENOFF ----------------------------------
  844.   CALL WPRINT(3, "  MPENOFF")
  845.   CALL WPRINT(1, "  MPENOFF~~  Light pen emulation mode off.")
  846.   CALL WPRINT(2, "  See MPENON for a demonstration.")
  847. END SUB
  848.  
  849. SUB smpenon
  850. '--------------------------------- MPENON -----------------------------------
  851.   CALL WPRINT(3, "  MPENON")
  852.   CALL WPRINT(1, "  MPENON~~  Light pen emulation mode on.")
  853.   CALL WPRINT(1, "~  Calls to BASIC Pen functions~  will return position and")
  854.   CALL WPRINT(1, "~  button press information from~  the mouse.")
  855.   IF mouse.status = 0 THEN EXIT SUB
  856.   CALL WPRINT(2, " Using the BASIC PEN function, the~ mouse info since button-press is:")
  857.   CALL WLOCATE(2, 0, 6): CALL WPRINT(2, " Press ESC to exit...")
  858.   PEN ON: CALL MPENON: x1 = 0: y1 = 0: b1 = 0
  859. PENON1:
  860.   CALL MSHOW: x = PEN(8): y = PEN(9): button = PEN(3)
  861.   IF button = 0 THEN a1$ = "NO " ELSE a1$ = "YES"
  862.   IF INKEY$ = CHR$(27) THEN PEN OFF: CALL MPENOFF(0, 0): CALL WCLS(2): EXIT SUB
  863.   IF x = x1 AND y = y1 AND button = b1 THEN GOTO PENON1
  864.   CALL WLOCATE(2, 0, 3)
  865.   CALL WPRINT(2, "    X-pos=" + MID$(STR$(x), 2) + "   Y-pos=" + MID$(STR$(y), 2) + "   ")
  866.   CALL WPRINT(2, "~    Any button pressed: " + a1$)
  867.   x1 = x: y1 = y: b1 = button: GOTO PENON1
  868. END SUB
  869.  
  870. SUB smratio
  871. '--------------------------------- MRATIO -----------------------------------
  872.   CALL WPRINT(3, "  MRATIO (x_step,y_step)")
  873.   CALL WPRINT(1, "  MRATIO~~  Sets how far mouse cursor will")
  874.   CALL WPRINT(1, "~  move in relation to how far the~  mouse has moved physically")
  875.   IF mouse.status = 0 THEN EXIT SUB
  876.   CALL WPRINT(2, " The mouse step-ratio has been~ set so that you have to physically")
  877.   CALL WPRINT(2, "  move the mouse far to move~ the mouse cursor just a little.")
  878.   CALL WPRINT(2, "~~ Press any key to return to normal.")
  879.   CALL MSHOW
  880.   CALL MRATIO(40, 80)         '5 times more than normal movement
  881.   WHILE INKEY$ = "": WEND: CALL MRATIO(8, 16)
  882. END SUB
  883.  
  884. SUB smsetpos
  885. '--------------------------------- MSETPOS ----------------------------------
  886.   CALL WPRINT(3, "  MSETPOS (column,row)")
  887.   CALL WPRINT(1, "  MSETPOS~~  Sets the mouse cursor position")
  888.   IF mouse.status = 0 THEN EXIT SUB
  889.   CALL WPRINT(2, " Move the mouse cursor to the~ upper part of the screen.  Press")
  890.   CALL WPRINT(2, "~ any key to force the mouse to~ the lower part of the screen.")
  891.   CALL MSHOW: WHILE INKEY$ = "": WEND: x = 80: y = 24
  892.   CALL MSETPOS((x - 1) * 8, (y - 1) * 8)
  893. END SUB
  894.  
  895. SUB smsetx
  896. '--------------------------------- MSETX ------------------------------------
  897.   CALL WPRINT(3, "  MSETX (min_x,max_x)")
  898.   CALL WPRINT(1, "  MSETX~~  Sets an area within which the")
  899.   CALL WPRINT(1, "~  mouse is able to move~  (between columns)")
  900.   IF mouse.status = 0 THEN EXIT SUB
  901.   CALL WPRINT(2, " The mouse is confined within~ columns 20 and 60.  Any attempt")
  902.   CALL WPRINT(2, "~ to move outside this area will~ just keep the mouse on the border.")
  903.   CALL WPRINT(2, "~~ Press any key to return to normal.")
  904.   CALL MSHOW: x1 = 20: x2 = 60
  905.   CALL MSETX((x1 - 1) * 8, (x2 - 1) * 8): '(value x 8) for text cursor
  906.   WHILE INKEY$ = "": WEND: CALL MSETX(0, 632)
  907. END SUB
  908.  
  909. SUB smsety
  910. '--------------------------------- MSETY ------------------------------------
  911.   CALL WPRINT(3, "  MSETY (min_y,max_y)")
  912.   CALL WPRINT(1, "  MSETY~~  Sets an area within which the")
  913.   CALL WPRINT(1, "~  mouse is able to move~  (between rows)")
  914.   IF mouse.status = 0 THEN EXIT SUB
  915.   CALL WPRINT(2, " The mouse is confined within~ rows 10 and 16.  Any attempt")
  916.   CALL WPRINT(2, "~ to move outside this area will~ just keep the mouse on the border.")
  917.   CALL WPRINT(2, "~~ Press any key to return to normal.")
  918.   CALL MSHOW: y1 = 10: y2 = 16
  919.   CALL MSETY((y1 - 1) * 8, (y2 - 1) * 8): '(value x 8) for text cursor
  920.   WHILE INKEY$ = "": WEND: CALL MSETY(0, 192)
  921. END SUB
  922.  
  923. SUB smshow
  924. '--------------------------------- MSHOW ------------------------------------
  925.   CALL WPRINT(3, "  MSHOW ")
  926.   CALL WPRINT(1, " MSHOW~~ Turns on the mouse cursor")
  927.   CALL WPRINT(1, "~~ The mouse driver tracks the~ position of the mouse even though")
  928.   CALL WPRINT(1, "~ the mouse cursor may be off.")
  929.   IF mouse.status = 0 THEN EXIT SUB
  930.   CALL MHIDE: CALL WPRINT(2, "~  Press any key to turn on~  the mouse cursor.")
  931.   WHILE INKEY$ = "": WEND: CALL MSHOW
  932. END SUB
  933.  
  934. SUB spopmenu
  935.   '------------------------------- POPMENU ----------------------------------
  936. PMENU1:
  937.   CALL WPRINT(3, "  POPMENU (result,kb,style,battr,cattr,x1,y1,num_options,menu$())")
  938.   CALL WPRINT(1, "  POPMENU~~  Creates a pop-up menu anywhere~  on the screen")
  939.   CALL WPRINT(2, "  Customize border styles, colors,~  and character attributes.")
  940.   CALL WPRINT(2, "~~  Select an option with the~  keyboard or a mouse.")
  941.   CALL prompt: CALL savescrn: CLS
  942.   PRINT "Select an option by..."
  943.   PRINT "  1. Moving mouse cursor on top of option and pressing the left button."
  944.   PRINT "  2. Pressing the first letter of the option and pressing ENTER."
  945.   PRINT "  3. Using up/down arrows to highlight option and press ENTER."
  946.   PRINT : PRINT "Press ESC to exit without selecting an option."
  947.   num.options = 6: x = 32: y = 10: battr = 2: cattr = 14: style = 2: kb = 1
  948.   menu$(0) = "Sample menu"
  949.   menu$(1) = "  Account Maintenance"
  950.   menu$(2) = "  Download Maintenance"
  951.   menu$(3) = "  Message Bas Maintenance"
  952.   menu$(4) = "  TeleLink Network Maintenance"
  953.   menu$(5) = "  System Configurations"
  954.   menu$(6) = "  Quit Syslink"
  955.   CALL POPMENU(result, kb, style, battr, cattr, x, y, num.options, VARPTR(menu$(0)))
  956.   LOCATE 10, 3
  957.   IF result = 0 THEN
  958.     PRINT "No options were selected."
  959.   ELSE
  960.     PRINT "You've selected menu option: "; result; "  --> "; menu$(result)
  961.   END IF
  962.   CALL prompt: CALL restorescrn
  963. END SUB
  964.  
  965. SUB spopmenu1
  966.   '------------------------------- POPMENU1 ---------------------------------
  967. PMENU2:
  968.   CALL WPRINT(3, "  POPMENU1 (result,kb,style,battr,cattr(),x1,y1,n,menu$())")
  969.   CALL WPRINT(1, "  POPMENU1~~  Creates a pop-up menu anywhere~  on the screen")
  970.   CALL WPRINT(1, "~~  Same as POPMENU, but allows each~  row to have its own attribute")
  971.   CALL WPRINT(2, "  Customize border styles, colors,~  and character attributes.")
  972.   CALL WPRINT(2, "~~  Select an option with the~  keyboard or a mouse.")
  973.   CALL prompt: CALL savescrn: CLS
  974.   PRINT "Select an option by..."
  975.   PRINT "  1. Moving mouse cursor on top of option and pressing the left button."
  976.   PRINT "  2. Pressing the first letter of the option and pressing ENTER."
  977.   PRINT "  3. Using up/down arrows to highlight option and press ENTER."
  978.   PRINT : PRINT "Press ESC to exit without selecting an option."
  979.   num.options = 6: x = 32: y = 10: battr = 2: style = 2: kb = 1
  980.   menu$(0) = "Another sample menu"
  981.   menu$(1) = "  Account Maintenance"
  982.   menu$(2) = "  Download Maintenance"
  983.   menu$(3) = "  Message Bas Maintenance"
  984.   menu$(4) = "  TeleLink Network Maintenance"
  985.   menu$(5) = "  System Configurations"
  986.   menu$(6) = "  Quit Syslink"
  987.   FOR i = 0 TO 5: cattr(i) = i + 1: NEXT i'....Define each row's attributes....
  988.   CALL POPMENU1(result, kb, style, battr, cattr(), x, y, num.options, VARPTR(menu$(0)))
  989.   LOCATE 10, 3
  990.   IF result = 0 THEN
  991.     PRINT "No options were selected."
  992.   ELSE
  993.     PRINT "You've selected menu option: "; result; "  --> "; menu$(result)
  994.   END IF
  995.   CALL prompt: CALL restorescrn
  996. END SUB
  997.  
  998. SUB spopmenuh
  999. '--------------------------------- POPMENUH ---------------------------------
  1000. PMENUH:
  1001.   CALL WPRINT(3, "  POPMENUH (id,posn,opt_width,num_opts,barattr,menu$(),result,flg)")
  1002.   CALL WPRINT(1, "  POPMENUH~~  Creates a pop-up menu using the~  specified window id.")
  1003.   CALL WPRINT(1, "~  Menu options are laid out~  horizontally according to option")
  1004.   CALL WPRINT(1, "~  width and size of the window.")
  1005.   CALL WPRINT(2, "~~  Select an option with the~  keyboard or a mouse.")
  1006.   CALL prompt: CALL savescrn: CLS
  1007.   PRINT "Scroll through pages of options by..."
  1008.   PRINT "  1. Pressing PgUp, PgDn, HOME, or END."
  1009.   PRINT "  2. Placing mouse cursor before or after scroll pointer and clicking left"
  1010.   PRINT "     mouse button.": PRINT
  1011.   PRINT "Select an option by..."
  1012.   PRINT "  1. Moving mouse cursor on top of option and pressing the left button."
  1013.   PRINT "  2. Using up/down/left/right arrows to highlight option and press ENTER."
  1014.   PRINT : PRINT "Press ESC to exit without selecting an option."
  1015.   barattr = 3: relpos = 0: menuwidth = 15: numoptions = 100: 'max numoptions is 255
  1016.   FOR i = 0 TO numoptions: menu$(i) = "00000" + MID$(STR$(i), 2): NEXT i
  1017.   CALL WOPEN(9, 12, 70, 23, 2, &H12, "", s8(), 8)
  1018.   CALL WCOLOR(8, &H17): CALL PUTCH(9, 12, &H7F, &H12)
  1019.   CALL POPMENUH(8, relpos, menuwidth, numoptions, barattr, VARPTR(menu$(0)), result, flag)
  1020.   CALL VSCROLL(1, 1, 80, 10, 0, &H17, 1): LOCATE 1, 1: 'clear upper part of screen
  1021.   PRINT "Selected menu option: "; result, "("; menu$(result); ")", "Exit flag: ";
  1022.   IF flag = 0 THEN PRINT "NO SELECTION MADE" ELSE PRINT "SELECTED OPTION"
  1023.   CALL prompt: CALL WCLOSE(8): CALL restorescrn
  1024. END SUB
  1025.  
  1026. SUB spopmenuv
  1027. '--------------------------------- POPMENUV ---------------------------------
  1028.   CALL WPRINT(3, "  POPMENUV (id,rel_pos,barattr,num_options,menu$(),result,flg)")
  1029.   CALL WPRINT(1, "  POPMENUV~~  Creates a pop-up menu using the~  specified window id.")
  1030.   CALL WPRINT(1, "~  Menu options are laid out~  vertically according to the")
  1031.   CALL WPRINT(1, "~  size of the window.")
  1032.   CALL WPRINT(2, "~~  Select an option using the~  keyboard or a mouse.")
  1033.   CALL prompt: CALL savescrn: CLS
  1034.   PRINT "Scroll through pages of options by..."
  1035.   PRINT "  1. Pressing PgUp, PgDn, HOME, or END."
  1036.   PRINT "  2. Placing mouse cursor before or after scroll"
  1037.   PRINT "     pointer and clicking left mouse button.": PRINT
  1038.   PRINT "Select an option by..."
  1039.   PRINT "  1. Moving mouse cursor on top of option and"
  1040.   PRINT "     pressing the left button."
  1041.   PRINT "  2. Using up/down arrows to highlight option"
  1042.   PRINT "     and press ENTER.": PRINT
  1043.   PRINT "Press ESC to exit without selecting an option."
  1044.   barattr = 3: relpos = 0: numoptions = 100: 'numoptions limit is 255
  1045.   FOR i = 0 TO numoptions: menu$(i) = "00000" + MID$(STR$(i), 2): NEXT i
  1046.   CALL WOPEN(55, 2, 74, 23, 2, &H12, "", s8(), 8)
  1047.   CALL WCOLOR(8, &H17): CALL PUTCH(55, 2, &H7F, &H12)
  1048.   CALL POPMENUV(8, relpos, barattr, numoptions, VARPTR(menu$(0)), result, flag)
  1049.   CALL VSCROLL(1, 1, 54, 14, 0, &H17, 1): LOCATE 1, 1: 'clear upper part of screen
  1050.   PRINT "Selected menu option: "; result, "("; menu$(result); ")", "Exit flag: ";
  1051.   IF flag = 0 THEN PRINT "NO SELECTION MADE" ELSE PRINT "SELECTED OPTION"
  1052.   CALL prompt: CALL WCLOSE(8): CALL restorescrn
  1053. END SUB
  1054.  
  1055. SUB sputch
  1056. '-------------------------------- PUTCH -------------------------------------
  1057.   CALL WPRINT(3, "  PUTCH (row,col,character,attribute)")
  1058.   CALL WPRINT(1, "  PUTCH~~  Writes a character and its~  attribute for a given")
  1059.   CALL WPRINT(1, "~  row (1-24) and column (1-80)~  to the screen")
  1060. END SUB
  1061.  
  1062. SUB sputscrn
  1063. '------------------------------- PUTSCRN ------------------------------------
  1064.   CALL WPRINT(3, "  PUTSCRN (X1,Y1,X2,Y2,array())")
  1065.   CALL WPRINT(1, "  PUTSCRN~~  Writes the contents of an~  array to the screen")
  1066.   CALL prompt: CALL savescrn: CLS : CALL BOX(1, 1, 35, 6, 4, &H74, "")
  1067.   COLOR 1, 7: LOCATE 3, 3: PRINT "This box will be moved by using"
  1068.   LOCATE 4, 3: PRINT "the GETSCRN/PUTSCRN functions."
  1069.   CALL GETSCRN(1, 1, 35, 6, sc1())
  1070.   FOR i = 2 TO 40
  1071.     CALL VSCROLL(i - 1, 1, 34 + i, 6, 0, &H11, 1): 'clear box
  1072.     CALL PUTSCRN(1 + i, 1, 35 + i, 6, sc1())
  1073.   NEXT i
  1074.   COLOR 7, 1: CALL prompt: CALL restorescrn
  1075. END SUB
  1076.  
  1077. SUB srevscrn
  1078. '-------------------------------- REVSCRN -----------------------------------
  1079.   CALL WPRINT(3, "  REVSCRN (X1,Y1,X2,Y2)")
  1080.   CALL WPRINT(1, "  REVSCRN~~  Reverses the attributes for all~  or part of the screen")
  1081.   CALL prompt: CALL savescrn: CLS : LOCATE 10, 1
  1082.   PRINT "Upon executing CALL REVSCRN(10,5,70,17), this part of the screen is reversed...";
  1083.   LOCATE 12, 17: COLOR 6, 1
  1084.   PRINT "Regardless of the number of color combinations."
  1085.   CALL prompt: CALL REVSCRN(10, 5, 70, 17): COLOR 7, 1
  1086.   CALL prompt: CALL restorescrn
  1087. END SUB
  1088.  
  1089.