home *** CD-ROM | disk | FTP | other *** search
- MODULE Test;
-
- FROM InOut IMPORT Read, Write, WriteInt, WriteString, WriteLn;
- FROM Intuition IMPORT ScreenPtr, WindowPtr, ItemFlags, ItemFlagSet, Menu,
- MenuPtr, MenuItem, MenuItemPtr, IntuiMessagePtr,
- IDCMPFlags, IDCMPFlagSet, MenuFlags, MenuFlagSet,
- MenuNULL;
- FROM Menus IMPORT SetMenuStrip, HighComp;
- FROM Screens IMPORT CloseScreen;
- FROM Storage IMPORT DestroyHeap;
- FROM Strings IMPORT String;
- FROM SYSTEM IMPORT NULL;
- FROM Views IMPORT Modes, ModeSet;
- FROM Windows IMPORT CloseWindow;
- FROM ModulaTools IMPORT OpenGraphics, CloseGraphics, CreateScreen,
- CreateWindow, InitializeMenuStrip, DestroyMenuStrip,
- AddMenu, AddItem, AddSubItem, FirstMenu, SelectText,
- ChoiceType, GotMessage, GetMenuChoice, Checkable,
- CheckNow, ItemOn, NoKey, Left;
-
- VAR
- UserScreen : ScreenPtr;
- UserWindow : WindowPtr;
- CurrentMenu : MenuPtr;
- CurrentItem : MenuItemPtr;
- CurrentSubItem : MenuItemPtr;
- IMessage : IntuiMessagePtr;
- finished : BOOLEAN;
- WindowTitle : String;
- ScreenTitle : String;
-
-
- (* In case you didn't know, it's possible to pick more than one (Sub)Item at *)
- (* a time, either by drag selection or click selection. This routine will *)
- (* identify all such choices by checking the NextSelect field in the MenuItem *)
- (* structure. The one thing to be wary of is that Intuition doesn't keep track*)
- (* of the number of times an Item is chosen. Thus, three clicks on one Item *)
- (* prior to releasing the right menu-button is reported as one click. *)
-
- PROCEDURE HandleMenus (MenuCode : CARDINAL);
-
- VAR
- MenuChoice : ChoiceType;
-
- BEGIN
- WHILE (MenuCode <> MenuNULL) DO
- GetMenuChoice (MenuCode, FirstMenu, MenuChoice);
- WITH MenuChoice DO
- WriteString (" Menu #"); WriteInt (MenuChosen,2);
- WriteString (" Item #"); WriteInt (ItemChosen,2);
- WriteString (" Sub #"); WriteInt (SubItemChosen,2);
- WriteLn;
- MenuCode := ChoicePointer^.NextSelect;
- END; (* WITH MenuChoice *)
- END; (* WHILE MenuCode *)
- WriteLn; WriteLn;
- END HandleMenus;
-
-
- BEGIN
-
- IF OpenGraphics() THEN
-
- ScreenTitle := "Simple Screen";
- UserScreen := CreateScreen (0, 100, 320, 100, 1, ScreenTitle);
-
- WindowTitle := "Simple Window";
- UserWindow := CreateWindow (0, 0, 320, 100, WindowTitle, UserScreen);
-
- IF (UserWindow <> NULL) THEN
-
- InitializeMenuStrip;
-
- AddMenu("Menu #0");
- AddItem("Item #0", "0", ItemOn+Checkable+CheckNow, 0);
- AddItem("Item #1", NoKey, ItemOn, 0);
- AddSubItem("SubItem #0 ", "a", ItemOn+Checkable, 2+4+8);
- AddSubItem("SubItem #1 ", "b", ItemOn+Checkable, 1+4+8);
- AddSubItem("SubItem #2 ", "c", ItemOn+Checkable, 1+2+8);
- AddSubItem("SubItem #3 ", "d", ItemOn+Checkable, 1+2+4);
-
- Left := 100; (* optional *)
- AddMenu("Menu #1");
- AddItem("Item #0", "?", ItemOn, 0);
- AddItem("Item #1", NoKey, ItemOn, 0);
- Left := -50; (* optional *)
- AddSubItem("SubItem #0", "A", ItemOn+Checkable, 2+4);
- AddSubItem("SubItem #1", "B", ItemOn+Checkable, 1+4);
- AddSubItem("SubItem #2", "C", ItemOn+Checkable+CheckNow, 1+2);
-
- SetMenuStrip(UserWindow, FirstMenu^);
-
- finished := FALSE;
- WHILE NOT (finished) DO
- IF (GotMessage (IMessage, UserWindow)) THEN
- IF (MenuPick IN IMessage^.Class) THEN
- HandleMenus (IMessage^.Code);
- ELSIF (CloseWindowFlag IN IMessage^.Class) THEN
- finished := TRUE;
- END; (* IF MenuPick *)
- END; (* IF GotMessage *)
- END; (* WHILE NOT finished *)
-
- DestroyMenuStrip(UserWindow);
- CloseWindow (UserWindow);
-
- END; (* IF UserWindow *)
-
- IF (UserScreen <> NULL) THEN
- CloseScreen (UserScreen);
- END; (* IF UserScreen *)
-
- CloseGraphics ();
-
- END; (* IF OpenGraphics *)
-
- DestroyHeap;
-
- END Test.
-