home *** CD-ROM | disk | FTP | other *** search
/ Millennium Time Capsule / AC2000.BIN / disks / ac9_disk / tutorial.s / hbasic06.tut / routines / sharewar.bas next >
Encoding:
BASIC Source File  |  1998-03-29  |  3.0 KB  |  148 lines
  1.  
  2. LIBRARY "gemaes","gemvdi"
  3.  
  4. REM $option k20
  5. REM $option g,y+,v+,u+,#,[,]
  6.  
  7. DEFINT a-z
  8.  
  9. DIM SHARED junk
  10. REM DECLARE FUNCTION Dialog
  11.  
  12. REM $include sharewar.bh
  13. REM $include gemaes.bh
  14.  
  15. DIM SHARED tree&
  16.  
  17. DEF FNObjectAddr&(object)=tree&+object*ob_sizeof
  18. DEF FNGetob_spec&(object)=PEEKL(FNObjectAddr&(object)+ob_spec)
  19.  
  20. SUB Exclob_state(object,flag_mask)
  21. STATIC t&
  22. t&=FNObjectAddr&(object)+ob_state
  23. POKEW    t&,PEEKW(t&) AND (NOT flag_mask)
  24. END SUB
  25.  
  26. SUB SelectTreeAddr(t&)
  27. tree&=t&
  28. END SUB
  29.  
  30. SUB SelectTree(treeno)
  31. STATIC formaddr&
  32.     junk=FNrsrc_gaddr(type_tree,treeno,formaddr&)
  33.     SelectTreeAddr formaddr&
  34. END SUB
  35.  
  36. SUB form_show (dial)
  37. STATIC junk,tree&,x,y,w,h,but,type_tree,treeno,tree&
  38.  
  39. junk=FNrsrc_gaddr(0,dial,tree&)
  40. form_center tree&,x,y,w,h
  41. form_dial FMD_START,0,0,0,0,x,y,w,h
  42. junk=FNobjc_draw(tree&,0,10,x,y,w,h)
  43. END SUB
  44.  
  45. SUB form_show_part (dial, object)
  46. STATIC junk,tree&,x,y,w,h,but,type_tree,treeno,tree&
  47. STATIC x2,y2,w2,h2
  48.  
  49. junk=FNrsrc_gaddr(0,dial,tree&)
  50. form_center tree&,x,y,w,h
  51. SelectTree dial
  52.  
  53. form_dial FMD_START,0,0,0,0,x,y,w,h
  54.  
  55. junk=FNobjc_draw(tree&,object,0,x,y,w,h)
  56.  
  57. END SUB
  58.  
  59. 'Returns the value of the ob_x field in the given object of the current tree
  60. DEF FNGetob_x (object)
  61. FNGetob_x=PEEKW(FNObjectAddr&(object)+ob_x)
  62. END DEF
  63.  
  64. 'Returns the value of the ob_y field in the given object of the current tree
  65. DEF FNGetob_y (object)
  66. FNGetob_y=PEEKW(FNObjectAddr&(object)+ob_y)
  67. END DEF
  68.  
  69. 'Returns the value of the ob_width field in the given object of the current tree
  70. DEF FNGetob_width (object)
  71. FNGetob_width=PEEKW(FNObjectAddr&(object)+ob_width)
  72. END DEF
  73.  
  74. 'Returns the value of the ob_height field in the given object of the current tree
  75. DEF FNGetob_height (object)
  76. FNGetob_height=PEEKW(FNObjectAddr&(object)+ob_height)
  77. END DEF
  78.  
  79. 'Sets the value of the ob_width field in the given object of the current tree
  80. SUB Setob_width (object, value)
  81. POKEW FNObjectAddr&(object)+ob_width,value
  82. END SUB
  83.  
  84. SUB InitResourceFile(name$)
  85. STATIC junk
  86. SHARED resource_loaded
  87. IF FNrsrc_load(name$)=0 THEN
  88.     junk=FNform_alert(1,"[3][ Couldn't find SHAREWAR.RSC! ][ Quit ]")
  89.     SYSTEM
  90. END IF
  91. resource_loaded=-1
  92. END SUB
  93.  
  94. SUB StartProgram (resourcefile$)
  95. WINDOW ON
  96. InitResourceFile resourcefile$
  97. END SUB
  98.  
  99. SUB StopProgram
  100. STATIC junk
  101. junk=FNrsrc_free
  102. STOP -1
  103. END SUB
  104.  
  105.  
  106. SUB GetSetObjects
  107. SHARED wwidth,swidth,spart
  108.  
  109. SelectTree sharedial
  110. wwidth=FNgetob_width (whiteback)
  111.  
  112. setob_width slidebar, 0
  113. swidth=0
  114.  
  115. spart=wwidth/100
  116.  
  117. END SUB
  118.  
  119. SUB do_timer
  120. SHARED swidth,wwidth,spart
  121. SHARED finished
  122.  
  123. swidth=swidth+spart
  124. IF swidth>wwidth THEN
  125.     finished=-1
  126. ELSE
  127.     setob_width slidebar,swidth
  128. '    form_show_part sharedial, whiteback
  129.     form_show_part sharedial, slidebar
  130. END IF
  131.  
  132. END SUB
  133.  
  134. DIM mess(16)
  135. StartProgram "SHAREWAR.RSC"
  136. GetSetObjects
  137.  
  138.     form_show (sharedial)
  139.  
  140. DO
  141.     e=FNevnt_multi(MU_TIMER,0,0,0,0,0,0,0,0,0,0,0,0,0,_
  142.                     VARPTR(mess(0)),100,0,0,0,0,k,0)
  143.  
  144.     IF e AND MU_TIMER THEN CALL do_timer
  145.  
  146. IF finished=-1 THEN CALL StopProgram
  147.  
  148. LOOP