home *** CD-ROM | disk | FTP | other *** search
/ Amiga ISO Collection / AmigaUtilCD2.iso / Programming / Pascal / HISOFTPASCAL2,0-1.DMS / in.adf / HSPascal / AmigaDemos / MenuDemo.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1992-05-14  |  4.6 KB  |  122 lines
  1. {----------------------------------------------------------------------------
  2.  
  3.                       HighSpeed Pascal for the Amiga
  4.  
  5.                                 MENU DEMO
  6.  
  7.                    Programmed by Martin Eskildsen 1991
  8.  
  9.                    Copyright (c) 1991 by D-House I ApS
  10.                           All rights reserved
  11.  
  12.  
  13.   Version : Date (dd.mm.yy) : Comment
  14.   -----------------------------------
  15.     1.00 : 21.07.91 : First version
  16.     1.01 : 17.09.91 : Modified for new libraries
  17.     1.02 : 06.11.91 : Final for first release
  18.     1.10 : 22.04.92 : Updated to use correct unsigned types, Wait() fixed
  19.  
  20. ----------------------------------------------------------------------------}
  21.  
  22. program MenuDemo;
  23.  
  24. uses Init, Intuition, Exec, Graphics, MenuUtil;
  25.  
  26. var
  27.   BaseMenu : pMenu;           { The first menu in the menu strip }
  28.   m        : pMenu;           { Used temporarily }
  29.   bool     : boolean;         { Dummy }
  30.   i        : integer;         { Index }
  31.   iPtr     : pIntuiText;
  32.  
  33. procedure SelectLoop;
  34. var
  35.   dummy    : longint;
  36.   Imessage : pIntuiMessage;   { The messages sent to this program }
  37.   class    : long;            { Message class }
  38.   code     : word;            { Message code }
  39.   quit     : boolean;         { TRUE = done showing menu }
  40.   mNum     : integer;         { Menu number selected }
  41.   iNum     : integer;         { Item number selected }
  42.   s        : string;          { A string }
  43.   ItemPtr  : pMenuItem;       { Pointer to a menu item structure }
  44.   TextPtr  : pIntuiText;      { Pointer to a IntuiText structure }
  45.  
  46. begin
  47.   quit := FALSE;                           { Not done yet }
  48.   repeat
  49.     dummy := Wait(BitMask(OutputWindow^.UserPort^.MP_SIGBIT));
  50.                                         { Wait for something to happen }
  51.  
  52.     Imessage := pIntuiMessage(GetMsg(OutputWindow^.UserPort));
  53.                                         { Find out what }
  54.     while Imessage <> NIL do begin
  55.       class := Imessage^.class;         { Save for later use }
  56.       code  := Imessage^.code;
  57.       ReplyMsg(pMessage(Imessage));     { Accept this message }
  58.       case class of
  59.         MENUPICK     : begin            { The right mouse key was pressed }
  60.                          if code <> MENUNULL then begin { Pointed at menu? }
  61.                            mNum := MenuNum(code);
  62.                            iNum := ItemNum(code);
  63.                            quit := (mNum = 0) and (iNum = 2);
  64.                                    { Menu 1 }     { Quit item }
  65.                            ItemPtr := pMenuItem(ItemAddress(BaseMenu, code));
  66.                            TextPtr := pIntuiText(ItemPtr^.ItemFill);
  67.                            s := 'You chose ' + RetrieveStr(TextPtr^.IText);
  68.                          end
  69.                          else s := '-- You made no selection --';
  70.                          while length(s) < 60 do s := s + ' ';
  71.                          with OutputWindow^ do begin
  72.                            Move_(RPort, 20,20);         { Where to write }
  73.                            Text_(RPort, @s[1], length(s))   { this text }
  74.                          end
  75.                        end;
  76.         CLOSEWINDOW_ : quit := TRUE
  77.       end;
  78.       Imessage := pIntuiMessage(GetMsg(OutputWindow^.UserPort)) { Get next }
  79.     end;
  80.   until quit
  81. end;
  82.  
  83. begin
  84.   if PrepareEnvironment('Menu') then begin
  85.  
  86.     Message('First, we''ll build the menu structures');
  87.     InitMenu(BaseMenu, 'Menu 1 ');
  88.     AddItem (BaseMenu, 'Simple item',    ITEMENABLED or HIGHCOMP, $0000, #0);
  89.     AddItem (BaseMenu, 'Disabled item',                 HIGHCOMP, $0000, #0);
  90.     AddItem (BaseMenu, 'Quit          ', ITEMENABLED or HIGHCOMP
  91.                                                      or COMMSEQ , $0000, 'Q');
  92.     AddMenu (m, BaseMenu, 'Menu 2 ');
  93.     for i := 1 to 20 do
  94.       AddItem (m, 'Item ' + chr(i + ord('@')), ITEMENABLED or HIGHCOMP, $0000, #0);
  95.  
  96.     Message('Menus need a window, so let''s make one');
  97.     with OutputWinDef do                     { Tell Intuition that we want }
  98.       IDCMPflags := IDCMPflags or MENUPICK;  { menu events }
  99.     OpenOutputWindow;
  100.  
  101.     Message('Let''s attach the menu strip to the Output window');
  102.  
  103.     bool := SetMenuStrip(OutputWindow, BaseMenu);
  104.  
  105.     Inform('Now, activate the Output window and press right mouse button');
  106.     SelectLoop;
  107.     
  108.     Inform('Let''s change Menu 1 a bit. Please examine the menu');
  109.     ClearMenuStrip(OutputWindow);
  110.     iPtr := BaseMenu^.FirstItem^.ItemFill;
  111.     iPtr^.IText := CStrConstPtr('Yo! I changed!');
  112.     bool := SetMenuStrip(OutputWindow, BaseMenu);
  113.     SelectLoop;
  114.  
  115.     ClearMenuStrip(OutputWindow);
  116.     Message('How nice. The menu strip has been removed and so will the Output window');
  117.     CloseOutputWindow;
  118.  
  119.     CloseDown
  120.   end
  121. end.
  122.