home *** CD-ROM | disk | FTP | other *** search
/ HTBasic 9.3 / HTBasic 9.3.iso / 83win / data1.cab / Basic_Plus_Examples / MENUSYST < prev    next >
Encoding:
Text File  |  2001-03-02  |  9.4 KB  |  272 lines
  1. 10    ! *******************************************************************
  2. 20    ! Example: Menu System
  3. 30    !
  4. 40    ! This program demonstrates how to build a pulldown menu system.
  5. 50    ! It builds a panel with a menu and a printer widget to tell you
  6. 60    ! the menu entry you clicked.
  7. 70    !
  8. 80    ! ********************************************************************
  9. 90    !
  10. 100       INTEGER Black,White,Red,Yellow,Green,Blue,Cyan,Magenta
  11. 110       DATA 0,1,2,3,4,5,6,7
  12. 120       READ Black,White,Red,Yellow,Green,Blue,Cyan,Magenta
  13. 130   !
  14. 140   ! Define some variables:
  15. 150   !
  16. 160   !    S$:          General-purpose string variable
  17. 170   !    M$(*):       System menu elements
  18. 180   !    State:       Gets state of MENU TOGGLE widgets
  19. 190   !    N:           General-purpose INTEGER variable
  20. 200   !    D(*):        Array to get hard-clip values
  21. 210   !    Dw,Dh:       Display dimensions
  22. 220   !    X,Y:         Location of main PANEL
  23. 230   !    Panelwidth, Panelheight:  Dimensions for main PANEL
  24. 240   !    Prx,Pry,Prwidth,Prheight: Location & dimensions of main PANEL
  25. 250   !    Ih,Iw:       Interior dimensions of PANEL
  26. 260   !
  27. 270   ! The main panel is set up so it automatically scales to the
  28. 280   ! entire display, except for the DISP, INPUT, and softkeys lines.
  29. 290   !
  30. 300       DIM S$[80],M$(0:2)[80]
  31. 310       INTEGER State,N,D(1:4)
  32. 320       INTEGER Dw,Dh,X,Y
  33. 330       INTEGER Panelwidth,Panelheight,Prx,Pry,Prwidth,Prheight,Iw,Ih
  34. 340   !
  35. 350       GESCAPE CRT,3;D(*)
  36. 360       Dw=D(3)-D(1)+1
  37. 370       Dh=D(4)-D(2)+1
  38. 380       Panelwidth=Dw*.75
  39. 390       Panelheight=Dh*.75
  40. 400       X=(Dw-Panelwidth)/2
  41. 410       Y=(Dh-Panelheight)/2
  42. 420   !
  43. 430   ! Create the PANEL widget
  44. 440   !
  45. 450       CLEAR SCREEN
  46. 460       ASSIGN @P TO WIDGET "PANEL";SET ("VISIBLE":0)
  47. 470       CONTROL @P;SET ("RESIZABLE":1)
  48. 480       CONTROL @P;SET ("X":X,"Y":Y,"WIDTH":Panelwidth,"HEIGHT":Panelheight)
  49. 490       CONTROL @P;SET ("TITLE":" Example: Menu System")
  50. 500       CONTROL @P;SET ("MAXIMIZABLE":0,"RESIZABLE":0)
  51. 510   !
  52. 520   ! Create the PULLDOWN MENU widgets, using the PANEL widget as parent
  53. 530   !
  54. 540       S$="PullDown_1"
  55. 550       ASSIGN @Pd1 TO WIDGET "PULLDOWN MENU";PARENT @P,SET ("LABEL":S$)
  56. 560   !
  57. 570       S$="PullDown_2"
  58. 580       ASSIGN @Pd2 TO WIDGET "PULLDOWN MENU";PARENT @P,SET ("LABEL":S$)
  59. 590   !
  60. 600       S$="PullDown_3"
  61. 610       ASSIGN @Pd3 TO WIDGET "PULLDOWN MENU";PARENT @P,SET ("LABEL":S$)
  62. 620   !
  63. 630   ! Now that the PULLDOWN MENU has been set up, get interior dimensions
  64. 640   ! of PANEL and set up PRINTER widget accordingly.
  65. 650   !
  66. 660       STATUS @P;RETURN ("INSIDE WIDTH":Iw,"INSIDE HEIGHT":Ih)
  67. 670       Prx=Iw*.02
  68. 680       Pry=Ih*.02
  69. 690       Prwidth=Iw*.96
  70. 700       Prheight=Ih*.96
  71. 710       ASSIGN @Prn TO WIDGET "PRINTER";PARENT @P
  72. 720       CONTROL @Prn;SET ("X":Prx,"Y":Pry,"WIDTH":Prwidth,"HEIGHT":Prheight)
  73. 730   !
  74. 740   ! Create menu for "PullDown_2" (using @Pd2 as PARENT)
  75. 750   !
  76. 760       S$="Button_1"
  77. 770       ASSIGN @B21 TO WIDGET "MENU BUTTON";PARENT @Pd2,SET ("LABEL":S$)
  78. 780   !
  79. 790       S$="Button_2"
  80. 800       ASSIGN @B22 TO WIDGET "MENU BUTTON";PARENT @Pd2,SET ("LABEL":S$)
  81. 810   !
  82. 820   ! Create menu for "PullDown_3" (using @Pd3 as PARENT)
  83. 830   !
  84. 840       S$="Button_1"
  85. 850       ASSIGN @B31 TO WIDGET "MENU BUTTON";PARENT @Pd3,SET ("LABEL":S$)
  86. 860   !
  87. 870       S$="Button_2"
  88. 880       ASSIGN @B32 TO WIDGET "MENU BUTTON";PARENT @Pd3,SET ("LABEL":S$)
  89. 890   !
  90. 900       S$="Button_3"
  91. 910       ASSIGN @B33 TO WIDGET "MENU BUTTON";PARENT @Pd3,SET ("LABEL":S$)
  92. 920   !
  93. 930       ASSIGN @S34 TO WIDGET "MENU SEPARATOR";PARENT @Pd3
  94. 940   !
  95. 950       S$="Quit"
  96. 960       ASSIGN @Quit TO WIDGET "MENU BUTTON";PARENT @Pd3,SET ("LABEL":S$)
  97. 970   !
  98. 980   ! Create menu for "PullDown_1" (using @Pd1 as PARENT)
  99. 990   !
  100. 1000       S$="Button_1"
  101. 1010       ASSIGN @B11 TO WIDGET "MENU BUTTON";PARENT @Pd1,SET ("LABEL":S$)
  102. 1020  !
  103. 1030  ! Add menu separator
  104. 1040  !
  105. 1050       ASSIGN @S12 TO WIDGET "MENU SEPARATOR";PARENT @Pd1
  106. 1060  !
  107. 1070  ! Add CASCADE MENU widgets to "PullDown_1" (using @Pd1 as PARENT)
  108. 1080  !
  109. 1090       S$="Cascade_1"
  110. 1100       ASSIGN @C13 TO WIDGET "CASCADE MENU";PARENT @Pd1,SET ("LABEL":S$)
  111. 1110  !
  112. 1120       S$="Cascade_2"
  113. 1130       ASSIGN @C14 TO WIDGET "CASCADE MENU";PARENT @Pd1,SET ("LABEL":S$)
  114. 1140  !
  115. 1150  ! Create menu for "Cascade_1" (using @C1 as PARENT)
  116. 1160  !
  117. 1170       S$="Item_1"
  118. 1180       ASSIGN @B131 TO WIDGET "MENU BUTTON";PARENT @C13,SET ("LABEL":S$)
  119. 1190  !
  120. 1200       S$="Item_2"
  121. 1210       ASSIGN @B132 TO WIDGET "MENU BUTTON";PARENT @C13,SET ("LABEL":S$)
  122. 1220  !
  123. 1230       S$="Item_3"
  124. 1240       ASSIGN @B133 TO WIDGET "MENU BUTTON";PARENT @C13,SET ("LABEL":S$)
  125. 1250  !
  126. 1260  ! Create menu for "Cascade_2" (using @C14 as PARENT)
  127. 1270  !
  128. 1280       S$="Toggle_1"
  129. 1290       ASSIGN @T141 TO WIDGET "MENU TOGGLE";PARENT @C14,SET ("LABEL":S$)
  130. 1300  !
  131. 1310       S$="Toggle_2"
  132. 1320       ASSIGN @T142 TO WIDGET "MENU TOGGLE";PARENT @C14,SET ("LABEL":S$)
  133. 1330  !
  134. 1340       S$="Toggle_3"
  135. 1350       ASSIGN @T143 TO WIDGET "MENU TOGGLE";PARENT @C14,SET ("LABEL":S$)
  136. 1360  !
  137. 1370  ! Add "Cascade_3" as entry in "Cascade_2"
  138. 1380  !
  139. 1390       S$="Cascade_3"
  140. 1400       ASSIGN @C144 TO WIDGET "CASCADE MENU";PARENT @C14,SET ("LABEL":S$)
  141. 1410  !
  142. 1420  ! Populate menu for "Cascade_3"
  143. 1430  !
  144. 1440       S$="Toggle_1"
  145. 1450       ASSIGN @T1441 TO WIDGET "MENU TOGGLE";PARENT @C144,SET ("LABEL":S$)
  146. 1460  !
  147. 1470       S$="Button_1"
  148. 1480       ASSIGN @B1442 TO WIDGET "MENU BUTTON";PARENT @C144,SET ("LABEL":S$)
  149. 1490  !
  150. 1500  ! Create SYSTEM MENU
  151. 1510  !
  152. 1520       M$(0)="SysMenu1"
  153. 1530       M$(1)="SysMenu2"
  154. 1540       M$(2)="SysMenu3"
  155. 1550       CONTROL @P;SET ("SYSTEM MENU":M$(*))
  156. 1560  !
  157. 1570       CONTROL @P;SET ("VISIBLE":1)
  158. 1580  !
  159. 1590  ! Set up menu events
  160. 1600  !
  161. 1610       ON EVENT @B11,"ACTIVATED" GOSUB Button11
  162. 1620       ON EVENT @B21,"ACTIVATED" GOSUB Button21
  163. 1630       ON EVENT @B22,"ACTIVATED" GOSUB Button22
  164. 1640       ON EVENT @B31,"ACTIVATED" GOSUB Button31
  165. 1650       ON EVENT @B32,"ACTIVATED" GOSUB Button32
  166. 1660       ON EVENT @B33,"ACTIVATED" GOSUB Button33
  167. 1670       ON EVENT @B131,"ACTIVATED" GOSUB Button131
  168. 1680       ON EVENT @B132,"ACTIVATED" GOSUB Button132
  169. 1690       ON EVENT @B133,"ACTIVATED" GOSUB Button133
  170. 1700       ON EVENT @T141,"CHANGED" GOSUB Toggle141
  171. 1710       ON EVENT @T142,"CHANGED" GOSUB Toggle142
  172. 1720       ON EVENT @T143,"CHANGED" GOSUB Toggle143
  173. 1730       ON EVENT @T1441,"CHANGED" GOSUB Toggle1441
  174. 1740       ON EVENT @B1442,"ACTIVATED" GOSUB Button1442
  175. 1750  !
  176. 1760       ON EVENT @P,"SYSTEM MENU" GOSUB Sysmenu
  177. 1770       ON EVENT @Quit,"ACTIVATED" GOTO Finis
  178. 1780  !
  179. 1790       LOOP
  180. 1800           WAIT FOR EVENT
  181. 1810       END LOOP
  182. 1820       STOP
  183. 1830  !
  184. 1840  ! *************** End of Main Program **************************
  185. 1850  !
  186. 1860  ! The following routines are handlers for the various menu buttons.
  187. 1870  ! They print the menu item description to the PRINTER widget.
  188. 1880  !
  189. 1890  Button11:!
  190. 1900       S$="PullDown_1 / Button_1"
  191. 1910       CONTROL @Prn;SET ("APPEND TEXT":S$)
  192. 1920       RETURN
  193. 1930  !
  194. 1940  Button21:!
  195. 1950       S$="PullDown_2 / Button_1"
  196. 1960       CONTROL @Prn;SET ("APPEND TEXT":S$)
  197. 1970       RETURN
  198. 1980  !
  199. 1990  Button22:!
  200. 2000       S$="PullDown_2 / Button_2"
  201. 2010       CONTROL @Prn;SET ("APPEND TEXT":S$)
  202. 2020       RETURN
  203. 2030  !
  204. 2040  Button31:!
  205. 2050       S$="PullDown_3 / Button_1"
  206. 2060       CONTROL @Prn;SET ("APPEND TEXT":S$)
  207. 2070       RETURN
  208. 2080  !
  209. 2090  Button32:!
  210. 2100       S$="PullDown_3 / Button_2"
  211. 2110       CONTROL @Prn;SET ("APPEND TEXT":S$)
  212. 2120       RETURN
  213. 2130  !
  214. 2140  Button33:!
  215. 2150       S$="PullDown_3 / Button_3"
  216. 2160       CONTROL @Prn;SET ("APPEND TEXT":S$)
  217. 2170       RETURN
  218. 2180  !
  219. 2190  Button131:!
  220. 2200       S$="PullDown_1 / Cascade_1 / Item_1"
  221. 2210       CONTROL @Prn;SET ("APPEND TEXT":S$)
  222. 2220       RETURN
  223. 2230  !
  224. 2240  Button132:!
  225. 2250       S$="PullDown_1 / Cascade_1 / Item_2"
  226. 2260       CONTROL @Prn;SET ("APPEND TEXT":S$)
  227. 2270       RETURN
  228. 2280  !
  229. 2290  Button133:!
  230. 2300       S$="PullDown_1 / Cascade_1 / Item_3"
  231. 2310       CONTROL @Prn;SET ("APPEND TEXT":S$)
  232. 2320       RETURN
  233. 2330  !
  234. 2340  Toggle141:!
  235. 2350       S$="PullDown_1 / Cascade_2 / Toggle_1: "
  236. 2360       STATUS @T141;RETURN ("VALUE":State)
  237. 2370       CONTROL @Prn;SET ("APPEND TEXT":S$&VAL$(State))
  238. 2380       RETURN
  239. 2390  !
  240. 2400  Toggle142:!
  241. 2410       S$="PullDown_1 / Cascade_2 / Toggle_2: "
  242. 2420       STATUS @T142;RETURN ("VALUE":State)
  243. 2430       CONTROL @Prn;SET ("APPEND TEXT":S$&VAL$(State))
  244. 2440       RETURN
  245. 2450  !
  246. 2460  Toggle143:!
  247. 2470       S$="PullDown_1 / Cascade_2 / Toggle_3: "
  248. 2480       STATUS @T143;RETURN ("VALUE":State)
  249. 2490       CONTROL @Prn;SET ("APPEND TEXT":S$&VAL$(State))
  250. 2500       RETURN
  251. 2510  !
  252. 2520  Toggle1441:!
  253. 2530       S$="PullDown_1 / Cascade_2 / Cascade_3 / Toggle_1: "
  254. 2540       STATUS @T1441;RETURN ("VALUE":State)
  255. 2550       CONTROL @Prn;SET ("APPEND TEXT":S$&VAL$(State))
  256. 2560       RETURN
  257. 2570  !
  258. 2580  Button1442:!
  259. 2590       S$="PullDown_1 / Cascade_2 / Cascade_3 / Button_1"
  260. 2600       CONTROL @Prn;SET ("APPEND TEXT":S$)
  261. 2610       RETURN
  262. 2620  !
  263. 2630  Sysmenu:!
  264. 2640       STATUS @P;RETURN ("SYSTEM MENU EVENT":N)
  265. 2650       S$="SYSTEM MENU / SysMenu"&VAL$(N+1)
  266. 2660       CONTROL @Prn;SET ("APPEND TEXT":S$)
  267. 2670       RETURN
  268. 2680  !
  269. 2690  Finis:!
  270. 2700       ASSIGN @P TO *! Delete PANEL widget
  271. 2710       END
  272.