home *** CD-ROM | disk | FTP | other *** search
/ Vectronix 2 / VECTRONIX2.iso / FILES_01 / HISOFT.LZH / HISOFT_A.MSA / HGT / MENU.BAS < prev    next >
BASIC Source File  |  1993-05-25  |  3KB  |  127 lines
  1.  
  2. 'Menu short cut routines for the tool box
  3. CONST MaxShortCut=100
  4.  
  5.  
  6. SUB Record(BYVAL a,BYVAL c,BYVAL o,BYVAL t)
  7. SHARED scShortCuts,scascii(1),scch(1),scobj(1),sctitle(1)
  8.     INCR scShortCuts
  9.     IF scShortCuts>MaxShortCut THEN
  10. ' Error no room for shortcuts
  11.         DECR scShortCuts
  12.     ELSE
  13.         scascii(scShortCuts)=a
  14.         scobj(scShortCuts)=o
  15.         scch(scShortCuts)=c
  16.         sctitle(scShortCuts)=t
  17.     END IF
  18. END SUB
  19.  
  20. SUB ConsiderString(BYVAL obj,BYVAL title,BYVAL st$)
  21. SHARED scspecval(1),scspec$(1),scspcount
  22. STATIC i,j,l,modifier,ch
  23.     i=LEN(st$)
  24.     IF i<1 THEN EXIT SUB
  25.     IF RIGHT$(st$,1)=" " THEN st$=LEFT$(st$,i-1):DECR i
  26.     IF i<3 THEN EXIT SUB
  27. ' Now check the named keys
  28.     FOR j=1 TO scspcount
  29.         l=LEN(scspec$(j))
  30.         IF i>l+2 THEN
  31.             IF RIGHT$(st$,l)=scspec$(j) THEN
  32.                 Record 1,scspecval(j),obj,title
  33.                 EXIT SUB
  34.             END IF
  35.         END IF
  36.     NEXT j
  37.  
  38.     modifier=ASC(MID$(st$,i-1,1))
  39.     ch=ASC(UCASE$(RIGHT$(st$,1)))
  40.     SELECT CASE modifier
  41.     CASE " "%,1:    Record -1,ch,obj,title
  42.     CASE "^"%:        Record -1,ch-&h40,obj,title
  43.     CASE 7:            Record 0,ch,obj,title
  44.     END SELECT
  45.  
  46. END SUB
  47.  
  48. SUB RecordSpecial(a$,BYVAL ScanCode)
  49. SHARED scspec$(1),scspecval(1),scspcount
  50. INCR scspcount
  51. scspec$(scspcount)=a$
  52. scspecval(scspcount)=ScanCode
  53. END SUB
  54.  
  55. SUB ScanMenu
  56. SHARED menutree&,scShortCuts,tree&,scspec$(1),scspecval(1),scspcount
  57. SHARED scascii(1),scch(1),scobj(1),sctitle(1)
  58. STATIC obj,title,oldtree&,typ,i
  59. REDIM scspecval(29),scspec$(29)
  60.  
  61.     scspcount=0
  62.     RecordSpecial "Help",&h6200
  63.     RecordSpecial "Undo",&h6100
  64.     RecordSpecial "BS",&hE08
  65.     RecordSpecial "Del",&h537F
  66.     RecordSpecial "Esc",&h011b
  67.     RecordSpecial "Ins",&h5200
  68.     RecordSpecial "Home",&h4700
  69.     RecordSpecial "Clr",&h4737
  70.     RecordSpecial "Tab",&h0f09
  71.     FOR i=1 TO 10
  72.         RecordSpecial "F"+CHR$(i+"0"%),&h3A00+&h100*i
  73.         RecordSpecial CHR$(1)+"F"+CHR$(i+"0"%),&h5300+&h100*i
  74.     NEXT i
  75.     REDIM scascii(MaxShortCut),scch(MaxShortCut),scobj(MaxShortCut),sctitle(MaxShortCut)
  76.  
  77.     oldtree&=tree&
  78.     SelectTreeAddr menutree&
  79.     obj=0
  80.     scShortCuts=0
  81.     title=1
  82.     DO
  83.         typ=Getob_type(obj)
  84.         SELECT CASE typ
  85.         CASE G_TEXT:
  86.             ConsiderString obj,title,Gette_ptext$(obj)
  87.         CASE G_STRING:
  88.             ConsiderString obj,title,Getob_spec$(obj)
  89.         CASE G_BOX:
  90.             INCR title
  91.         END SELECT
  92.         IF Curob_flags(obj,mask_lastob) THEN EXIT LOOP
  93.         INCR obj
  94.     LOOP
  95. END SUB
  96.  
  97. FUNCTION CreateShortCut(BYVAL Scancode)
  98. SHARED scShortCuts,scascii(1),scch(1),sctitle(1),scobj(1),Mess(1)
  99. STATIC ch,i,Altcode
  100.     ch=Scancode MOD 256
  101.     Altcode=ConvertAlt(ScanCode)
  102.      FOR i=1 TO scShortCuts
  103.         IF (scascii(i)=-1 AND scch(i)=ch) _
  104.         OR (scascii(i)=0 AND ch=0 AND altcode=scch(i)) _
  105.         OR (scascii(i)=1 AND Scancode=scch(i)) THEN
  106.                 CreateShortCut=-1
  107.                 Mess(0)=MN_SELECTED
  108.                 Mess(3)=sctitle(i)
  109.                 Mess(4)=scobj(i)
  110.                 EXIT FUNCTION
  111.         END IF
  112.     NEXT i
  113.     CreateShortCut=0
  114. END FUNCTION
  115.  
  116. 'Initialise the menu system to use the the given treenumber
  117. 'from the resource file. exititem gives the umber of the item
  118. 'that will cause termination
  119. SUB InitMenuSystem(BYVAL treenumber,BYVAL exititem)
  120. SHARED menutree&,exit_item,menus_enabled
  121. junk=rsrc_gaddr(0,treenumber,menutree&)
  122. menu_bar menutree&,1
  123. exit_item=exititem
  124. menus_enabled=-1
  125. ScanMenu
  126. END SUB
  127.