home *** CD-ROM | disk | FTP | other *** search
/ Frozen Fish 1: Amiga / FrozenFish-Apr94.iso / bbs / alib / d1xx / d138 / modulatools.lha / ModulaTools / ModulaTools.source / MenuTools.mod < prev    next >
Encoding:
Modula Implementation  |  1988-03-20  |  26.8 KB  |  614 lines
  1. (******************************************************************************)
  2. (*                                                                            *)
  3. (*  Version 1.00a.002 (Beta) :   March 2, 1988                                *)
  4. (*                                                                            *)
  5. (*    These procedures were originally written under version 1.20 of the TDI  *)
  6. (* Modula-2 compiler. I have rewritten this module to operate under the v2.00 *)
  7. (* compiler. However, should you find any problem or inconsistency with the   *)
  8. (* functionality of this code, please contact me at the following address:    *)
  9. (*                                                                            *)
  10. (*                               Jerry Mack                                   *)
  11. (*                               23 Prospect Hill Ave.                        *)
  12. (*                               Waltham, MA   02154                          *)
  13. (*                                                                            *)
  14. (*    Check the module MenuUtils for TDI's (considerably less powerful) ver-  *)
  15. (* sions of my Menu and IntuitionText procedures. The modules GadgetUtils and *)
  16. (* EasyGadgets should also be of great help.                                  *)
  17. (*                                                                            *)
  18. (******************************************************************************)
  19. (*                                                                            *)
  20. (*    The source code to MenuTools is in the public domain. You may do with   *)
  21. (* it as you please.                                                          *)
  22. (*                                                                            *)
  23. (******************************************************************************)
  24.  
  25. IMPLEMENTATION MODULE MenuTools;
  26.  
  27.  
  28. FROM Intuition       IMPORT IntuitionText, IntuitionTextPtr, WindowPtr,
  29.                             IDCMPFlags,IDCMPFlagSet,
  30.                             Menu, MenuPtr, MenuFlags, MenuFlagSet,
  31.                             MenuItem, MenuItemPtr, ItemFlags, ItemFlagSet,
  32.                             CheckWidth, LowCheckWidth, CommWidth, LowCommWidth;
  33. FROM IntuiUtils      IMPORT MenuNum, ItemNum, SubNum;
  34. FROM Menus           IMPORT ClearMenuStrip, HighFlags;
  35. FROM Storage         IMPORT ALLOCATE, DEALLOCATE;
  36. FROM Strings         IMPORT InitStringModule, String, Compare, Equal, Length;
  37. FROM SYSTEM          IMPORT BYTE, NULL;
  38. FROM TextTools       IMPORT GetIntuiText, DestroyIntuiText, TextDrawMode,
  39.                             FrontTextPen, BackTextPen, LastText, CurrentFont;
  40.  
  41. CONST
  42.    OutOfBounds = 10000;              (* flag: default Menu & Item placement? *)
  43.    TextFlag    = ItemFlagSet{ItemText};   (* all Menu Items must be textual; *)
  44.    NoText      = 0C;
  45.  
  46. TYPE
  47.    StringPtr = POINTER TO String;       (* storage space for Menu text;      *)
  48.  
  49. VAR                                     (*       default positions:          *)
  50.    MenuLeft         : INTEGER;          (* left position of current Menu;    *)
  51.    ItemLeft         : INTEGER;          (* left position of current Item;    *)
  52.    ItemTop          : INTEGER;          (* top  position of current Item;    *)
  53.    ItemWide         : INTEGER;          (* width         of current Item;    *)
  54.    ItemColumnTop    : MenuItemPtr;      (* first Item    in current column;  *)
  55.    SubItemLeft      : INTEGER;          (* left position of current SubItem; *)
  56.    SubItemTop       : INTEGER;          (* top  position of current SubItem; *)
  57.    SubItemWide      : INTEGER;          (* width         of current SubItem; *)
  58.    SubItemColumnTop : MenuItemPtr;      (* first SubItem in current column;  *)
  59.    MenuText         : StringPtr;        (* permanent storage of Menu text;   *)
  60.    Itemintuitext    : IntuitionTextPtr; (* Menu-text structure Amiga uses;   *)
  61.  
  62.  
  63.    PROCEDURE Min (int1, int2 : INTEGER ) : INTEGER;
  64.    
  65.    BEGIN
  66.       IF (int1 < int2) THEN              (* utility routine to find the    *)
  67.          RETURN int1;                    (* minimum of a pair of integers; *)
  68.       ELSE
  69.          RETURN int2;
  70.       END; (* IF int1 *)
  71.    END Min; 
  72.    
  73.    
  74.    PROCEDURE Max (int1, int2 : INTEGER ) : INTEGER;
  75.    
  76.    BEGIN
  77.       IF (int1 > int2) THEN              (* utility routine to find the    *)
  78.          RETURN int1;                    (* maximum of a pair of integers; *)
  79.       ELSE
  80.          RETURN int2;
  81.       END; (* IF int1 *)
  82.    END Max; 
  83.    
  84.  
  85. (***************************************************************************)
  86. (*                                                                         *)
  87. (*    This procedure initializes the variables used in the Menu procedures *)
  88. (* below. If you wish to build several Menu structures, save the value of  *)
  89. (* FirstMenu before the second and subsequent calls: this is the MenuPtr   *)
  90. (* used in the procedure SetMenuStrip to attach the Menu tree to a window. *)
  91. (*                                                                         *)
  92. (***************************************************************************)
  93.  
  94.    PROCEDURE InitializeMenuStrip;
  95.    
  96.    BEGIN
  97.       CurrentMenu   := NULL;                (* no Menus currently defined; *)
  98.       FirstMenu     := NULL;
  99.       SelectText    := NoText;
  100.       MenuLeft      := 0;     (* place next Menu at left edge of Menu bar; *)
  101.       VerPixPerChar := 8;            (* max. # of vertical and horizontal  *)
  102.       HorPixPerChar := 8;           (* pixels per character for this font; *)
  103.       HiResScreen   := FALSE;  (* low-resolution screen (320 hor. pixels); *)
  104.       Left          := OutOfBounds;
  105.       Top           := OutOfBounds;  (* flags: calculate reasonable values *)
  106.       Wide          := OutOfBounds;  (* for positions of Menus and Items;  *)
  107.       High          := OutOfBounds;
  108.       MenuSetting   := MenuFlagSet{MenuEnabled};          (* enable Menus; *)
  109.       AutoIndent    := FALSE;        (* don't shift (Sub)Items to right;   *)
  110.       RightJustify  := TRUE;         (* align right edges of (Sub)Items;   *)
  111.       NewItemColumn := FALSE;        (* don't start new (Sub)Item column   *)
  112.       ItemPen       := -1;
  113.       ItemSelectPen := -1;
  114.    END InitializeMenuStrip;          (* unless required to for checkmark;  *)
  115.  
  116.  
  117. (***************************************************************************)
  118. (*                                                                         *)
  119. (*    This procedure adds a new Menu to the current Menu-tree. All Menu    *)
  120. (* structures and pointers are properly allocated and linked. The only     *)
  121. (* required parameter is the string MenuBarText, which contains the text   *)
  122. (* for the new Menu. Upon the execution of this procedure, the global      *)
  123. (* pointer CurrentMenu will point to this new Menu.                        *)
  124. (*                                                                         *)
  125. (*    The placement of the Menus is determined by the global variables     *)
  126. (* Left, Top, Wide and High. If you assign a value to any of these prior   *)
  127. (* to calling this procedure, then that value will be used in constructing *)
  128. (* the Menu structure. Otherwise, the procedure will calculate reasonable  *)
  129. (* values for the size and placement of the Menu. The variable MenuSetting *)
  130. (* can also be modified by the user, although it merely enables & disables *)
  131. (* the Menu in this version of Intuition.                                  *)
  132. (*                                                                         *)
  133. (***************************************************************************)
  134.  
  135.    PROCEDURE AddMenu (MenuBarText : String);
  136.  
  137.    VAR
  138.       OldMenu : MenuPtr;
  139.          
  140.    BEGIN
  141.    
  142.       IF (CurrentMenu <> NULL) THEN
  143.          OldMenu := CurrentMenu;              (* link new Menu to old Menu *)
  144.          NEW(CurrentMenu);
  145.          OldMenu^.NextMenu := CurrentMenu;
  146.       ELSE
  147.          NEW (CurrentMenu);                   (* first Menu in Menu tree   *)
  148.          FirstMenu := CurrentMenu;
  149.       END; (* IF CurrentMenu *)
  150.  
  151.       SelectText := NoText;                    (* calculate Menu positions *)
  152.       CalcLeftTopWideHigh (MenuLeft, 0, MenuBarText, SelectText);
  153.  
  154.       NEW(MenuText);
  155.       MenuText^ := MenuBarText;   
  156.       WITH CurrentMenu^ DO
  157.          LeftEdge  := Left;
  158.          TopEdge   := Top;              (* location and dimensions of Menu *)
  159.          Height    := High;
  160.          Width     := Wide;
  161.          Flags     := MenuSetting;        (* To enable or not to enable... *)
  162.          MenuName  := MenuText;
  163.          NextMenu  := NULL;
  164.          FirstItem := NULL;
  165.       END; (* WITH NewMenu^ *)
  166.       CurrentItem := NULL;
  167.                                                 (* left position of next Menu *)
  168.       INC(MenuLeft, Wide+INTEGER(HorPixPerChar));
  169.  
  170.       ItemLeft    := 0;             (* location of first Item under this Menu *)
  171.       ItemTop     := 0;
  172.       IF (RightJustify) THEN
  173.          ItemWide := Wide;     (* width of Item's select box >= width of Menu *)
  174.       ELSE
  175.          ItemWide := HorPixPerChar;
  176.       END; (* IF RightJustify *)
  177.  
  178.       ResetGlobals;
  179.  
  180.    END AddMenu;
  181.  
  182.  
  183. (***************************************************************************)
  184. (*                                                                         *)
  185. (*    This procedure adds a new Item under the CurrentMenu. All the Item   *)
  186. (* structures and pointers are properly allocated and linked. The required *)
  187. (* parameters are as follows:                                              *)
  188. (*                                                                         *)
  189. (*    ItemText    - (String) the text to appear in this Item.              *)
  190. (*    CommandKey  - (CHAR) the command-key equivalent for this Item; if    *)
  191. (*                  this is set to the global constant NoKey, then no key  *)
  192. (*                  equivalent will be assigned; otherwise, pressing this  *)
  193. (*                  key and the right Amiga-key will select this Item.     *)
  194. (*    ItemSetting - (ItemFlagSet) the options desired for this Item;       *)
  195. (*                  several commonly-used values for this parameter are    *)
  196. (*                  declared in the definition module.                     *)
  197. (*    Exclusion   - (LONGINT) the other Items in this Menu (CurrentMenu)   *)
  198. (*                  which cannot be selected at the same time as this one; *)
  199. (*                  setting a bit in Exclusion excludes the corresponding  *)
  200. (*                  Item while this Item is chosen.                        *)
  201. (*                                                                         *)
  202. (*    The placement of the Items is determined by the global variables     *)
  203. (* Left, Top, Wide and High. If you assign a value to any of these prior   *)
  204. (* to calling this procedure, then that value will be used in constructing *)
  205. (* the Item structure. Otherwise, the procedure will calculate reasonable  *)
  206. (* values for the size and placement of the Item. Wide and Left are auto-  *)
  207. (* matically adjusted if checkmarks and/or command keys are desired, based *)
  208. (* upon the value of the global flag HiResScreen. Setting the global flag  *)
  209. (* AutoIndent adds the space required for a checkmark to all subsequent    *)
  210. (* Items under the CurrentMenu, regardless of whether or not the Item may  *)
  211. (* be checked. (This is useful for lining up the left edges of the Items   *)
  212. (* when not all of them may be checked.) If AutoIndent is not set, then    *)
  213. (* the space will be added only to Items which may be checked.             *)
  214. (*                                                                         *)
  215. (*    Since the IntuiText procedures in this module are used to create the *)
  216. (* IntuitionText structures for this Item, you may change the global vari- *)
  217. (* ables recognized by those procedures to obtain special effects for your *)
  218. (* Items (e.g., different fonts, styles, colors, etc.).                    *)
  219. (*                                                                         *)
  220. (*    Upon returning from this procedure, the global variable CurrentItem  *)
  221. (* will point to this new Item.                                            *)
  222. (*                                                                         *)
  223. (***************************************************************************)
  224.  
  225.    PROCEDURE AddItem (ItemText    : String;
  226.                       Commandkey  : CHAR;
  227.                       ItemSetting : ItemFlagSet;
  228.                       Exclusion   : LONGINT);
  229.  
  230.    VAR
  231.       Selectintuitext     : IntuitionTextPtr;
  232.       TextLeft            : INTEGER;
  233.       ChangePreviousItems : BOOLEAN;
  234.  
  235.    BEGIN
  236.  
  237.       ItemSetting := ItemSetting + TextFlag;      (* Item must be a string *)
  238.       ChangePreviousItems := FALSE;      (* no reverse-traverse needed yet *)
  239.  
  240.       LinkItemsOrSubItems (CurrentItem, CurrentMenu^.FirstItem, ItemColumnTop);
  241.  
  242.       IF (NewItemColumn) THEN 
  243.          MakeNewColumn (ItemLeft, ItemTop, ItemWide);
  244.          ItemColumnTop := CurrentItem;
  245.       END; (* IF NewItemColumn *)
  246.  
  247.       CalcLeftTopWideHigh (ItemLeft, ItemTop, ItemText, SelectText); 
  248.  
  249.       AddCheckmarkAndCommandKey (ItemSetting, Commandkey, TextLeft);
  250.  
  251.       CalcFinalLeftAndWide (ItemLeft, ItemWide, ChangePreviousItems);
  252.  
  253.       IF (ChangePreviousItems) THEN
  254.          ReverseTraverse (ItemColumnTop, ItemLeft, ItemWide);
  255.       END; (* IF ChangePreviousSubItems *)
  256.  
  257.       IntuitionizeTexts (ItemText, SelectText, TextLeft, ItemSetting,
  258.                                       Itemintuitext, Selectintuitext);
  259.  
  260.        WITH CurrentItem^ DO
  261.          LeftEdge      := ItemLeft;    (* LeftEdge & Width must be same as *)
  262.          TopEdge       := Top;         (* values for other items under     *)
  263.          Height        := High;        (* this menu; TopEdge & Height may  *)
  264.          Width         := ItemWide;    (* vary as user wishes;             *)
  265.          Flags         := ItemSetting;             (* Item characteristics *)
  266.          MutualExclude := Exclusion;          (* exclude these other Items *)
  267.          ItemFill      := Itemintuitext;   (* text seen when Item selected *)
  268.          SelectFill    := Selectintuitext;           (* text normally seen *)
  269.          Command       := BYTE(Commandkey);              (* key equivalent *)
  270.          SubItem       := NULL;
  271.       END; (* WITH CurrentItem *)
  272.  
  273.       INC(ItemTop, High);                   (* top position of next Item   *)
  274.  
  275.       CurrentSubItem := NULL;
  276.       SubItemTop     := 0;             (* subitem select-box must overlap *)
  277.       SubItemLeft    := Wide-1;        (* item select-box somewhere;      *)
  278.       SubItemWide    := HorPixPerChar; (* ...safety precaution...         *)
  279.  
  280.       ResetGlobals;
  281.  
  282.    END AddItem;
  283.       
  284.       
  285. (***************************************************************************)
  286. (*                                                                         *)
  287. (*    This procedure adds a new SubItem under the CurrentItem. All Item    *)
  288. (* structures and pointers are properly allocated and initialized. The     *)
  289. (* procedure is virtually identical to the above routine AddItem, except   *)
  290. (* that the parameters and variables mentioned affect the SubItems under   *)
  291. (* the CurrentItem, rather than the Items under the CurrentMenu.           *)
  292. (*                                                                         *)
  293. (*    Upon returning from this procedure, the global variable CurrentSub-  *)
  294. (* Item will point to this new SubItem.                                    *)
  295. (*                                                                         *)
  296. (***************************************************************************)
  297.  
  298.    PROCEDURE AddSubItem (SubItemText           : String;
  299.                          Commandkey            : CHAR;
  300.                          ItemSetting           : ItemFlagSet;
  301.                          Exclusion             : LONGINT);
  302.  
  303.    VAR
  304.       Selectintuitext        : IntuitionTextPtr;
  305.       TextLeft               : INTEGER;
  306.       ChangePreviousSubItems : BOOLEAN;
  307.  
  308.    BEGIN
  309.    
  310.       ItemSetting := ItemSetting + TextFlag;   (* subitem must be a string *)
  311.       ChangePreviousSubItems := FALSE;   (* no reverse-traverse needed yet *)
  312.  
  313.       LinkItemsOrSubItems (CurrentSubItem, CurrentItem^.SubItem, 
  314.                                            SubItemColumnTop);
  315.  
  316.       IF (NewItemColumn) THEN
  317.          MakeNewColumn (SubItemLeft, SubItemTop, SubItemWide);
  318.          SubItemColumnTop := CurrentSubItem;
  319.       END; (* IF NewItemColumn *)
  320.  
  321.       CalcLeftTopWideHigh (SubItemLeft, SubItemTop, SubItemText, SelectText);
  322.  
  323.       AddCheckmarkAndCommandKey (ItemSetting, Commandkey, TextLeft);
  324.  
  325.       CalcFinalLeftAndWide (SubItemLeft, SubItemWide, ChangePreviousSubItems);
  326.  
  327.       IF (ChangePreviousSubItems) THEN
  328.          ReverseTraverse (SubItemColumnTop, SubItemLeft, SubItemWide);
  329.       END; (* IF ChangePreviousSubItems *)
  330.  
  331.       IntuitionizeTexts (SubItemText, SelectText, TextLeft, ItemSetting,
  332.                                          Itemintuitext, Selectintuitext);
  333.      
  334.       WITH CurrentSubItem^ DO
  335.          LeftEdge      := SubItemLeft;     (* LeftEdge & Width must be the *)
  336.          TopEdge       := Top;             (* same for all subitems under  *)
  337.          Height        := High;            (* this item; TopEdge & Height  *)
  338.          Width         := SubItemWide;     (* may vary as the user desires *)
  339.          Flags         := ItemSetting;          (* SubItem characteristics *)  
  340.          MutualExclude := Exclusion;       (* exclude these other SubItems *)
  341.          ItemFill      := Itemintuitext;(* text seen when SubItem selected *)
  342.          SelectFill    := Selectintuitext;           (* text normally seen *)
  343.          Command       := BYTE(Commandkey);              (* key equivalent *)
  344.          SubItem       := NULL;
  345.       END; (* WITH CurrentSubItem *)
  346.  
  347.       INC (SubItemTop, High);              (* top position of next SubItem *)
  348.  
  349.       ResetGlobals;
  350.  
  351.    END AddSubItem;
  352.       
  353.       
  354. (***************************************************************************)
  355. (*                                                                         *)
  356. (*    This procedure removes a Menu tree from a Window, DISPOSEs of all    *)
  357. (* Menu and Item structures and pointers and then calls InitializeMenuStrip*)
  358. (* to reset the variables used to create the next Menu tree. The only para-*)
  359. (* meter required is WindowPointer, a pointer to the Window from which you *)
  360. (* wish the Menu tree to be removed. If WindowPointer = NULL, then any Menu*)
  361. (* pointed to by the global variable LoneMenuStrip is DISPOSEd of as above;*)
  362. (* This feature is useful if you have several MenuStrips for a Window and  *)
  363. (* you wish to DISPOSE of one that isn't currently attached.               *)
  364. (*                                                                         *)
  365. (***************************************************************************)
  366.  
  367.    PROCEDURE DestroyMenuStrip (WindowPointer : WindowPtr);
  368.  
  369.    VAR
  370.       thisMenu     : MenuPtr;       (* pointers for traversing the Menus,  *)
  371.       nextMenu     : MenuPtr;       (* Items and SubItems in the MenuStrip *)
  372.       thisItem     : MenuItemPtr;
  373.       nextItem     : MenuItemPtr;
  374.       thisSubItem  : MenuItemPtr;
  375.       nextSubItem  : MenuItemPtr;
  376.          
  377.    BEGIN
  378.  
  379.       IF (WindowPointer <> NULL) AND (WindowPointer <> NIL) THEN
  380.          ClearMenuStrip (WindowPointer);
  381.          thisMenu := WindowPointer^.MenuStrip;
  382.       ELSE
  383.          IF (LoneMenuStrip <> NULL) AND (LoneMenuStrip <> NIL) THEN
  384.             thisMenu := LoneMenuStrip;
  385.          ELSE
  386.             RETURN;                         (* nothing of which to DISPOSE *)
  387.          END; (* IF LoneMenuStrip *)
  388.       END; (* IF WindowPointer *)
  389.  
  390.       
  391.       WHILE thisMenu <> NULL DO
  392.          thisItem := thisMenu^.FirstItem;
  393.  
  394.           WHILE thisItem <> NULL DO
  395.             thisSubItem := thisItem^.SubItem;
  396.  
  397.             WHILE thisSubItem <> NULL DO
  398.                WITH thisSubItem^ DO
  399.                   nextSubItem   := NextItem;
  400.                   Itemintuitext := IntuitionTextPtr(ItemFill);
  401.                   DestroyIntuiText (Itemintuitext, FALSE);
  402.                   IF (SelectFill <> NULL) THEN
  403.                      Itemintuitext := IntuitionTextPtr(SelectFill);
  404.                      DestroyIntuiText (Itemintuitext, FALSE);
  405.                   END; (* IF SelectFill *)
  406.                END; (* WITH thisSubItem *)
  407.                DISPOSE (thisSubItem);
  408.               thisSubItem := nextSubItem;
  409.             END; (* WHILE thisSubItem^ *)
  410.  
  411.             WITH thisItem^ DO
  412.                nextItem      := NextItem;
  413.                Itemintuitext := IntuitionTextPtr(ItemFill);
  414.                DestroyIntuiText (Itemintuitext, FALSE);
  415.                IF (SelectFill <> NULL) THEN
  416.                   Itemintuitext := IntuitionTextPtr(SelectFill);
  417.                   DestroyIntuiText (Itemintuitext, FALSE);
  418.                END; (* IF SelectFill *)
  419.             END; (* WITH thisItem^ *)
  420.             DISPOSE (thisItem);
  421.             thisItem := nextItem;
  422.          END; (* WHILE thisItem *)
  423.  
  424.          nextMenu := thisMenu^.NextMenu;
  425.          MenuText := StringPtr(thisMenu^.MenuName);
  426.          DISPOSE (MenuText);
  427.          DISPOSE (thisMenu);
  428.          thisMenu := nextMenu;
  429.       END; (* WHILE thisMenu *)
  430.       InitializeMenuStrip;
  431.    END DestroyMenuStrip;
  432.  
  433.  
  434.    PROCEDURE LinkItemsOrSubItems (VAR NewLink, FirstLink : MenuItemPtr;
  435.                                   VAR ColumnTop          : MenuItemPtr);
  436.  
  437.    VAR
  438.       OldLink : MenuItemPtr;
  439.  
  440.    BEGIN
  441.       IF (NewLink <> NULL) THEN
  442.          OldLink := NewLink;      (* link new (Sub)Item to last (Sub)Item *)
  443.          NEW(NewLink);
  444.          OldLink^.NextItem := NewLink;
  445.       ELSE
  446.          NEW(NewLink);                     (* first (Sub)Item; link it to *)
  447.          FirstLink := NewLink;             (* CurrentMenu or CurrentItem; *)
  448.          ColumnTop := FirstLink;           (* first (Sub)Item in column;  *)
  449.       END; (* IF NewLink *)
  450.       NewLink^.NextItem := NULL;
  451.    END LinkItemsOrSubItems;
  452.  
  453.  
  454.    PROCEDURE MakeNewColumn (VAR ItemLeft, ItemTop, ItemWide : INTEGER);
  455.  
  456.    BEGIN
  457.       ItemTop  := 0;
  458.       ItemLeft := ItemLeft + ItemWide;
  459.       ItemWide := HorPixPerChar;
  460.    END MakeNewColumn;
  461.  
  462.  
  463.    PROCEDURE CalcLeftTopWideHigh (DefaultLeft  : INTEGER;
  464.                                   DefaultTop   : INTEGER;
  465.                                   DefaultText  : String;
  466.                                   SelectText   : String);
  467.  
  468.    BEGIN
  469.       IF (Left = OutOfBounds) THEN Left := DefaultLeft;     END;
  470.       IF (Top  = OutOfBounds) THEN Top  := DefaultTop;      END;
  471.       IF (High = OutOfBounds) THEN High := VerPixPerChar+2; END;
  472.       IF (Wide = OutOfBounds) THEN 
  473.          Wide := ( Length( DefaultText ) + 1 ) * HorPixPerChar; 
  474.          IF (Compare (SelectText, NoText) <> Equal) THEN
  475.             Wide := Max (Wide, ( Length( SelectText ) + 1 ) * HorPixPerChar );
  476.          END; (* IF Compare *)
  477.       END; (* IF Wide *)
  478.    END CalcLeftTopWideHigh;
  479.  
  480.  
  481.    PROCEDURE  AddCheckmarkAndCommandKey (VAR ItemSetting : ItemFlagSet;
  482.                                              Commandkey  : CHAR;
  483.                                          VAR TextLeft    : INTEGER);
  484.  
  485.    BEGIN
  486.  
  487.       IF (CheckIt IN ItemSetting) OR (AutoIndent) THEN
  488.          IF HiResScreen THEN
  489.             TextLeft := CheckWidth;        (* left edge of IntuitionText   *)
  490.             INC(Wide, CheckWidth);         (* must be placed to right of   *)
  491.          ELSE                              (* checkmark; also, the width   *)
  492.             TextLeft := LowCheckWidth;     (* of the (Sub)Item must be in- *)
  493.             INC(Wide, LowCheckWidth);      (* creased to prevent the Intu- *)
  494.          END; (* IF HiResScreen *)         (* itionText from being clipped;*)
  495.       ELSE
  496.          TextLeft := 0;                      (* left edge of IntuitionText *)
  497.       END; (* IF CheckIt *)                  (* = left edge of (Sub)Item;  *)
  498.  
  499.       IF (Commandkey <> NoKey) THEN
  500.          INCL (ItemSetting, CommSeq);                (* add space to width *)
  501.          IF HiResScreen THEN                         (* of Item to allow   *)
  502.             INC(Wide, CommWidth + HorPixPerChar);    (* for command key;   *)
  503.          ELSE                                       
  504.             INC(Wide, LowCommWidth + HorPixPerChar);
  505.          END; (* IF HiResScreen *)
  506.       ELSE
  507.          EXCL (ItemSetting, CommSeq);        (* don't want key-equivalent; *)
  508.       END; (* IF CheckIt *)
  509.  
  510.    END AddCheckmarkAndCommandKey;
  511.  
  512.  
  513.     (* compute left position and width required by (Sub)Item; if either  *)
  514.     (* of these exceeds the corresponding values for previous (Sub)Items *)
  515.     (* under this Menu(Item), then must reverse traverse the MenuStrip;  *)
  516.  
  517.    PROCEDURE CalcFinalLeftAndWide (VAR CurrentLeft     : INTEGER;
  518.                                    VAR CurrentWide     : INTEGER;
  519.                                    VAR ReverseTraverse : BOOLEAN);
  520.  
  521.    BEGIN
  522.  
  523.       IF (Left < CurrentLeft) THEN
  524.          IF (RightJustify) THEN
  525.             Wide         := Max( Wide, CurrentWide + CurrentLeft - Left );
  526.             CurrentWide  := Wide;
  527.          END; (* IF RightJustify *)
  528.          CurrentLeft     := Left;
  529.          ReverseTraverse := TRUE;
  530.       ELSE
  531.          Left := CurrentLeft;
  532.       END; (* IF Left *)
  533.  
  534.       IF (Wide > CurrentWide) THEN
  535.          CurrentWide     := Wide;
  536.          ReverseTraverse := TRUE;
  537.       ELSE
  538.          Wide := CurrentWide;
  539.       END; (* IF Wide *)
  540.  
  541.    END CalcFinalLeftAndWide;
  542.  
  543.  
  544.    PROCEDURE ReverseTraverse (StartItem   : MenuItemPtr;
  545.                               NewLeftEdge : INTEGER;
  546.                               NewWidth    : INTEGER);
  547.  
  548.    VAR
  549.       thisItem : MenuItemPtr;
  550.  
  551.    BEGIN 
  552.       thisItem := StartItem;
  553.       WHILE (thisItem <> NULL) DO
  554.          WITH thisItem^ DO
  555.             LeftEdge := NewLeftEdge;      (* NewLeftEdge always <= LeftEdge *)
  556.             Width    := NewWidth;         (* NewWidth    always >= Width    *)
  557.             thisItem := NextItem;
  558.          END; (* WITH thisSubItem *)
  559.       END; (* WHILE thisItem *)
  560.    END ReverseTraverse;
  561.  
  562.  
  563.    PROCEDURE IntuitionizeTexts (ItemText, SelectText : String;
  564.                                 TextLeft             : INTEGER;
  565.                                 VAR ItemSetting      : ItemFlagSet;
  566.                                 VAR Itemintuitext    : IntuitionTextPtr;
  567.                                 VAR Selectintuitext  : IntuitionTextPtr);
  568.    VAR
  569.       SavedPen : INTEGER;
  570.  
  571.    BEGIN
  572.  
  573.       SavedPen := FrontTextPen;
  574.  
  575.       FrontTextPen := ItemPen; 
  576.       GetIntuiText (ItemText, TextLeft, 0, Itemintuitext);
  577.   
  578.       IF (Compare (SelectText, NoText) = Equal) THEN
  579.          Selectintuitext := NULL;
  580.       ELSE
  581.          ItemSetting  := ItemSetting - HighFlags;
  582.          FrontTextPen := ItemSelectPen;
  583.          GetIntuiText(SelectText, TextLeft, 0, Selectintuitext);
  584.       END; (* IF Compare *)
  585.  
  586.       FrontTextPen := SavedPen;
  587.  
  588.    END IntuitionizeTexts; 
  589.  
  590.  
  591.    PROCEDURE ResetGlobals;
  592.  
  593.    BEGIN
  594.  
  595.       Left := OutOfBounds;
  596.       Top  := OutOfBounds;           (* flags: calculate reasonable positions *)
  597.       Wide := OutOfBounds;
  598.       High := OutOfBounds;
  599.  
  600.       SelectText := NoText;       (* default: no alternate text for (Sub)Item *)
  601.  
  602.       NewItemColumn := FALSE;        (* default: no new column for (Sub)Items *)
  603.  
  604.    END ResetGlobals; 
  605.  
  606.  
  607. BEGIN
  608.  
  609.    InitStringModule;                          (* initialize Strings module *)
  610.  
  611.    LoneMenuStrip := NULL;
  612.  
  613. END MenuTools.
  614.