home *** CD-ROM | disk | FTP | other *** search
/ HTBasic 9.3 / HTBasic 9.3.iso / 93win / data1.cab / Basic_Plus_Examples / BMAPWDGT < prev    next >
Encoding:
Text File  |  2005-03-02  |  6.9 KB  |  187 lines
  1. 10   ! ***********************************************************
  2. 20   ! Example: BITMAP Widget
  3. 40   ! This program demonstrates the use of the BITMAP widget. It
  4. 50   ! allows you to bring in and display bitmaps, as well as select
  5. 60   ! portions of them and save them in a file.
  6. 80   ! It also demonstrates the SCROLLABLE attribute for the PANEL,
  7. 90   ! such as the various operations needed to make SCROLL WIDTH
  8. 100   ! and SCROLL HEIGHT as correct as possible.
  9. 120   ! ***********************************************************
  10. 140   ! Variables used:
  11. 160   !   S$:   General-purpose string
  12. 170   !   N:    General-purpose variable
  13. 180   !   Btn:  Returns button value from dialogs
  14. 190   !   Sc:   Scroll factor
  15. 200   !   Bitfile$: Name of bitmap file to be read
  16. 210   !   Dirname$: Directory name returned from FILE dialog
  17. 220   !   B1$(*):   Stores MENU BUTTONS
  18. 230   !   A1$,A2$:  Stores dialog attributes
  19. 240       DIM S$[256]
  20. 280       INTEGER N,Btn,Sc
  21. 290       DIM Bitfile$[100],Dirname$[100],Btns$(1:2)[50],A1$[50],A2$[50]
  22. 310       DATA "BMP File","Cancel","DIALOG BUTTONS","SELECTION",20
  23. 320       READ Btns$(*),A1$,A2$,Sc
  24. 330 !
  25. 340   ! Widget dimensions
  26. 350 !
  27. 360       INTEGER Pw,Ph,Px,Py,Iw,Ih,Ww,Wh,Wx,Wy
  28. 370 !
  29. 380   ! Variables for display scaling
  30. 390 !
  31. 400       INTEGER Cursor,D(1:4),Dw,Dh
  32. 410 !
  33. 420   ! Get display size
  34. 430 !
  35. 440       GESCAPE CRT,3;D(*)
  36. 450       Dw=D(3)-D(1)
  37. 460       Dh=D(4)-D(2)
  38. 470 !
  39. 480       CLEAR SCREEN
  40. 490 !
  41. 500       Pw=Dw*.7! PANEL width
  42. 510       Ph=Dh*.7! PANEL height
  43. 520       Px=(Dw-Pw)/2! Center PANEL
  44. 530       Py=(Dh-Ph)/2
  45. 540 !
  46. 550   ! Create PANEL for BITMAP widget. The SCROLL WIDTH and
  47. 560   ! HEIGHT are set to a small value so that scroll bars
  48. 570   ! will not appear initially. The actual heights are set
  49. 580   ! later to fit the bitmap that has been loaded.
  50. 590 !
  51. 600       ASSIGN @Main TO WIDGET "PANEL";SET ("VISIBLE":0)
  52. 610       CONTROL @Main;SET ("X":Px,"Y":Py,"WIDTH":Pw,"HEIGHT":Ph)
  53. 620       CONTROL @Main;SET ("TITLE":" Example: BITMAP Widget")
  54. 630       CONTROL @Main;SET ("SIZE CONTROL":"SCROLLABLE","MINIMIZABLE":1)
  55. 640       CONTROL @Main;SET ("SCROLL WIDTH":1,"SCROLL WIDTH UNITS":Sc)
  56. 650       CONTROL @Main;SET ("SCROLL HEIGHT":1,"SCROLL HEIGHT UNITS":Sc)
  57. 660 !
  58. 670   ! Build menu
  59. 680 !
  60. 690       ASSIGN @Menu TO WIDGET "PULLDOWN MENU";PARENT @Main
  61. 700       CONTROL @Menu;SET ("LABEL":"Menu")
  62. 710       ASSIGN @Getfile TO WIDGET "MENU BUTTON";PARENT @Menu
  63. 720       CONTROL @Getfile;SET ("LABEL":"Get Bitmap File")
  64. 730       ASSIGN @Savefile TO WIDGET "MENU BUTTON";PARENT @Menu
  65. 740       CONTROL @Savefile;SET ("LABEL":"Cut Bitmap To File")
  66. 750       ASSIGN @Cd TO WIDGET "MENU BUTTON";PARENT @Menu
  67. 760       CONTROL @Cd;SET ("LABEL":"Change Directory")
  68. 770       ASSIGN @S TO WIDGET "MENU SEPARATOR";PARENT @Menu
  69. 780       ASSIGN @Quit TO WIDGET "MENU BUTTON";PARENT @Menu
  70. 790       CONTROL @Quit;SET ("LABEL":"Quit")
  71. 800 !
  72. 810   ! Create and size BITMAP widget. (Setting RETAIN RASTER makes
  73. 820   ! the widget redraw quickly when overwritten by a dialog.)
  74. 830 !
  75. 840       ASSIGN @Bitmap TO WIDGET "BITMAP";PARENT @Main
  76. 850       CONTROL @Bitmap;SET ("RETAIN RASTER":1,"AUTO SIZE":1)
  77. 860       STATUS @Main;RETURN ("INSIDE WIDTH":Iw,"INSIDE HEIGHT":Ih)
  78. 870       Wx=Iw*.01
  79. 880       Wy=Ih*.01
  80. 890       Wh=Ih*.98
  81. 900       Ww=Iw*.98
  82. 910       CONTROL @Bitmap;SET ("X":Wx,"Y":Wy,"WIDTH":Ww,"HEIGHT":Wh)
  83. 920 !
  84. 930   ! Set events
  85. 940 !
  86. 950       ON EVENT @Getfile,"ACTIVATED" GOSUB Getbitfile
  87. 960       ON EVENT @Savefile,"ACTIVATED" GOSUB Savebits
  88. 970       ON EVENT @Cd,"ACTIVATED" GOSUB Chdir
  89. 980       ON EVENT @Quit,"ACTIVATED" GOTO Finis
  90. 990 !
  91. 1000       CONTROL @Main;SET ("VISIBLE":1)
  92. 1010 !
  93. 1020  ! Loop and wait for input
  94. 1030 !
  95. 1040       LOOP
  96. 1050           WAIT FOR EVENT
  97. 1060       END LOOP
  98. 1070       STOP
  99. 1080 !
  100. 1090  ! ************** End of Main Program **********************
  101. 1100 !
  102. 1110  ! This routine gets a bitmap file and displays it. It gets
  103. 1120  ! the bitmap size and sets up PANEL scrolling accordingly.
  104. 1130  ! Also, it makes the BITMAP widget invisible so the display
  105. 1140  ! will "thrash" as little as possible.
  106. 1150 !
  107. 1160  Getbitfile:                     !
  108. 1170       S$="Please enter the name of a bitmap (.BMP) file:"
  109. 1180       DIALOG "FILE",S$,Btn;RETURN ("SELECTION":Bitfile$)
  110. 1190 !
  111. 1200       IF Btn=0 THEN
  112. 1210           CLEAR ERROR
  113. 1220           ON ERROR GOSUB Errtrap
  114. 1230           CONTROL @Bitmap;SET ("VISIBLE":0,"BITMAP FILE":Bitfile$)
  115. 1240           OFF ERROR
  116. 1250           IF ERRN<>0 THEN
  117. 1260               DIALOG "ERROR","Can't open file / invalid bitmap file."
  118. 1270               CONTROL @Bitmap;SET ("BITMAP FILE":"","VISIBLE":1)
  119. 1280           ELSE
  120. 1290               CONTROL @Bitmap;SET ("VISIBLE":0)
  121. 1300               STATUS @Bitmap;RETURN ("BITMAP HEIGHT":Wh,"BITMAP WIDTH":Ww)
  122. 1310               CONTROL @Main;SET ("SCROLL HEIGHT":2+INT(Wh/Sc))
  123. 1320               CONTROL @Main;SET ("SCROLL WIDTH":2+INT(Ww/Sc))
  124. 1330               CONTROL @Bitmap;SET ("VISIBLE":1)
  125. 1340               DIALOG "INFORMATION","File read completed"
  126. 1350           END IF
  127. 1360       END IF
  128. 1370       RETURN
  129. 1380 !
  130. 1390  ! This routine allows you to cut a section of a bitmap and
  131. 1400  ! save it in a file. String variables are used in the FILE
  132. 1410  ! dialog to specify the DIALOG BUTTONS attribute and the
  133. 1420  ! SELECTION attribute to keep a compact statement length.
  134. 1430 !
  135. 1440  Savebits:               !
  136. 1450       S$="Enter file name, then click-and-drag image to save:"
  137. 1460       DIALOG "FILE",S$,Btn;SET (A1$:Btns$(*)),RETURN (A2$:Bitfile$)
  138. 1470 !
  139. 1480       SELECT Btn
  140. 1490       CASE 0
  141. 1500           S$="BMP"! Dump format is MS-Windows .BMP file.
  142. 1510       CASE 2
  143. 1540           RETURN
  144. 1550       END SELECT
  145. 1560 !
  146. 1570       CLEAR ERROR
  147. 1580       ON ERROR GOSUB Errtrap
  148. 1590       CONTROL @Bitmap;SET ("DUMP FORMAT":S$,"DUMP AREA":Bitfile$)
  149. 1600       OFF ERROR
  150. 1610       IF ERRN<>0 THEN
  151. 1620           DIALOG "ERROR","Can't open file."
  152. 1630       ELSE
  153. 1640           DIALOG "INFORMATION","Bitmap saved to "&S$&" file."
  154. 1650       END IF
  155. 1660 !
  156. 1670       RETURN
  157. 1680       !
  158. 1690       !
  159. 1700       !
  160. 1710       !
  161. 1720 !
  162. 1730  ! This routine changes directories
  163. 1740 !
  164. 1750  Chdir:      !
  165. 1760       S$="Please enter the name of a directory:"
  166. 1770       DIALOG "FILE",S$,Btn;RETURN ("DIRECTORY":Dirname$)
  167. 1780       DIM Retstr$[260]
  168. 1790       Err=0
  169. 1860       CLEAR ERROR
  170. 1870       ON ERROR GOSUB Errtrap
  171. 1880       MASS STORAGE IS Dirname$
  172. 1890       OFF ERROR
  173. 1900       IF ERRN<>0 THEN
  174. 1910           DIALOG "ERROR","Can't change directory"
  175. 1920       END IF
  176. 1930       RETURN
  177. 1940 !
  178. 1950  ! Dummy routine for trapping errors
  179. 1960 !
  180. 1970  Errtrap: ERROR RETURN
  181. 1980 !
  182. 1990  Finis:      !
  183. 2000       DLL UNLOAD ALL
  184. 2010       ASSIGN @Main TO *! Delete PANEL widget
  185. 2020       CLEAR SCREEN
  186. 2030       END
  187.