home *** CD-ROM | disk | FTP | other *** search
/ HTBasic 9.3 / HTBasic 9.3.iso / 93win / data1.cab / Basic_Plus_Examples / SLIDRTST < prev    next >
Encoding:
Text File  |  2005-03-02  |  5.1 KB  |  156 lines
  1. 10    ! ******************************************************************
  2. 20    ! Example: SLIDER Test
  3. 30    !
  4. 40    ! This program consists of a SLIDER and a LABEL in a PANEL with
  5. 50    ! a pulldown menu system. You set the SLIDER to a value, and the
  6. 60    ! LABEL shows the value.
  7. 70    !
  8. 80    ! ******************************************************************
  9. 90    !
  10. 100    ! Define colors
  11. 110   !
  12. 120       INTEGER Black,White,Red,Yellow,Green,Cyan,Blue,Magenta
  13. 130       DATA 0,1,2,3,4,5,6,7
  14. 140       READ Black,White,Red,Yellow,Green,Cyan,Blue,Magenta
  15. 150   !
  16. 160   ! Log and Direct are flags for LOGARITHMIC and DIRECT MOVE mode
  17. 170   ! settings. V is the value returned from the SLIDER.
  18. 180   !
  19. 190       INTEGER Log,Direct
  20. 200       REAL V
  21. 210   !
  22. 220   ! Variables for display handling
  23. 230   !
  24. 240       INTEGER Nlines,D(1:4),Dw,Dh,Iw,Ih,Gx,Gy! Display size parameters
  25. 250       INTEGER Pw,Ph,Px,Py                ! PANEL parameters
  26. 260       INTEGER Lx,Ly,Lw,Lh,Sx,Sy,Sw,Sh    ! LABEL & SLIDER parameters
  27. 270   !
  28. 280   ! Get display size
  29. 290   !
  30. 300       STATUS CRT,13;Nlines
  31. 310       GESCAPE CRT,3;D(*)
  32. 320       Dw=D(3)-D(1)
  33. 330       Dh=(D(4)-D(2))*((Nlines-7)/Nlines)
  34. 340   !
  35. 350   ! Set main PANEL dimensions and origin
  36. 360   !
  37. 370       Pw=Dw*.35
  38. 380       Ph=Dh*.8
  39. 390       Px=(Dw-Pw)/2
  40. 400       Py=(Dh-Ph)/2
  41. 410   !
  42. 420   ! Build main PANEL
  43. 430   !
  44. 440       CLEAR SCREEN
  45. 450       ASSIGN @Main TO WIDGET "PANEL";SET ("VISIBLE":0)
  46. 460       CONTROL @Main;SET ("X":Px,"Y":Py,"WIDTH":Pw,"HEIGHT":Ph)
  47. 470       CONTROL @Main;SET ("RESIZABLE":0,"MAXIMIZABLE":0)
  48. 480       CONTROL @Main;SET ("BACKGROUND":9,"TITLE":" Example: SLIDER Test")
  49. 490   !
  50. 500   ! Build menu
  51. 510   !
  52. 520       ASSIGN @Menu TO WIDGET "PULLDOWN MENU";PARENT @Main
  53. 530       CONTROL @Menu;SET ("LABEL":" Menu")
  54. 540       ASSIGN @Log TO WIDGET "MENU BUTTON";PARENT @Menu
  55. 550       CONTROL @Log;SET ("LABEL":" Set LOG mode")
  56. 560       Log=0
  57. 570       ASSIGN @Direct TO WIDGET "MENU BUTTON";PARENT @Menu
  58. 580       CONTROL @Direct;SET ("LABEL":" Set DIRECT MOVE")
  59. 590       Direct=0
  60. 600       ASSIGN @S1 TO WIDGET "MENU SEPARATOR";PARENT @Menu
  61. 610       ASSIGN @Quit TO WIDGET "MENU BUTTON";PARENT @Menu
  62. 620       CONTROL @Quit;SET ("LABEL":" Quit")
  63. 630   !
  64. 640   ! PANEL done, get inside dimensions
  65. 650   !
  66. 660       STATUS @Main;RETURN ("INSIDE WIDTH":Iw,"INSIDE HEIGHT":Ih)
  67. 670   !
  68. 680   ! Set widget parameters
  69. 690   !
  70. 700       Gx=Iw*.1                ! Set gaps
  71. 710       Gy=Ih*.05
  72. 720       Lx=Gx                   ! Position & size LABEL
  73. 730       Ly=Gy
  74. 740       Lw=Iw*.4
  75. 750       Lh=Iw*.2
  76. 760       Sx=Lx+Lw+Gx             ! Position & size SLIDER
  77. 770       Sy=Gy
  78. 780       Sw=Iw-(Sx+Gx)
  79. 790       Sh=Ih-(2*Gy)
  80. 800   !
  81. 810   ! Create LABEL widget
  82. 820   !
  83. 830       ASSIGN @Label TO WIDGET "LABEL";PARENT @Main
  84. 840       CONTROL @Label;SET ("X":Lx,"Y":Ly,"WIDTH":Lw,"HEIGHT":Lh)
  85. 850       CONTROL @Label;SET ("BACKGROUND":1,"PEN":Black)
  86. 860   !
  87. 870   ! Create SLIDER widget
  88. 880   !
  89. 890       ASSIGN @Slider TO WIDGET "SLIDER";PARENT @Main
  90. 900       CONTROL @Slider;SET ("X":Sx,"Y":Sy,"WIDTH":Sw,"HEIGHT":Sh)
  91. 910       CONTROL @Slider;SET ("AUTO REPEAT":1,"LOGARITHMIC":0)
  92. 920       CONTROL @Slider;SET ("MAXIMUM":100,"MINIMUM":1)
  93. 930       CONTROL @Slider;SET ("MAJOR INCREMENT":10,"MINOR INCREMENT":1)
  94. 940   !
  95. 950   ! Enable events
  96. 960   !
  97. 970       ON EVENT @Log,"ACTIVATED" GOSUB Set_log
  98. 980       ON EVENT @Direct,"ACTIVATED" GOSUB Set_direct
  99. 990       ON EVENT @Slider,"CHANGED" GOSUB Set_label
  100. 1000       ON EVENT @Quit,"ACTIVATED" GOTO Finis
  101. 1010  !
  102. 1020  ! Initialize menu labels, make all widgets visible
  103. 1030  !
  104. 1040       GOSUB Set_label
  105. 1050       CONTROL @Main;SET ("VISIBLE":1)
  106. 1060  !
  107. 1070  ! Wait for event to happen
  108. 1080  !
  109. 1090       LOOP
  110. 1100           WAIT FOR EVENT
  111. 1110       END LOOP
  112. 1120       STOP
  113. 1130  !
  114. 1140  ! ********* Subroutines *****************
  115. 1150  !
  116. 1160  ! Toggle between log and linear mode
  117. 1170  !
  118. 1180  Set_log:!
  119. 1190       SELECT Log
  120. 1200       CASE 0
  121. 1210           CONTROL @Slider;SET ("LOGARITHMIC":1)
  122. 1220           CONTROL @Log;SET ("LABEL":"Set LINEAR Mode")
  123. 1230           Log=1
  124. 1240       CASE 1
  125. 1250           CONTROL @Slider;SET ("LOGARITHMIC":0)
  126. 1260           CONTROL @Log;SET ("LABEL":"Set LOG Mode")
  127. 1270           Log=0
  128. 1280       END SELECT
  129. 1290       RETURN
  130. 1300  !
  131. 1310  ! Toggle DIRECT MOVE on or off
  132. 1320  !
  133. 1330  Set_direct:!
  134. 1340       SELECT Direct
  135. 1350       CASE 0
  136. 1360           CONTROL @Slider;SET ("DIRECT MOVE":1)
  137. 1370           CONTROL @Direct;SET ("LABEL":"Clear DIRECT MOVE")
  138. 1380           Direct=1
  139. 1390       CASE 1
  140. 1400           CONTROL @Slider;SET ("DIRECT MOVE":0)
  141. 1410           CONTROL @Direct;SET ("LABEL":"Set DIRECT MOVE")
  142. 1420           Direct=0
  143. 1430       END SELECT
  144. 1440       RETURN
  145. 1450  !
  146. 1460  ! Set label value from SLIDER widget
  147. 1470  !
  148. 1480  Set_label:!
  149. 1490       STATUS @Slider;RETURN ("VALUE":V)
  150. 1500       CONTROL @Label;SET ("VALUE":V)
  151. 1510       RETURN
  152. 1520  !
  153. 1530  Finis:!
  154. 1540       ASSIGN @Main TO *! Delete PANEL widget
  155. 1550       END
  156.