home *** CD-ROM | disk | FTP | other *** search
/ Amiga ISO Collection / AmigaUtilCD2.iso / Programming / Basic / MAXONB32.DMS / in.adf / Includes.lha / BH / BLib / GadToolsMenus.bas < prev    next >
Encoding:
BASIC Source File  |  1994-03-16  |  7.2 KB  |  241 lines
  1. ''
  2. '' $Id: GadToolsMenus.bas,v 1.4 1994/03/16 13:53:36 alex Rel $
  3. ''
  4. '' GadTools Menu creation helper
  5. ''
  6. '' (c) Copyright 1994 HiSoft
  7. ''
  8.  
  9. 'REM $INCLUDE Exec.bh
  10. 'REM $INCLUDE GadTools.bh
  11. 'REM $INCLUDE Utility.bc
  12.  
  13. '
  14. ' NM_CI - add a new item to an existing NewMenu list
  15. '
  16. FUNCTION NM_CI%(nmEntry&, BYVAL nmType%, nmLabel$, BYVAL nmImage&, _
  17.   nmCommKey$, BYVAL nmFlags%, BYVAL nmMutualExclude&, BYVAL nmUserData&)
  18.     STATIC slen%, sptr&
  19.  
  20.     POKEB nmEntry& + nm_Type%, nmType%    'fill in entry type
  21.  
  22.     SELECT CASE nmType%
  23.         CASE IM_ITEM&, IM_SUB&
  24.             POKEL nmEntry& + nm_Label%, nmImage&
  25.         CASE NM_END&
  26.             POKEL nmEntry& + nm_Label%, NULL&
  27.         CASE REMAINDER
  28.             IF nmLabel$ = "" THEN
  29.                 ' treat null string as a separator
  30.                 POKEL nmEntry& + nm_Label%, NM_BARLABEL&
  31.             ELSE
  32.                 slen% = LEN(nmLabel$) + 1
  33.                 sptr& = AllocVec&(slen%, MEMF_PUBLIC&)    'allocate memory for string
  34.                 IF sptr& <> NULL& THEN 
  35.                     CopyMem SADD(nmLabel$ + CHR$(0)), sptr&, slen%
  36.                     POKEL nmEntry& + nm_Label%, sptr&        'fill in label
  37.                 ELSE
  38.                     NM_CI% = FALSE&
  39.                     EXIT FUNCTION
  40.                 END IF
  41.             END IF
  42.     END SELECT
  43.     
  44.     POKEL nmEntry& + nm_CommKey%, NULL&
  45.     IF nmCommKey$ <> "" THEN
  46.         ' treats null string as no commkey
  47.         slen% = LEN(nmCommKey$)
  48.         IF slen% = 1 OR PEEKW(LIBRARY("gadtools.library") + lib_Version%) >= 39 THEN
  49.             IF slen% > 1 THEN
  50.                 nmFlags% = nmFlags% OR NM_COMMANDSTRING&
  51.             END IF
  52.             sptr& = AllocVec&(slen% + 1, MEMF_PUBLIC&)    'allocate memory for string
  53.             IF sptr& <> NULL& THEN 
  54.                 CopyMem SADD(nmCommKey$ + CHR$(0)), sptr&, slen% + 1
  55.                 POKEL nmEntry& + nm_CommKey%, sptr&        'fill in command key
  56.             ELSE
  57.                 NM_CI% = FALSE&
  58.                 EXIT FUNCTION
  59.             END IF
  60.         END IF
  61.     END IF
  62.     
  63.     POKEW nmEntry& + nm_Flags%, nmFlags%
  64.     POKEL nmEntry& + nm_MutualExclude%, nmMutualExclude&
  65.     POKEL nmEntry& + nm_UserData%, nmUserData&
  66.  
  67.     nmEntry& = nmEntry& + NewMenu_sizeof%
  68.  
  69.     NM_CI% = TRUE&
  70. END FUNCTION
  71.  
  72. '
  73. ' Create a new menu title
  74. '
  75. '    nmEntry& - next free NewMenu slot
  76. '    nmLabel$ - label for this menu title (the title text itself)
  77. '    nmFlags% - initial flags for this title
  78. '    nmUserData& - user data (whatever you like!)
  79. '
  80. FUNCTION MenuTitle%(nmEntry&, nmLabel$, BYVAL nmFlags%, BYVAL nmUserData&)
  81.     MenuTitle% = NM_CI%(nmEntry&, NM_TITLE&, nmLabel$, NULL&, "", _
  82.       nmFlags%, 0&, nmUserData&)
  83. END FUNCTION
  84.  
  85. '
  86. ' Create a new text menu item under the current title
  87. '
  88. '    nmEntry& - next free NewMenu slot
  89. '    nmLabel$ - label for this menu item (the item text itself)
  90. '    nmCommKey$ - the associated command key, a single character string for WB2,
  91. '                 or a longer string for WB3 (the routine will automatically ignore
  92. '                 longer strings for WB before V3)
  93. '    nmFlags% - initial flags for this title
  94. '    nmMutualExclude& - mutual exclude setting
  95. '    nmUserData& - user data (whatever you like!)
  96. '
  97. FUNCTION MenuItem%(nmEntry&, nmLabel$, nmCommKey$, _
  98.   BYVAL nmFlags%, BYVAL nmMutualExclude&, BYVAL nmUserData&)
  99.     MenuItem% = NM_CI%(nmEntry&, NM_ITEM&, nmLabel$, NULL&, nmCommKey$, _
  100.       nmFlags%, nmMutualExclude&, nmUserData&)
  101. END FUNCTION
  102.  
  103. '
  104. ' Create a new image menu item under the current title
  105. '
  106. '    nmEntry& - next free NewMenu slot
  107. '    nmImage& - address of the image which is to be used for this item
  108. '    nmCommKey$ - the associated command key, a single character string for WB2,
  109. '                 or a longer string for WB3 (the routine will automatically ignore
  110. '                 longer strings for WB before V3)
  111. '    nmFlags% - initial flags for this title
  112. '    nmMutualExclude& - mutual exclude setting
  113. '    nmUserData& - user data (whatever you like!)
  114. '
  115. FUNCTION MenuImageItem%(nmEntry&, BYVAL nmImage&, nmCommKey$, _
  116.   BYVAL nmFlags%, BYVAL nmMutualExclude&, BYVAL nmUserData&)
  117.     MenuImageItem% = NM_CI%(nmEntry&, IM_ITEM&, "", nmImage&, nmCommKey$, _
  118.       nmFlags%, nmMutualExclude&, nmUserData&)
  119. END FUNCTION
  120.  
  121. '
  122. ' Create a new text sub-menu item under the current item
  123. '
  124. '    nmEntry& - next free NewMenu slot
  125. '    nmLabel$ - label for this menu item (the item text itself)
  126. '    nmCommKey$ - the associated command key, a single character string for WB2,
  127. '                 or a longer string for WB3 (the routine will automatically ignore
  128. '                 longer strings for WB before V3)
  129. '    nmFlags% - initial flags for this title
  130. '    nmMutualExclude& - mutual exclude setting
  131. '    nmUserData& - user data (whatever you like!)
  132. '
  133. FUNCTION MenuSubItem%(nmEntry&, nmLabel$, nmCommKey$, _
  134.   BYVAL nmFlags%, BYVAL nmMutualExclude&, BYVAL nmUserData&)
  135.     MenuSubItem% = NM_CI%(nmEntry&, NM_SUB&, nmLabel$, NULL&, nmCommKey$, _
  136.       nmFlags%, nmMutualExclude&, nmUserData&)
  137. END FUNCTION
  138.  
  139. '
  140. ' Create a new image sub-menu item under the current item
  141. '
  142. '    nmEntry& - next free NewMenu slot
  143. '    nmImage& - address of the image which is to be used for this item
  144. '    nmCommKey$ - the associated command key, a single character string for WB2,
  145. '                 or a longer string for WB3 (the routine will automatically ignore
  146. '                 longer strings for WB before V3)
  147. '    nmFlags% - initial flags for this title
  148. '    nmMutualExclude& - mutual exclude setting
  149. '    nmUserData& - user data (whatever you like!)
  150. '
  151. FUNCTION MenuImageSubItem%(nmEntry&, BYVAL nmImage&, nmCommKey$, _
  152.   BYVAL nmFlags%, BYVAL nmMutualExclude&, BYVAL nmUserData&)
  153.     MenuImageSubItem% = NM_CI%(nmEntry&, IM_SUB&, "", nmImage&, nmCommKey$, _
  154.       nmFlags%, nmMutualExclude&, nmUserData&)
  155. END FUNCTION
  156.  
  157. '
  158. ' Terminate NewMenu building & construct the final menu strip
  159. '
  160. '    nmList& - base of NewMenu list
  161. '    nmEntry& - next free NewMenu slot
  162. '    tattr& - TextAttr to be used for this menu
  163. '    vi& - GadTools ViewInfo associated with this windows screen
  164. '    scaledcheck& - scaled checkmark image to be used (WB3)
  165. '    scaledamigakey& - scaled Amiga key image to be used (WB3)
  166. '
  167. FUNCTION MenuEnd%(nmEntry&, strip&, BYVAL nmList&, BYVAL tattr&, _
  168.   BYVAL vi&, BYVAL scaledcheck&, BYVAL scaledamigakey&)
  169.     STATIC NMME_tl&(10)
  170.     STATIC fail%
  171.  
  172.     IF NM_CI%(nmEntry&, NM_END&, "", NULL&, "", 0, 0, NULL&) = TRUE& THEN
  173.         nmEntry& = NULL&
  174.  
  175.         strip& = CreateMenusA&(nmList&, NULL&)
  176.         IF strip& <> NULL& THEN
  177.             TAGLIST VARPTR(NMME_tl&(0)), _
  178.               GTMN_TextAttr&, tattr&, _
  179.               GTMN_NewLookMenus&, TRUE&, _
  180.               TAG_END&
  181.           
  182.             IF scaledcheck& AND scaledamigakey& THEN
  183.                 TAGLIST VARPTR(NMME_tl&(4)), _
  184.                   GTMN_Checkmark&, scaledcheck&, _
  185.                   GTMN_AmigaKey&, scaledamigakey&, _
  186.                   TAG_END&
  187.             END IF
  188.         
  189.             MenuEnd% = LayoutMenusA&(strip&, vi&, VARPTR(NMME_tl&(0)))
  190.         ELSE
  191.             MenuEnd% = FALSE&
  192.             EXIT FUNCTION
  193.         END IF
  194.     ELSE
  195.         MenuEnd% = FALSE&
  196.         EXIT FUNCTION
  197.     END IF
  198. END FUNCTION
  199.  
  200. '
  201. ' Allocate space for num_entries in a NewMenu structure
  202. '
  203. '    nmEntry& - space to store the initial NewMenu slot
  204. '    num_entries% - the number of menu entries you need (including the MenuEnd)
  205. '
  206. FUNCTION MenuAlloc&(nmEntry&, BYVAL num_entries%)
  207.     nmEntry& = AllocVec&(num_entries% * NewMenu_sizeof%, MEMF_CLEAR&)
  208.     MenuAlloc& = nmEntry&
  209. END FUNCTION
  210.  
  211. '
  212. ' Free space which was allocated for the menu we built
  213. '
  214. '    nmList& - base of NewMenu list
  215. '    strip& - menu strip which was created (must have been detached from window!)
  216. '
  217. SUB MenuFree(nmList&, strip&)
  218.     STATIC nmEntry&, label&
  219.  
  220.     IF strip& <> NULL& THEN
  221.         FreeMenus strip&
  222.         strip& = NULL&
  223.     END IF
  224.     IF nmList& THEN 
  225.         nmEntry& = nmList&
  226.         WHILE PEEKL(nmEntry& + nm_Type%) <> NM_END&
  227.             label& = PEEKL(nmEntry& + nm_Label%)
  228.             IF label& <> NM_BARLABEL& THEN
  229.                 FreeVec label&
  230.             END IF
  231.             label& = PEEKL(nmEntry& + nm_CommKey%)
  232.             IF label& <> NULL&
  233.                 FreeVec label&
  234.             END IF
  235.             nmEntry& = nmEntry& + NewMenu_sizeof%
  236.         WEND
  237.         FreeVec nmList&
  238.         nmList& = NULL&
  239.     END IF
  240. END SUB
  241.