home *** CD-ROM | disk | FTP | other *** search
/ The Developer Connection…ice Driver Kit for OS/2 3 / DEV3-D1.ISO / devtools / dataflex / sellist.pkg < prev    next >
Encoding:
Text File  |  1993-08-10  |  16.4 KB  |  489 lines
  1. //************************************************************************
  2. //
  3. // Copyright 1987-1992 Data Access Corporation, Miami FL, USA
  4. // All Rights reserved
  5. // DataFlex is a registered trademark of Data Access Corporation.
  6. //
  7. //
  8. //     $Source: /u3/source.30/product/pkg/RCS/sellist.pkg,v $
  9. //     $Revision: 1.1 $
  10. //     $State: Exp $
  11. //     $Author: james $
  12. //     $Date: 1992/09/08 14:43:08 $
  13. //     $Locker:  $
  14. //
  15. //     $Log: sellist.pkg,v $
  16. //Revision 1.1  1992/09/08  14:43:08  james
  17. //Initial revision
  18. //
  19. //Revision 1.12  92/07/01  01:42:42  lee
  20. //first_selected_item now returns -1 if no items/records are selected.
  21. //,
  22. //
  23. //Revision 1.11  92/05/29  14:06:02  lee
  24. //removed end_construct_* messages from mixins; now, classes that use the mixin
  25. //send the message that used to be sent by the end_construct_* message (for
  26. //efficiency).
  27. //
  28. //Revision 1.10  92/05/14  17:17:26  SWM
  29. //Updated Copyright slug.
  30. //
  31. //Revision 1.9  92/04/01  00:33:40  lee
  32. //removed navstart and liststart (unused), renamed bind_main_file and bind_index
  33. //in datalist to bind_list_main_file and bind_list_index to avoid conflict with
  34. //commands used by data_set, moved bind_static from sellist to datalist as it
  35. //only sets properties defined in datalist (not sellist).
  36. //
  37. //Revision 1.8  92/03/29  18:45:11  lee
  38. //added MSG_END_CONSTRUCT_OBJECT, moved ENDMAC macro stuff into END_CONSTRUCT-
  39. //OBJECT procedures (in .pkgs). moved Flag_ITems to list.pkg after generalizing
  40. //it based on PROTOTYPE_OBJECT instead of Whether or not it is a table-oriented
  41. //object. Moved define_access_keys mechanism completely into actionbr.pkg.
  42. //fixed two typos: import_class_protocol used !# instead of !3, and register-
  43. //procedure used !1 instead of !2.
  44. //
  45. //Revision 1.7  92/03/27  16:21:42  steve-l
  46. //CANCEL altered to properly refind parent-records
  47. //
  48. //Revision 1.6  92/03/18  12:39:15  steve-l
  49. //altered all calls to vfind to perform a relate if successful
  50. //
  51. //Revision 1.5  92/03/09  19:04:18  james
  52. //Added #CHKSUB directive to insure source
  53. //only compiled with correct revision of 
  54. //compiler.
  55. //
  56. //Revision 1.4  92/01/15  18:12:41  steve-l
  57. //DAR# 2440 - FIRST_CHARACTER search mode supported for virtual lists
  58. //
  59. //Revision 1.3  92/01/13  17:38:48  steve-l
  60. //DAR 2241: send entering retval  changed to  get msg_entering to retval.
  61. //
  62. //Revision 1.2  91/11/08  09:22:28  steve-l
  63. //it
  64. //
  65. //************************************************************************/
  66.  
  67. //************************************************************************
  68. //     File Name: SelList.Pkg
  69. // Creation Date: January 1, 1991
  70. // Modified Date: January 15, 1992
  71. //     Author(s): Steven A. Lowe
  72. //
  73. // This module contains the Selection_List class definition.
  74. //************************************************************************/
  75.  
  76. #CHKSUB 1 1 // Verify the UI subsystem.
  77.  
  78. use Set
  79. use DataList
  80. use List
  81.  
  82. register_procedure refind_Records
  83. register_function current_record returns integer
  84.  
  85. class Selection_List is a Data_List STARTMAC slStart
  86.  
  87.   procedure construct_object integer img
  88.     forward send construct_object img
  89.     on_key kBegin_of_Data SEND Beginning_of_Data  PRIVATE
  90.     on_key kEnd_of_Data   SEND End_of_Data        PRIVATE
  91.     object Selected_Items is a Set 
  92.     end_object
  93.     send define_list  //invoke constructor for list support
  94.   end_procedure
  95.  
  96.   IMPORT_CLASS_PROTOCOL LIST_Mixin   //include list support module
  97.  
  98.   function select_count returns integer
  99.     local integer retval
  100.     if (Batch_State(current_object)) forward get select_count to retval
  101.     else move (item_count(Selected_Items(current_object))) to retval
  102.     function_return retval
  103.   end_function
  104.  
  105.   procedure set select_count integer newval
  106.     forward set select_count to newval
  107.     if (Batch_State(current_object) = 0) ;
  108.         set item_count of (Selected_Items(current_object)) to newval
  109.   end_procedure
  110.  
  111.   function first_selected_item returns integer
  112.     local integer count maxx
  113.     if (Batch_State(current_object)) begin
  114.       move (item_count(current_object) - 1) to maxx
  115.       for count from 0 to maxx
  116.         if (select_state(current_object,count)) function_Return count
  117.       loop
  118.     end
  119.     else begin
  120.       if (select_count(current_object) > 0) begin
  121.         get array_Value of (Selected_Items(current_object)) item 0 to count
  122.         function_Return count
  123.       end
  124.     end
  125.     function_return -1 // no selected items/records
  126.   end_function
  127.  
  128.   procedure move_value_out
  129.     local integer item# srvr# obj# oldDisp mainfile
  130.     local string val
  131.     get first_selected_item to item#
  132.     get Invoking_Object_ID to obj#
  133.     if (Batch_State(current_object)) begin
  134.       get value item item# to val
  135.       set value of obj# item CURRENT to val
  136.       set item_changed_state of obj# item CURRENT to TRUE
  137.     end
  138.     else begin
  139.       get Server to srvr#
  140.       get main_file to mainfile
  141.       if srvr# ne 0 begin
  142.         get line_display_State to oldDisp
  143.         set line_display_State to true
  144.         send Find_by_RecNum to srvr# mainfile item#
  145.         set line_display_State to oldDisp
  146.       end
  147.       else if mainfile ne 0 begin
  148.         move mainfile to filenumber
  149.         move 0 to fieldindex
  150.         clear Indirect_File
  151.         move item# to Indirect_File.RECNUM
  152.         find eq Indirect_File.RECNUM
  153.       end
  154.       [found] if obj# ne 0 begin
  155.         send entry_display to obj# 0 0
  156.         if (Export_Item_State(current_object)) begin
  157.           get value item (base_item(current_object)) to val
  158.           set value of obj# item CURRENT to val
  159.           set item_changed_state of obj# item CURRENT to TRUE
  160.         end
  161.       end
  162.     end
  163.     set changed_state to false  //list not changed after value exported
  164.   end_procedure
  165.  
  166.   procedure Entering returns integer
  167.     local integer retval obj#
  168.     get Server to obj#
  169.     if (Batch_State(current_object)) begin
  170.       forward get msg_Entering to retval
  171.       set Original_Selection to (current_item(current_object))
  172.     end
  173.     else begin
  174.       if obj# ne 0 set Original_Selection to (Current_Record(obj#))
  175.       else begin
  176.         get main_file to filenumber
  177.         if filenumber ne 0 begin
  178.           move 0 to fieldindex
  179.           set Original_Selection to Indirect_File.RECNUM
  180.         end
  181.         else set Original_Selection to 0
  182.       end
  183.       forward get msg_Entering to retval
  184.     end
  185.     if (Select_Mode(current_object) = AUTO_SELECT) ;
  186.         set select_state item CURRENT to true
  187.     procedure_return retval
  188.   end_procedure
  189.  
  190.   procedure CANCEL returns integer
  191.     local integer srvr# rec# file# oldinuse
  192.     if (Batch_State(current_object)) begin
  193.       set current_item to (Original_Selection(current_object))
  194.       send request_cancel
  195.     end
  196.     else begin
  197.       send request_cancel
  198.       get main_file to file#
  199.       if file# ne 0 begin
  200.         get Server to srvr#
  201.         get Original_Selection to rec#
  202.         if (srvr# <> 0 AND current_record(srvr#) = rec#) begin
  203.           send refind_records to srvr#
  204.           if (oldinuse = False) set in_use_state of srvr# to False
  205.         end
  206.         else begin  //no server or server's curRec <> OrigSel rec#
  207.           move file# to FILENUMBER
  208.           move 0 to FIELDINDEX
  209.           clear Indirect_File
  210.           if rec# ne 0 begin
  211.             move rec# to Indirect_File.RECNUM
  212.             find eq Indirect_File.RECNUM
  213.           end
  214.           relate Indirect_File
  215.         end
  216.       end
  217.     end
  218.   end_procedure
  219.  
  220.   procedure Initialize_List
  221.     forward send initialize_list
  222.     if (static_state(current_object)) set entry_msg to msg_none
  223.   end_procedure
  224.  
  225.   Procedure SET SELECT_STATE integer item# integer newState
  226.     local integer rowID itemID selMode selArr
  227.     get select_mode to selMode
  228.     if selMode eq NO_SELECT procedure_return  //do nothing
  229.     if item# eq CURRENT get current_item to item#
  230.     if newState eq TOGGLE_STATE ;
  231.       move (not(select_State(current_object,item#))) to newState
  232.     Forward set select_State item item# to newState
  233.     if (not(Batch_State(current_object))) begin
  234.       get row item item# to rowID
  235.       get record_number item rowID to itemID
  236.       move (Selected_Items(current_object)) to selArr
  237.       if (select_State(current_object,item#)) begin
  238.         if ((selMode = AUTO_SELECT) ;
  239.          OR (selMode = SINGLE_SELECT)) ;
  240.           set item_count of selArr to 0
  241.         send Add_Element to selArr itemID
  242.       end
  243.       else send Remove_Element to selArr itemID
  244.     end
  245.   End_Procedure
  246.  
  247.   function next_selection returns integer  //returns -1 if no selections
  248.     local integer rec# SelArrID selCounter obj# retval maxx
  249.     move (Selected_Items(current_object)) to SelArrID
  250.     get Enumeration_Counter to selCounter
  251.     if (Batch_State(current_object)) begin
  252.       calc (item_count(current_object) - 1) to maxx
  253.       if selCounter le maxx begin
  254.         for retval from selCounter to maxx
  255.           if (select_state(current_object,retval)) begin
  256.             set Enumeration_Counter to (retval + 1)
  257.             set current_item to retval
  258.             function_return retval
  259.           end
  260.         loop
  261.         function_Return -1  //no more items
  262.       end
  263.     end
  264.     else if selCounter lt (select_count(current_object)) begin
  265.       get array_value of SelArrID item selCounter to rec#
  266.       set array_value of SelArrID item selCounter to 0    //deselect item
  267.       set Enumeration_Counter to (selCounter + 1)
  268.       get server to obj#
  269.       if obj# ne 0 send read_by_recnum to obj# (main_file(current_object)) rec#
  270.       function_return rec#
  271.     end
  272.     else function_Return -1
  273.   end_function
  274.  
  275.   procedure entry_update integer mfile# integer flag
  276.     local integer item# file# selMode
  277.     local string astr
  278.     get target_file to file#
  279.     get select_mode to selMode
  280.     if ((SelMode = SINGLE_SELECT OR SelMode = AUTO_SELECT) AND ;
  281.         Select_Count(current_object) > 0 AND ;
  282.         (mfile# = 0 OR mfile# = file#)) begin
  283.       if (Batch_State(current_object)) begin
  284.         get first_selected_item to item#
  285.         get value item item# to astr
  286.         move file# to filenumber
  287.         if file# gt 0 begin
  288.           get target_field to fieldindex
  289.           move astr to Indirect_File.RECNUM
  290.         end
  291.       end
  292.     end
  293.   end_procedure
  294.  
  295. //  procedure INSERT_NEW_ROW integer row#  //insert & display row before specified row#
  296. //    local integer rec#
  297. //    forward send insert_new_row row#
  298. //    get record_number item row# to rec#
  299. //    get find_element of (Selected_Items(current_object)) item rec# to rec#
  300. //    if rec# ne -1 ;
  301. //        set select_state item (row# * item_limit(current_object)) to TRUE
  302. //  end_procedure
  303.  
  304. //  procedure append_new_row     //add row at end of item list & display
  305. //    local integer rec# row#
  306. //    forward send append_new_row
  307. //    move (row_count(current_object) - 1) to row#
  308. //    get record_number item row# to rec#
  309. //    get find_element of (Selected_Items(current_object)) item rec# to rec#
  310. //    if rec# ne -1 ;
  311. //        set select_state item (row# * item_limit(current_object)) to TRUE
  312. //  end_procedure
  313.  
  314. //
  315. // replacement for commented-out augmentations, above; purpose is to ensure
  316. // item's select_state set according to row membership in selected_items
  317. //
  318.  
  319.   procedure display_row integer row#
  320.     local integer rec#
  321.     forward send display_row row#
  322.     get record_number item row# to rec#
  323.     get find_element of (Selected_Items(current_object)) item rec# to rec#
  324.     if rec# ne -1 ;
  325.         set select_state item (row# * item_limit(current_object)) to TRUE
  326.   end_procedure
  327.  
  328.  
  329.   //
  330.   // created to empty selected_items array along with list item data
  331.   //
  332.   procedure empty_list
  333.     local integer obj#
  334.     forward send empty_list
  335.     move (Selected_Items(current_object)) to obj#
  336.     if obj# ne 0 send delete_data to obj#
  337.   end_procedure
  338.  
  339.  
  340.   //
  341.   // created for Bottom_of_Panel support
  342.   //
  343.   function last_panel_item returns integer
  344.     local integer lastitem maxitem topItem
  345.     get top_item to topItem
  346.     calc (topItem + Display_Size(current_object) - 1) to lastitem
  347.     get item_count to maxitem
  348.     if lastItem gt maxitem move (maxitem - 1) to lastitem
  349.     while (record_number(current_object,(row(current_object,lastitem))) = 0 ;
  350.         AND lastitem > topItem)
  351.       decrement lastitem
  352.     end
  353.     function_return lastitem
  354.   end_function
  355.  
  356.   //
  357.   // created to support FIRST_CHARACTER searching
  358.   //
  359.   procedure key integer keyval
  360.     local integer ser# file# retval rec# ordr# oldCol mainfile curi bits
  361.     local string lookStr
  362.     if (keyval <= 255 AND search_mode(current_object) = FIRST_CHARACTER) begin
  363.  
  364.       move -1 to retval
  365.  
  366.       get current_item to curi
  367.  
  368.       move (character(keyval)) to lookStr
  369.  
  370.       get item_option of current_object item curi 19 to bits
  371.       if bits uppercase lookStr    //CAPSLOCK check
  372.  
  373.       get data_file to file#
  374.       if file# le 0 begin
  375.         forward send key keyval
  376.         procedure_return       //can't find if no valid main file
  377.       end
  378.  
  379.       get Server to ser#
  380.       get main_file to mainfile
  381.       move (current_item(current_object) - base_item(current_object)) ;
  382.           to oldCol
  383.       move file# to filenumber
  384.       move 0 to fieldindex
  385.       move Indirect_File.RECNUM to rec#
  386.       move 0 to Indirect_File.RECNUM      //hold recbuf
  387.       move rec# to Indirect_File.RECNUM   //replace rec#
  388.       get data_field to fieldindex
  389.  
  390.       move lookStr to Indirect_File.RECNUM
  391.       if mainfile ne file# begin  //find in parent-file
  392.         if ser# ne 0 begin   //has a server
  393.           send Request_Superfind to ser# GE file# ;
  394.               (data_field(current_object,CURRENT))
  395.           [found] move (oldCol+top_item(current_object)) to retval  //current item
  396.         end
  397.         else begin  //no server
  398.           send entry_superfind GE mainfile
  399.           if [found] begin
  400.             send display
  401.             move (oldCol+top_item(current_object)) to retval  //current item
  402.             indicate found true
  403.           end
  404.           else begin
  405.             move file# to filenumber
  406.             move 0 to fieldindex
  407.             clear Indirect_File
  408.             move rec# to Indirect_File.RECNUM
  409.             find eq Indirect_File.RECNUM
  410.           end
  411.         end
  412.       end
  413.       else begin  //find in main-file
  414.         get Ordering to ordr#
  415.         if ser# ne 0 begin
  416.           if (Deferred_State(current_object)) begin
  417.             send Request_Read to ser# GE file# ordr#
  418.             if [found] begin
  419.               send display
  420.               move (oldCol+top_item(current_object)) to retval  //current item
  421.               indicate found true
  422.             end
  423.           end
  424.           else begin
  425.             send Request_Find to ser# GE file# ordr#
  426.             [found] move (oldCol+top_item(current_object)) to retval  //current item
  427.           end
  428.         end
  429.         else begin
  430.           if ordr# lt 0 move 0 to ordr#
  431.           vfind file# ordr# GE
  432.           if [found] begin
  433.             move file# to filenumber
  434.             move 0 to fieldindex
  435.             relate Indirect_File.RECNUM
  436.             send display
  437.             move (oldCol+top_item(current_object)) to retval  //current item
  438.             indicate found true
  439.           end
  440.         end
  441.         [not found] begin
  442.           move file# to filenumber
  443.           move 0 to fieldindex
  444.           clear Indirect_File
  445.           move rec# to Indirect_File.RECNUM
  446.           find eq Indirect_File.RECNUM
  447.         end
  448.       end
  449.       if retval ge 0 set current_item to retval
  450.     end
  451.     else forward send key keyval
  452.   end_procedure
  453.  
  454.   procedure End_Construct_Object
  455.     send Flag_Items // mark checkbox items
  456.     forward send End_Construct_Object
  457.   end_procedure
  458.  
  459. end_class
  460.  
  461. //
  462. // Support Commands
  463. //
  464.  
  465. //
  466. // slStart <class> <image> { ACTION_BAR <actionbar#> } { POP_UP } { RING }
  467. //     { VIRTUAL | BATCH } { USING <ServerID> } { MAIN_FILE <FileName> }
  468. //     { BY <Index> } { FOR <File.Field> } { STATIC } { RADIO }
  469. //
  470. #COMMAND slStart R R 
  471.   FORWARD_BEGIN_CONSTRUCT !1 !2 !3 !4 !5 !6 !7 !8 !9
  472.   Bind_SelList_PopUp !3 !4 !5 !6 !7 !8 !9
  473.   Bind_Target !3 !4 !5 !6 !7 !8 !9
  474.   Bind_Static !3 !4 !5 !6 !7 !8 !9
  475.   Bind_Radio !3 !4 !5 !6 !7 !8 !9
  476. #ENDCOMMAND
  477.  
  478. #COMMAND Bind_SelList_PopUp  //relies on inherited bind_popup to 
  479.                              //actually set popup state
  480.   #IF (!0>0)
  481.     #IFSAME !1 POP_UP POPUP
  482.       set Deferred_State to true
  483.       set Auto_Fill_State to false
  484.     #ELSE
  485.       Bind_SelList_PopUp !2 !3 !4 !5 !6 !7 !8 !9
  486.     #ENDIF
  487.   #ENDIF
  488. #ENDCOMMAND
  489.