home *** CD-ROM | disk | FTP | other *** search
/ The Developer Connection…ice Driver Kit for OS/2 3 / DEV3-D1.ISO / devtools / dataflex / pulldown.pkg < prev    next >
Encoding:
Text File  |  1993-05-19  |  6.3 KB  |  198 lines
  1. // PULLDOWN.PKG
  2. // March 13, 1992
  3. // LS
  4. //
  5. // package for Pull_Down_Menu and Shadow_Text_Pull_Down_Menu classes (for use
  6. // with Action_Bar_Menu class); supports cascading pull-down menus
  7.  
  8. #CHKSUB 1 1 // Verify the UI subsystem.
  9.  
  10. use UI
  11.  
  12. register_function Action_Bar_Location returns integer
  13. register_function Action_Bar_Width returns integer
  14.  
  15. class Pull_Down_Menu is a MENU
  16.     procedure Construct_Object integer Img
  17.         forward send Construct_Object Img
  18.  
  19.         property integer Ignore_Exit_State Public 0
  20.  
  21.         set Attach_Parent_State to True
  22.         set Exit_Msg            to Exit_Cascade
  23.         set Wrap_State          to True
  24.  
  25.         on_key kAction_Bar    send Return_To_Prior_Scope Private
  26.         on_key kCancel        send Return_To_Prior_Scope Private
  27.         on_key kEnter         send Redirect_Message      Private
  28.         on_key kLeftArrow     send Pull_Left             Private
  29.         on_key kNext_Item     send None                  Private
  30.         on_key kPrevious_Item send None                  Private
  31.         on_key kRightArrow    send Pull_Right            Private
  32.     end_procedure
  33.  
  34.     procedure Activate
  35.         local integer Count Tot_Itms Itm Nxt_Lvl
  36.  
  37.         move 0 to Count
  38.         delegate get Item_Count to Tot_Itms
  39.         delegate get Current_Item to Itm
  40.  
  41.         while Count LT Tot_Itms
  42.             if (Aux_Value( Parent( Current_Object ), Count )) ;
  43.               EQ Current_Object move Count to Itm
  44.             increment Count
  45.         end
  46.  
  47.         if Itm LT Tot_Itms delegate set Current_Item to Itm
  48.  
  49.         delegate set Ignore_Exit_State to True // don't send Exit_Msg of parent
  50.         set Ignore_Exit_State to True                                // or self
  51.  
  52.         send Adjust_Location
  53.  
  54.         forward send Activate
  55.  
  56.         delegate set Select_State to True    // leave parent's item as selected
  57.         set Ignore_Exit_State to False
  58.         delegate set Ignore_Exit_State to False
  59.         get Next_Level to Nxt_Lvl
  60.         if Nxt_Lvl NE 0 send Deactivate to Nxt_Lvl
  61.     end_procedure
  62.  
  63.     procedure Activate_Pull_Down // special message that allows on_item
  64.         send Activate            // to activate a pull down menu object
  65.     end_procedure
  66.  
  67.     procedure Pull_Left
  68.         send Pull_Menu kLeftArrow
  69.     end_procedure
  70.  
  71.     procedure Pull_Right
  72.         send Pull_Menu kRightArrow
  73.     end_procedure
  74.  
  75.     procedure Pull_Menu integer Key_Val
  76.         send Exit
  77.         send Process_Key to (Focus( Desktop )) Key_Val
  78.  
  79.         if (Message( Focus( Desktop ), Current )) EQ ;
  80.           Msg_Activate_Pull_Down send Process_Key ;
  81.           to (Focus( Desktop )) kEnter
  82.  
  83.         delegate set Auto_Pull_Down_State to True
  84.     end_procedure
  85.  
  86.     procedure Entering returns integer
  87.         local integer Ret_Val
  88.         forward get Msg_Entering to Ret_Val
  89.         if not Ret_Val set Select_Count to 0                  // de-select item
  90.         procedure_return Ret_Val
  91.     end_procedure
  92.  
  93.     procedure Exit_Area
  94.         delegate send Exit_Area
  95.     end_procedure
  96.  
  97.     procedure Exit_Cascade
  98.         if (Ignore_Exit_State( Current_Object )) procedure_return
  99.         send Exit
  100.         if Not (Active_State( Current_Object )) delegate send Exit_Cascade
  101.     end_procedure
  102.  
  103.     procedure Adjust_Location
  104.         local integer New_Row New_Col Row_Col Ht_Wd Scr_Ht Cur_Row Cur_Col
  105.         local integer Act_Col
  106.  
  107.         if (Inverse_State( Parent( Current_Object ))) move -2 to New_Col // if action bar
  108.         else move 1 to New_Col
  109.         set Dynamic_Update_State to False
  110.         set Location to 1 New_Col Item_Relative // first try desired location
  111.  
  112.         get Location to Row_Col
  113.         get Size to Ht_Wd
  114.         move (Hi( Size( Desktop ) )) to Scr_Ht
  115.         move (Low( Action_Bar_Location( Current_Object ) )) to Act_Col
  116.  
  117.         move (Hi( Row_Col )) to New_Row
  118.         move (if( New_Row < 128, New_Row, New_Row - 256)) to Cur_Row
  119.         move (((Scr_Ht - Hi( Ht_Wd ) - 1) Min Cur_Row) Max 0) to New_Row
  120.  
  121.         move (Low( Row_Col )) to New_Col
  122.         move (if( New_Col < 128, New_Col, New_Col - 256)) to Cur_Col
  123.         move (((Action_Bar_Width( Current_Object ) + Act_Col - Low( Ht_Wd )) ;
  124.           Min Cur_Col) Max Act_Col) to New_Col
  125.  
  126.         if ((New_Row <> Cur_Row) Or (New_Col <> Cur_Col)) ;
  127.           set Location to New_Row New_Col Absolute  // reset to valid location
  128.         set Dynamic_Update_State to True
  129.     end_procedure
  130.  
  131.     procedure Redirect_Message returns integer
  132.         local integer Msg Obj Foc Act_Sco Ret_Val
  133.  
  134.         if (Shadow_State( Current_Object, Current )) procedure_return
  135.  
  136.         get Message to Msg
  137.         get Aux_Value to Obj
  138.  
  139.         move 0 to Ret_Val
  140.  
  141.         if Msg EQ Msg_Exit_Area move Current_Object to Obj
  142.         else begin
  143.             if Msg NE Msg_Activate_Pull_Down begin
  144.                 get Current_Scope to Act_Sco
  145.                 delegate send Return_To_Prior_Scope
  146.                 get Focus of Desktop to Foc                  // if focus failed
  147.                 if Foc EQ Current_Object procedure_return 0  // to move, quit
  148.  
  149.                 if Obj EQ 0 begin
  150.                     if Foc EQ Act_Sco procedure_return
  151.                     move Foc to Obj
  152.                 end
  153.             end
  154.         end
  155.  
  156.         get Msg of Obj to Ret_Val
  157.  
  158.         procedure_return Ret_Val
  159.     end_procedure
  160.  
  161.     procedure Return_To_Prior_Scope
  162.         delegate send Return_To_Prior_Scope
  163.     end_procedure
  164.  
  165.     procedure set Auto_Pull_Down_State integer Flag
  166.         delegate set Auto_Pull_Down_State to Flag
  167.     end_procedure
  168. end_class
  169.  
  170. // Shadow_text_Pull_Down_Menu class definition - shadows all items on
  171. // activation if the prior_scope is an edit class object.
  172.  
  173. class Shadow_Text_Pull_Down_Menu is a Pull_Down_Menu
  174.     procedure Activate
  175.         local integer Obj Itm Shdw Tot_Itms Old_Mode
  176.  
  177.         set_deferred 1
  178.         forward send Activate
  179.  
  180.         get Prior_Scope to Obj
  181.         if Obj EQ 0 move Desktop to Obj
  182.         get Scope_Focus of Obj to Obj
  183.  
  184.         move 1 to Shdw
  185.         if (Base_Class( Obj )) EQ Edit_Class move 0 to Shdw
  186.  
  187.         move (Item_Count( Current_Object ) - 1) to Tot_Itms
  188.  
  189.         for Itm from 0 to Tot_Itms
  190.           set Shadow_State item Itm to Shdw
  191.         loop
  192.  
  193.         set_deferred 0
  194.     end_procedure
  195. end_class
  196.  
  197.  
  198.