home *** CD-ROM | disk | FTP | other *** search
/ Vectronix 2 / VECTRONIX2.iso / FILES_01 / HISOFT.LZH / HISOFT_A.MSA / HGT / XFORMDO.BAS < prev   
BASIC Source File  |  1993-09-22  |  8KB  |  296 lines
  1. 'needs toolbox.bas
  2.  
  3. ' Returns the object number of this object's parent or -1 if it is the root
  4. FUNCTION GetParent(VAL index)
  5. STATIC nextindex
  6.     IF Index=0 THEN
  7.         GetParent=-1
  8.     ELSE
  9.         DO
  10.             nextindex=Getob_next(index)
  11.             IF Getob_tail(nextindex)=index THEN EXIT LOOP
  12.             index=nextindex
  13.         LOOP
  14.         GetParent=nextindex
  15.     END IF
  16. END FUNCTION
  17.  
  18. ' returns TRUE if PossChild is a child (or the same as) Parent
  19. '    in tree ObjTree.
  20. FUNCTION IsChild(VAL parent, VAL PossChild)
  21. STATIC current
  22. IF parent=0 THEN ischild=-1:EXIT FUNCTION
  23.     current=PossChild
  24.     DO
  25.         IF current=parent THEN
  26.             IsChild=-1
  27.             EXIT LOOP
  28.         END IF
  29.         current=GetParent(current)
  30.         IF current<0 THEN
  31.             IsChild=0
  32.             EXIT FUNCTION
  33.         END IF
  34.     LOOP
  35. END FUNCTION
  36.  
  37.  
  38. FUNCTION too_deep(BYVAL start,BYVAL obj,BYVAL depth)
  39. STATIC how_deep
  40. IF depth=10 OR depth=0 THEN 
  41.     too_deep=0
  42.     EXIT FUNCTION
  43. END IF
  44. how_deep=0
  45. DO
  46.     obj=getparent(obj) 
  47.     INCR how_deep
  48. LOOP UNTIL obj=-1 OR obj=start
  49. IF how_deep>depth THEN too_deep=-1 ELSE too_deep=0
  50. END FUNCTION
  51.  
  52. 'work out which objects need underlines
  53. SUB show_cuts(BYVAL object,BYVAL depth)
  54. STATIC i,type,flags
  55. SHARED sysfont_h,sysfont_w
  56. graf_mouse 256,0
  57. junk=graf_handle(sysfont_w,sysfont_h,0,0)
  58. i=object
  59. DO
  60.     type=getob_type(i)
  61.     flags=getob_flags(i)
  62.     IF type AND &hFF00 THEN                                        'it's xtended type
  63.         IF flags AND (mask_selectable OR mask_exit OR mask_touchexit) THEN     'if it selectable,exit...
  64.             IF (flags AND mask_hidetree)=0 THEN                'and not hidden
  65.                 IF NOT too_deep(object,i,depth) THEN        'if obj depth is within requested depth
  66.                     IF ischild(object,i) THEN work_underline i,type    'underline it
  67.                 END IF
  68.             END IF
  69.         END IF
  70.     END IF
  71. INCR i
  72. LOOP UNTIL depth=0 OR (flags AND mask_lastob)
  73. graf_mouse 257,0
  74. END SUB
  75.  
  76. ' extract a te_just record
  77. FUNCTION Gette_just(BYVAL object)
  78. STATIC t&
  79. t&=Getob_spec&(object)
  80. gette_just=PEEKW(t&+te_just)
  81. END FUNCTION
  82.  
  83. ' extract a te_font record
  84. FUNCTION Gette_font(BYVAL object)
  85. STATIC t&
  86. t&=Getob_spec&(object)
  87. gette_font=PEEKW(t&+te_font)
  88. END FUNCTION
  89.  
  90. 'workout location for underline
  91. SUB work_underline(BYVAL obj,BYVAL type)
  92. STATIC x,y,w,h,text$,chpos,text_w,char_h,char_w,x2,just,ch_x,ascii
  93. SHARED sysfont_h,sysfont_w
  94. ascii=type\256                                                        'this is the ascii code
  95. type=type AND &hFF                                                'clean type
  96. char_h=sysfont_h:char_w=sysfont_w                            'char dimension
  97. IF type=G_BUTTON OR type=G_STRING THEN                        'get text string in object
  98.     text$=getob_spec$(obj)
  99. ELSEIF type=G_TEXT OR type=G_BOXTEXT THEN
  100.     text$=gette_ptext$(obj)
  101.     IF gette_font(obj)=5 THEN char_h=6:char_w=6            'if small font change char dimensions
  102. ELSE
  103.     EXIT SUB
  104. END IF
  105. junk=objc_offset(tree&,obj,x,y)                                'get objct co-ordinates
  106. w=getob_width(obj)    
  107. h=getob_height(obj)
  108. text_w=LEN(text$)*char_w                                        'text width
  109. chpos=INSTR(UCASE$(text$),UCASE$(CHR$(ascii)))            'find char in objct
  110. IF chpos THEN                                                        'if found
  111.     ch_x=(chpos-1)*char_w                                        'find x offset of char
  112.     IF type=G_BUTTON THEN
  113.         x=x+(w-text_w)\2+ch_x
  114.     ELSEIF type=G_TEXT OR type=G_BOXTEXT THEN
  115.         just=gette_just(obj)
  116.         SELECT CASE just
  117.             CASE=2:x=x+(w-text_w)\2+ch_x
  118.             CASE=0:x=x+ch_x
  119.             CASE ELSE:x=x+w-text_w+ch_x
  120.         END SELECT
  121.     ELSEIF type=G_STRING THEN
  122.         x=x+ch_x
  123.     END IF
  124.     y=y+(h-char_h)\2+char_h-1                                    'find y
  125.     IF (getob_flags(obj) AND mask_3d)=fl3dact THEN 
  126.         IF aes_version>=&h340 THEN DECR x                    'activator
  127.     END IF
  128.     x2=x+char_w-1
  129.     draw_underline obj,x,y,x2
  130. END IF
  131. END SUB
  132.  
  133. SUB draw_underline(BYVAL obj,BYVAL x1,BYVAL y1,BYVAL x2)
  134. STATIC p()
  135. REDIM p(3)
  136. p(0)=x1:p(1)=y1:p(2)=x2:p(3)=y1
  137. IF Curob_state(obj,mask_selected) THEN
  138.     vsl_color 0
  139.     IF (getob_flags(obj) AND mask_3d)=fl3dact THEN 
  140.         IF aes_version>=&h340 THEN vsl_color 1 
  141.     END IF
  142. ELSE 
  143.     vsl_color 1
  144. END IF
  145. v_pline 2,p()
  146. END SUB
  147.  
  148. FUNCTION xform_keybd(BYVAL cur_edit,BYVAL kstate,new_edit,kr,idx)
  149. STATIC valid$,nkr
  150. SELECT CASE kr
  151.     CASE=&h4b34        'shift+left
  152.         junk=objc_edit(tree&,cur_edit,kr,idx,3)
  153.         idx=0
  154.         junk=objc_edit(tree&,cur_edit,kr,idx,3)
  155.         kr=0
  156.         xform_keybd=1
  157.     CASE=&h4d36        'shift+right
  158.         junk=objc_edit(tree&,cur_edit,kr,idx,3)
  159.         junk=objc_edit(tree&,cur_edit,kr,idx,1)
  160.         kr=0
  161.         xform_keybd=1
  162.     CASE ELSE
  163.         IF kr=&h5032 OR kr=&h4838 THEN kr=kr AND &hFF00            'shift+up/down cursor fix
  164.         IF kr=&h0f09 AND (kstate AND 3) THEN kr=&h0f00            'backtab
  165.         xform_keybd=form_keybd(tree&,0,cur_edit,kr,new_edit,kr)
  166. END SELECT
  167. END FUNCTION
  168.  
  169. SUB xobjc_change(BYVAL object,BYVAL x,BYVAL y,BYVAL w,BYVAL h,BYVAL newstate,BYVAL flag)
  170. junk=objc_change(tree&,object,x,y,w,h,newstate,flag)
  171. vs_clip 1,x,y,w,h
  172. IF flag THEN show_cuts object,0
  173. END SUB
  174.  
  175. SUB xobjc_draw(BYVAL object,BYVAL depth,BYVAL x,BYVAL y,BYVAL w,BYVAL h)
  176. STATIC inf()
  177. REDIM inf(5)
  178. junk=objc_draw(tree&,object,depth,x,y,w,h)
  179. vql_attributes inf()
  180. vsl_type 1:vswr_mode 1:vsl_ends 0,0:vsl_width 1
  181. IF x>0 AND y>0 AND w>0 AND h>0 THEN vs_clip 1,x,y,x+w-1,y+h-1
  182. show_cuts object,depth
  183. 'vs_clip 0,0,0,0,0
  184. vsl_type inf(0):vsl_color inf(1):vswr_mode inf(2)
  185. vsl_ends inf(3),inf(4):vsl_width inf(5)
  186. END SUB    
  187.  
  188. 'there was an alt+keypress, check if any object fits
  189. FUNCTION formcuts(BYVAL keypress,BYVAL undo_obj)
  190. STATIC i,xtype,ascii
  191. IF keypress=&h6100 THEN 
  192.     formcuts=undo_obj
  193.     EXIT FUNCTION
  194. END IF
  195. ascii=convertalt(keypress AND &hFF00)
  196. FOR i=1 TO 255
  197.     xtype=getob_type(i)\256
  198.     IF ascii=xtype THEN 
  199.         formcuts=i
  200.         EXIT FOR
  201.     ELSE formcuts=0
  202.     END IF
  203.     IF curob_flags(i,mask_lastob) THEN EXIT FOR
  204. NEXT i
  205. END FUNCTION
  206.  
  207. FUNCTION xform_do(BYVAL new_edit,BYVAL exit_obj,button)
  208. STATIC cont,cur_edit,idx,ev,x,y,br,kr,kstate
  209. STATIC mclicks,mmask,mstate,old_edit
  210. SHARED mouse_detect_both
  211. junk=wind_update(1)
  212. junk=wind_update(3)
  213. IF mouse_detect_both THEN
  214.     mclicks=258
  215.     mmask=3
  216.     mstate=0
  217. ELSE
  218.     mclicks=2
  219.     mmask=1
  220.     mstate=1
  221. END IF    
  222. cont=1
  223. old_edit=0
  224. cur_edit=0
  225. WHILE cont
  226.     IF new_edit<>0 AND cur_edit<>new_edit THEN
  227.         cur_edit=new_edit
  228.         new_edit=0
  229.         junk=objc_edit(tree&,cur_edit,0,idx,1)
  230.     END IF
  231.     ev=evnt_multi(mu_keybd+mu_button,mclicks,mmask,mstate,_
  232.                             0,0,0,0,0,_
  233.                             0,0,0,0,0,_
  234.                             0,0,_
  235.                             x,y,button,kstate,kr,br)
  236.     IF ev AND mu_keybd THEN
  237.         IF kstate=8 OR kr=&h6100 THEN
  238.             new_edit=formcuts(kr,exit_obj)
  239.             old_edit=new_edit
  240.             IF new_edit THEN cont=form_button(tree&,new_edit,br,new_edit)
  241.         ELSE
  242.             cont=xform_keybd(cur_edit,kstate,new_edit,kr,idx)
  243.             IF kr THEN junk=objc_edit(tree&,cur_edit,kr,idx,2)
  244.         END IF
  245.     END IF
  246.     IF ev AND mu_button THEN
  247.         new_edit=objc_find(tree&,0,10,x,y)
  248.         IF new_edit=-1 THEN 
  249.             BEEP        
  250.             new_edit=0
  251.         ELSE
  252.             old_edit=new_edit
  253.             cont=form_button(tree&,new_edit,br,new_edit)
  254.         END IF
  255.     END IF
  256.     IF (NOT cont AND (new_edit<>0 AND new_edit<>cur_edit)) THEN
  257.         junk=objc_edit(tree&,cur_edit,0,idx,3)
  258.     END IF
  259.     IF old_edit THEN
  260.         IF getob_type(old_edit) AND &hFF00 THEN
  261.             IF curob_flags(old_edit,mask_rbutton) THEN 
  262.                 old_edit=getparent(old_edit)
  263.             END IF
  264.             show_cuts getparent(old_edit),10
  265.         END IF
  266.     END IF
  267. WEND
  268. junk=wind_update(2)
  269. junk=wind_update(0)
  270. xform_do=new_edit
  271. END FUNCTION
  272.  
  273. ' a general routine to produce a dialog box and handle interaction
  274. ' the return result is the exit object number
  275. ' button will contain the button state on exit
  276. ' if the global variable mouse_detect_both is non-zero
  277. FUNCTION xHandleDialog(BYVAL editnum,BYVAL exit_obj,button)
  278. STATIC x,y,w,h,but
  279. form_center tree&,x,y,w,h
  280. form_dial FMD_START,0,0,0,0,x,y,w,h
  281. 'form_dial FMD_GROW,x+w\2,y+h\2,0,0,x,y,w,h
  282. xobjc_draw 0,10,x,y,w,h
  283. but=xform_do(editnum,exit_obj,button) AND &h7fff
  284. 'form_dial FMD_SHRINK,x+w\2,y+h\2,0,0,x,y,w,h
  285. form_dial FMD_FINISH,0,0,0,0,x,y,w,h
  286. IF curob_state(but,mask_selected) THEN
  287.     Exclob_state but,mask_selected
  288. END IF
  289. xHandleDialog=but
  290. END FUNCTION
  291.  
  292. 'sets the keyboard shortcut for an object
  293. SUB Setob_scut(BYVAL object,BYVAL ch$)
  294. POKEB ObjectAddr&(object)+ob_type,ASC(UCASE$(ch$))
  295. END SUB
  296.