home *** CD-ROM | disk | FTP | other *** search
/ The Developer Connection…ice Driver Kit for OS/2 3 / DEV3-D1.ISO / devtools / dataflex / picklist.pkg < prev    next >
Encoding:
Text File  |  1993-08-10  |  8.3 KB  |  265 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/picklist.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: picklist.pkg,v $
  16. //Revision 1.1  1992/09/08  14:43:08  james
  17. //Initial revision
  18. //
  19. //Revision 1.7  92/06/05  16:32:31  steve-l
  20. //altered set current_item occurrances to use set item false/true/2/3 instead,
  21. //in order to properly handle displayonly/noenter items on top-of-panel et al.
  22. //
  23. //Revision 1.6  92/05/29  14:06:05  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.5  92/05/14  15:47:38  unknown
  29. //Updated Copyright slug - SWM.
  30. //
  31. //Revision 1.4  92/03/29  18:45:08  lee
  32. //added MSG_END_CONSTRUCT_OBJECT, moved ENDMAC macro stuff into END_CONSTRUCT-
  33. //OBJECT procedures (in .pkgs). moved Flag_ITems to list.pkg after generalizing
  34. //it based on PROTOTYPE_OBJECT instead of Whether or not it is a table-oriented
  35. //object. Moved define_access_keys mechanism completely into actionbr.pkg.
  36. //fixed two typos: import_class_protocol used !# instead of !3, and register-
  37. //procedure used !1 instead of !2.
  38. //
  39. //Revision 1.3  92/03/09  19:03:50  james
  40. //Added #CHKSUB directive to insure source
  41. //only compiled with correct revision of 
  42. //compiler.
  43. //
  44. //Revision 1.2  92/01/13  17:39:45  steve-l
  45. //DAR 2241: send entering retval  changed to  get msg_entering to retval.
  46. //
  47. //Revision 1.1  91/10/23  10:21:59  elsa
  48. //Initial revision
  49. //
  50. //************************************************************************/
  51.  
  52. //************************************************************************
  53. //     File Name: PickList.Pkg
  54. // Creation Date: January 1, 1991
  55. // Modified Date: January 13, 1992
  56. //     Author(s): Steven A. Lowe
  57. //
  58. // This module contains the Pick_List class definition.
  59. //************************************************************************/
  60.  
  61. #CHKSUB 1 1 // Verify the UI subsystem.
  62.  
  63. USE WideList
  64. USE Server
  65. USE List
  66.  
  67. class Pick_List is a Wide_List STARTMAC plStart
  68.  
  69.   procedure construct_object integer img
  70.     forward send construct_object img
  71.     send define_list    //invoke constructor for list support
  72.     set export_item_state to TRUE  //change default to export item value
  73.     send define_server  //invoke constructor for server support
  74.   end_procedure
  75.  
  76.   IMPORT_CLASS_PROTOCOL LIST_Mixin     //include list support module
  77.   IMPORT_CLASS_PROTOCOL SERVER_Mixin   //include server support module
  78.  
  79.   procedure Initialize_List
  80.     local integer pscope item#
  81.     local string val
  82.     if (item_count(current_object)) lt 1 begin
  83.       send fill_list
  84.       get Invoking_Object_ID to pScope
  85.       if pscope ne 0 begin
  86.         get value of pscope item CURRENT to val
  87.         move 0 to item#
  88.         if val gt "" get item_matching val item#  //item# passed & returned
  89.         if item# ge 0 set current_item to item#
  90.       end
  91.     end
  92.   end_procedure
  93.  
  94.   procedure Fill_List  //invoked by Initialize_List - intended for override
  95.   end_procedure
  96.  
  97.   function first_selected_item returns integer
  98.     local integer count maxx
  99.     move (item_count(current_object) - 1) to maxx
  100.     for count from 0 to maxx
  101.       if (select_state(current_object,count)) function_Return count
  102.     loop
  103.   end_function
  104.  
  105.   procedure move_value_out
  106.     local integer item# obj# 
  107.     local string val
  108.     get first_selected_item to item#
  109.     get Invoking_Object_ID to obj#
  110.     if obj# ne 0 begin
  111.       if (Export_Item_State(current_object)) begin
  112.         get value item item# to val
  113.         set value of obj# item CURRENT to val
  114.         set item_changed_state of obj# item CURRENT to TRUE
  115.       end
  116.     end
  117.   end_procedure
  118.  
  119.   procedure Entering returns integer
  120.     local integer retval item# selMode
  121.     forward get msg_Entering to retval
  122.     get current_item to item#
  123.     set Original_Selection to item#
  124.     get select_mode to selMode
  125.     if (SelMode = AUTO_SELECT) set select_state item item# to true
  126.     procedure_return retval
  127.   end_procedure
  128.  
  129.   procedure CANCEL returns integer
  130.     set current_item to (Original_Selection(current_object)) //set SelState?
  131.     send request_cancel
  132.   end_procedure
  133.  
  134.   function next_selection returns integer  //returns -1 if no selections
  135.     local integer selCounter retval maxx
  136.     get Enumeration_Counter to selCounter
  137.     calc (item_count(current_object) - 1) to maxx
  138.     if selCounter le maxx begin
  139.       for retval from selCounter to maxx
  140.         if (select_state(current_object,retval)) begin
  141.           set Enumeration_Counter to (retval + 1)
  142.           set current_item to retval
  143.           function_return retval
  144.         end
  145.       loop
  146.       function_Return -1    //no more items
  147.     end
  148.     else function_Return -1 //no more items
  149.   end_function
  150.  
  151.   procedure entry_display integer mfile# integer flag
  152.     local integer item# selMode file#
  153.     local string astr
  154.     get target_file to file#
  155.     if mfile# eq 0 is_file_included file# 1  //sets FOUND
  156.     else indicate FOUND as (file# = mfile# OR flag = TRUE)
  157.     [found] begin
  158.       get select_mode to selMode
  159.       if (SelMode = SINGLE_SELECT OR SelMode = AUTO_SELECT) begin
  160.         if (file# > 0) begin
  161.           move file# to filenumber
  162.           get target_field to fieldindex
  163.           move Indirect_File.RECNUM to astr
  164.           get item_matching item astr to item#
  165.           if item# ge 0 begin
  166.             set current_item to item#
  167.             set select_state item item# to true
  168.           end
  169.           else set select_count to 0
  170.         end
  171.       end
  172.     end
  173.   end_procedure
  174.  
  175.   procedure entry_update integer mfile# integer flag
  176.     local integer item# file# selMode
  177.     local string astr
  178.     get target_file to file#
  179.     if (mfile# = 0 AND flag = 3) is_file_included file# 1  //sets FOUND
  180.     else indicate FOUND as (file# = mfile# OR flag = TRUE OR mfile# = 0)
  181.     [found] begin
  182.       get select_mode to selMode
  183.       if ((SelMode = SINGLE_SELECT OR SelMode = AUTO_SELECT) AND ;
  184.           Select_Count(current_object) > 0 AND ;
  185.           (mfile# = 0 OR mfile# = file#)) begin
  186.         get first_selected_item to item#
  187.         get value item item# to astr
  188.         move file# to filenumber
  189.         if file# gt 0 begin
  190.           get target_field to fieldindex
  191.           move astr to Indirect_File.RECNUM
  192.         end
  193.       end
  194.     end
  195.   end_procedure
  196.  
  197.   procedure beginning_of_data
  198. //    set current_item to 0
  199.     set item 3                  //go to first item and column in list
  200.   end_procedure
  201.  
  202.   procedure end_of_data
  203. //    set current_item to (item_count(current_object) - 1)
  204.     set item 2                  //go to last item and column in list
  205.   end_procedure
  206.  
  207.   procedure clear
  208.     get target_file to filenumber
  209.     if filenumber gt 0 is_file_included filenumber 1
  210.     else indicate FOUND TRUE
  211.     [FOUND] begin
  212.       send beginning_of_data
  213.       set select_count to 0
  214.     end
  215.   end_procedure
  216.  
  217.   procedure clear_set
  218.     send clear
  219.   end_procedure
  220.  
  221.   procedure clear_all
  222.     send clear
  223.   end_procedure
  224.  
  225.   procedure display
  226.     send entry_display 0 0
  227.   end_procedure
  228.  
  229.   //
  230.   // override of SERVER.PKG procedure
  231.   //
  232.   procedure find_servers_to_watch integer tableFlag
  233.     local integer file# obj# srvr#
  234.     get Server to srvr#
  235.     if srvr# ne 0 begin
  236.       get target_file to file#
  237.       get which_data_set of srvr# file# to obj#
  238.       if (obj# <> 0 AND obj# <> srvr#) send add_Watched_server obj#
  239.     end
  240.   end_procedure
  241.  
  242.   procedure End_Construct_Object
  243.     send Flag_Items // mark checkbox items
  244.     forward send End_Construct_Object
  245.   end_procedure
  246.  
  247. end_class
  248.  
  249.  
  250. //
  251. // Support Commands
  252. //
  253.  
  254. //
  255. // plStart <class> <image> { ACTION_BAR <actionbar#> } { POP_UP } { RING }
  256. //        { RADIO } { FOR <fieldName> } { USING <dataSetID> }
  257. //
  258. #COMMAND plStart R R
  259.   FORWARD_BEGIN_CONSTRUCT !1 !2 !3 !4 !5 !6 !7 !8 !9
  260.   Bind_Radio !3 !4 !5 !6 !7 !8 !9
  261.   Bind_Target !3 !4 !5 !6 !7 !8 !9
  262.   Bind_Using !3 !4 !5 !6 !7 !8 !9
  263. #ENDCOMMAND
  264.                                                   
  265.