home *** CD-ROM | disk | FTP | other *** search
/ The Developer Connection…ice Driver Kit for OS/2 3 / DEV3-D1.ISO / devtools / dataflex / action.pkg next >
Encoding:
Text File  |  1993-05-19  |  4.5 KB  |  147 lines
  1. // ACTION.PKG
  2. // March 13, 1992
  3. // LS
  4. //
  5. // package for Action_Bar_Menu class
  6.  
  7. #CHKSUB 1 1 // Verify the UI subsystem.
  8.  
  9. use UI
  10.  
  11. register_procedure Activate_Pull_Down
  12.  
  13. class Action_Bar_Menu is an ACTION_BAR
  14.     procedure Construct_Object integer Img
  15.         forward send Construct_Object Img
  16.  
  17.         property integer Action_Bar_Keys_Msg  Public 0 // used to assign alt-char keys
  18.         property integer Ignore_Exit_State    Public 0 // used to skip exit message
  19.         property integer Verify_Exit_Msg      Public 0
  20.         property integer Auto_Pull_Down_State Public 0 // activate pull_down on left/right arrow
  21.  
  22.         set Attach_Parent_State to True
  23.         set Inverse_State       to True
  24.         set Scope_State         to True
  25.         set Skip_State          to True
  26.         set Wrap_State          to True
  27.  
  28.         on_key kAction_Bar    send Return_To_Prior_Scope Private
  29.         on_key kCancel        send Request_Cancel        Private
  30.         on_key kDownarrow     send Choose                Private
  31.         on_key kNext_Item     send None                  Private
  32.         on_key kPrevious_Item send None                  Private
  33.     end_procedure
  34.  
  35.     function Action_Bar_Location returns integer
  36.         function_return (Location( Current_Object ))
  37.     end_function
  38.  
  39.     function Action_Bar_Width returns integer
  40.         function_return (Low( Size( Current_Object ) ))
  41.     end_function
  42.  
  43.     procedure Choose
  44.         if (Message( Current_Object, Current )) EQ Msg_Activate_Pull_Down ;
  45.           send Key kEnter
  46.     end_procedure
  47.  
  48.     procedure Entering returns integer
  49.         local integer Ret_Val
  50.  
  51.         forward get Msg_Entering to Ret_Val
  52.         if Ret_Val procedure_return Ret_Val
  53.  
  54.         set Auto_Pull_Down_State to False
  55.  
  56.         set Select_Count to 0    // de-select Current_Item for normal highlight
  57.     end_procedure
  58.  
  59. #IFSUB 'AREA_FLAG'
  60. #ELSE
  61.   #REPLACE AREA_FLAG 3  //scope AND popup
  62. #ENDIF
  63.  
  64.     procedure Exit_Area
  65.         local integer Obj
  66.  
  67.         get Prior_Level to Obj
  68.         if Obj send Deactivate to Obj AREA_FLAG
  69.     end_procedure
  70.  
  71.     procedure Exit_Cascade // dummy for delegation from pull down
  72.     end_procedure
  73.  
  74.     procedure Exiting_Scope integer New_Sco
  75.         local integer Nxt_Lvl
  76.  
  77.         forward send Exiting_Scope New_Sco
  78.  
  79.         get Next_Level to Nxt_Lvl
  80.         if Nxt_Lvl NE 0 send Deactivate to Nxt_Lvl
  81.         set Current_Item to 0
  82.     end_procedure
  83.  
  84.     procedure Mouse_Down integer W_Num integer C_Pos
  85.         forward send Mouse_Down W_Num C_Pos
  86.         send Mouse_Up W_Num C_Pos
  87.     end_procedure
  88.  
  89.     procedure Request_Cancel
  90.         local integer Msg Ret_Val
  91.  
  92.         send Return_To_Prior_Scope
  93.         if (Current_Scope( Desktop )) EQ Current_Object begin
  94.             get Verify_Exit_Msg to Msg
  95.             if Msg NE 0 get Msg to Ret_Val
  96.             if Ret_Val EQ 0 send Exit_Area
  97.         end
  98.     end_procedure
  99.  
  100.     procedure Return_To_Prior_Scope
  101.         local integer Pri_Sco
  102.  
  103.         if (Focus( Desktop )) NE Current_Object send Activate
  104.  
  105.         get Prior_Scope to Pri_Sco
  106.  
  107.         if Pri_Sco EQ 0 move Desktop to Pri_Sco
  108.         if (Active_State( Scope_Focus( Pri_Sco ) )) set Current_Scope to Pri_Sco
  109.         else set Current_Item to 0
  110.     end_procedure
  111.  
  112.     procedure Key integer Key_Val returns integer
  113.         local integer Ret_Val
  114.  
  115.         forward get Msg_Key Key_Val to Ret_Val
  116.         if Ret_Val NE 0 procedure_return Ret_Val
  117.  
  118.         if ((Key_Val = kRightArrow or Key_Val = kLeftArrow) and ;
  119.           Auto_Pull_Down_State( Current_Object ) and ;
  120.           Message( Current_Object, Current ) = Msg_Activate_Pull_Down) begin
  121.             get Msg_Process_Key kEnter to Ret_Val
  122.             procedure_return Ret_Val
  123.         end
  124.     end_procedure
  125. end_class
  126.  
  127. procedure Assign_Action_Bar_Keys for Desktop integer Obj
  128.     local integer Msg
  129.  
  130.     if (Obj <> 0 and Obj <> Current_Object and ;
  131.       (Focus_Mode( Current_Object ) = Focusable or ;
  132.       Popup_State( Current_Object ) <> 0)) begin
  133.         on_key kAction_Bar send Activate to Obj Private
  134.         get Action_Bar_Keys_Msg of Obj to Msg
  135.         if Msg NE 0 send Msg Obj
  136.     end
  137. end_procedure
  138.  
  139. procedure Define_Access_Keys for Desktop integer Obj
  140.     if (not(Popup_State( Current_Object )) and Obj <> 0 and ;
  141.       Obj <> Current_Object) begin
  142.         send Assign_Action_Bar_Keys Obj
  143.         if (Child_Count( Current_Object ) > 0) ;
  144.           broadcast send Define_Access_Keys Obj
  145.     end
  146. end_procedure
  147.