home *** CD-ROM | disk | FTP | other *** search
/ OS/2 Shareware BBS: Graphics / Graphics.zip / os2apipm.zip / APIEXAM / MENU.ADB < prev    next >
Text File  |  1996-07-17  |  4KB  |  92 lines
  1.  --  menu
  2.  with os2; use os2;
  3.  with os2.bse; use os2.bse;
  4.  with os2.vio; use os2.vio;
  5.  with os2.mou; use os2.mou;
  6.  with builtin; use builtin;
  7.  procedure menu is
  8.  --  pull down menu
  9.  BUTTON1_MOVE :constant ushort:= 02; -- bit 1 : button 1 push mouse moving
  10.  BUTTON1      :constant ushort:= 04; -- bit 2 : button 1 push
  11.  Blank   : array(0..1) of aliased byte := ( 16#20#,16#07#);
  12.                                          -- blank ,normal attribute
  13.                                          -- clear screen
  14.  MouHandle : aliased  ushort ;               -- mouse handle
  15.  Event     : aliased  MOUEVENTINFO ;
  16.  MouPos    : aliased PTRLOC ;          --  mouse place
  17.  ReadType  : aliased ushort := 1;      --  0 - no wait, 1 - wait
  18.  row       : ushort;
  19.  rc        : apiret16 ;
  20.  norm      :aliased uchar := 16#07#;  -- normal attribute
  21.  revr      :aliased uchar := 16#70#;  -- inverse attribute
  22.  begin
  23.  rc:=  VioScrollUp(0 ,0 ,-1 ,-1 ,-1 ,Blank(0)'unchecked_access ,0 );
  24.  if MouOpen( system.null_address, MouHandle'unchecked_access) > 0 then
  25.     put_edit("MouOpen error rc=",integer(rc)); goto fin ;
  26.  end if;
  27.                                          -- draw standard mouse
  28.  if MouDrawPtr( MouHandle ) > 0 then
  29.     put_edit("MouDrawPtr error rc=",integer(rc)); goto fin;
  30.  end if;
  31.  
  32.                   -- print  "MENU"
  33.  rc:=  VioWrtCharStrAtt ( "MENU", 4, 0, 0, norm'unchecked_access, 0 );
  34.  
  35.  loop --    wait mouse event
  36.    if MouReadEventQue( Event'unchecked_access,
  37.                        ReadType'unchecked_access,
  38.                        MouHandle ) > 0 then
  39.       put_edit("MouReadEventQue error rc=",integer(rc)); goto fin;
  40.    end if;
  41.    rc:= MouGetPtrPos( MouPos'unchecked_access, MouHandle );
  42.    if MouPos.col < 4 and  MouPos.row =0  then
  43.                                          -- mark  "MENU"
  44.      rc:=  VioWrtCharStrAtt( "MENU", 4, 0, 0, revr'unchecked_access, 0 );
  45.                                          -- right button push
  46.      if  Event.fs = BUTTON1   then
  47.                                          -- enter submenu cycle
  48.                                          -- ß¡«óá «ª¿ñáΓ∞ ß«íδΓ¿∩ ¼δΦ¿
  49.          while Event.fs = BUTTON1 or Event.fs = BUTTON1_MOVE loop
  50.             rc:= MouReadEventQue( Event'unchecked_access,
  51.                                   ReadType'unchecked_access,
  52.                                   MouHandle );
  53.             rc:= MouGetPtrPos( MouPos'unchecked_access, MouHandle );
  54.             rc:= VioWrtCharStrAtt( "Print", 5, 1, 0,  norm'unchecked_access, 0 );
  55.             rc:= VioWrtCharStrAtt( "Beep ", 4, 2, 0,  norm'unchecked_access, 0 );
  56.             rc:= VioWrtCharStrAtt( "Clear", 5, 3, 0,  norm'unchecked_access, 0 );
  57.             rc:= VioWrtCharStrAtt( "Quit ", 4, 4, 0,  norm'unchecked_access, 0 );
  58.             case MouPos.row is           -- mark theme
  59.               when 1 =>
  60.                rc:= VioWrtCharStrAtt( "Print", 5, 1, 0,  revr'unchecked_access, 0 );
  61.               when 2 =>
  62.                rc:=  VioWrtCharStrAtt( "Beep", 4, 2, 0,  revr'unchecked_access, 0 );
  63.               when 3 =>
  64.                rc:=  VioWrtCharStrAtt( "Clear", 5, 3, 0,  revr'unchecked_access, 0 );
  65.               when 4 =>
  66.                rc:=  VioWrtCharStrAtt( "Quit", 4, 4, 0,  revr'unchecked_access, 0 );
  67.               when others => null ;
  68.             end case;
  69.          end loop; -- end cycle  button relay
  70.          for i in 1..5 loop            -- clear submenu
  71.            rc:= VioWrtNCell( Blank(0)'unchecked_access, 5, ushort(i), 0, 0 );
  72.          end loop;
  73.          case MouPos.row  is  -- action
  74.            when 1 =>                     -- write in row  12
  75.             rc:= VioWrtCharStr( "MESSAGE", 7, 12, 0, 0 );
  76.            when 2 =>                -- speaker
  77.                if DosBeep( 100, 500 ) = 0 then null ; end if;
  78.             when 3 =>                    -- clear row  12
  79.              rc:= VioWrtNCell( Blank(0)'unchecked_access, 7, 12, 0, 0 );
  80.             when 4 => goto fin;         -- exit
  81.             when others => null;
  82.          end case;
  83.        end if;
  84.                                         -- print  "MENU"
  85.       rc:= VioWrtCharStrAtt ( "MENU", 4, 0, 0,  norm'unchecked_access, 0 );
  86.      end if;
  87.  end loop;
  88.  
  89.  rc:=  MouClose( MouHandle );
  90.  <<fin>> null ;
  91.  end menu;
  92.