home *** CD-ROM | disk | FTP | other *** search
/ The Developer Connection…ice Driver Kit for OS/2 3 / DEV3-D1.ISO / devtools / dataflex / dfh_util.pkg < prev    next >
Encoding:
Text File  |  1993-05-19  |  8.8 KB  |  303 lines
  1. // help maintenance utility classes
  2. // January 21, 1991
  3. // LS
  4.  
  5. #CHKSUB 1 1 // Verify the UI subsystem.
  6.  
  7. use sellist
  8. use text_win
  9.  
  10. #COMMAND USE_FILE R
  11.   #IFDEF !1.RECNUM
  12.   #ELSE
  13.     #INCLUDE !1.FD
  14.   #ENDIF
  15.  
  16.   #IFDEF !1.FILE_NUMBER
  17.   #ELSE
  18.     #SET Q$ !1.RECNUM
  19.     #REPLACE !1.FILE_NUMBER |CI!q
  20.   #ENDIF
  21.  
  22.   #IF (!0>1)
  23.     USE_FILE !2 !3 !4 !5 !6 !7 !8 !9
  24.   #ENDIF
  25. #ENDCOMMAND
  26.  
  27. #IFDEF POINTED_CURSOR_TYPE
  28. #ELSE
  29.   #REPLACE POINTED_CURSOR_TYPE |CI2
  30. #ENDIF
  31.  
  32. use_file grp sbj xrf ctx  // allow file and field references w/o opening files
  33.  
  34. class help_maintenance_text_window is a text_window
  35.     register_function filename returns string
  36.     register_function initial_highlight_color returns integer
  37.  
  38.     procedure construct_object
  39.         forward send construct_object
  40.  
  41.         property integer export_object   public 0
  42.         property integer import_object   public 0
  43.         property integer highlight_color public (initial_highlight_color(current_object))
  44.         property integer normal_colors   public (object_color(current_object))
  45.         property integer zoom_state      public 0
  46.     end_procedure
  47.  
  48.     procedure end_construct_object
  49.         local integer fnum
  50.  
  51.         local integer fil_num fld_num
  52.         local string dev_name
  53.  
  54.         get data_file item 0 to fil_num
  55.         get data_field item 0 to fld_num
  56.         move "DBMS:" to dev_name
  57.         append dev_name fil_num "," fld_num
  58.         set file_name to dev_name
  59.  
  60.         forward send end_construct_object
  61.     end_procedure
  62.  
  63.     function initial_highlight_color returns integer
  64.         local integer obj chk_obj pal ret_val
  65.  
  66.         move current_object to obj
  67.  
  68.         repeat
  69.             move obj to chk_obj
  70.             get class_palette (class(chk_obj)) to pal
  71.             if pal eq 0 get parent of chk_obj to obj
  72.         until (pal <> 0 or chk_obj = desktop)
  73.  
  74.         get palette_color pal POINTED_CURSOR_TYPE to ret_val
  75.         function_return ret_val
  76.     end_function
  77.  
  78.     procedure entering returns integer
  79.         local integer ret_val
  80.  
  81.         forward get msg_entering to ret_val
  82.  
  83.         if not ret_val begin
  84.             set object_color to ;
  85.             (highlight_color(current_object)) (low(normal_colors(current_object)))
  86.         end
  87.     end_procedure
  88.  
  89.     procedure exiting integer obj returns integer
  90.         local integer ret_val clrs
  91.  
  92.         forward get msg_exiting obj to ret_val
  93.  
  94.         if not ret_val begin
  95.             get normal_colors to clrs
  96.             set object_color to (hi(clrs)) (low(clrs))
  97.         end
  98.     end_procedure
  99.  
  100.     procedure release_focus returns integer
  101.         local integer clrs retval
  102.  
  103.         forward get msg_release_focus to retval
  104.  
  105.         if retval procedure_return retval
  106.  
  107.         get normal_colors to clrs
  108.         set object_color to (hi(clrs)) (low(clrs))
  109.     end_procedure
  110.  
  111.     procedure import_text
  112.         local integer ret_val imp_obj
  113.  
  114.         get import_object to imp_obj
  115.         ui_accept imp_obj to ret_val
  116.  
  117.         if ret_val ne msg_cancel begin
  118.             send read (filename( imp_obj ))
  119.             set changed_state of imp_obj to true
  120.         end
  121.     end_procedure
  122.  
  123.     procedure export_marked_area
  124.         local integer ret_val
  125.  
  126.         ui_accept (export_object( current_object )) to ret_val
  127.  
  128.         if ret_val ne msg_cancel begin
  129.             send copy_marked_area
  130.             send write to clipboard (filename( export_object( current_object ) ))
  131.             send mark_off
  132.         end
  133.     end_procedure
  134.  
  135.     set class_colors to u_!$ 0 0 // set colors for current class to inherit
  136. end_class
  137.  
  138. #COMMAND ASSIGN_DBMS_FIELD R . // for use in assigning the dbms field to the text_window
  139.   #PUSH !l
  140.   #SET L$ !1 //get file#
  141.   set data_file item 0 to |CI!l
  142.   #SET L$ %!1 //get field#
  143.   set data_field item 0 to |CI!l
  144.   #POP L$
  145. #ENDCOMMAND
  146.  
  147. class help_maintenance_selection_list is a selection_list
  148.     procedure construct_object integer img
  149.         forward send construct_object img
  150.  
  151.         property integer export_server         public 0 // user-specified server to export selected record to
  152.         property integer export_server_state   public 0 // determines whether to export normally or via export_server
  153.         property integer current_export_server public 0 // "real" export server - assumed if not user-specified
  154.         property integer old_popup_state       public 0 // used when making list act like popup when used inside a client
  155.  
  156.         set auto_fill_state to false // not wanted in popup selection lists
  157.         set deferred_state  to true  // assume popup = deferred
  158.     end_procedure
  159.  
  160.     procedure activating returns integer
  161.         local integer srvr# obj# ret_val
  162.  
  163.         forward get msg_activating to ret_val
  164.         if not ret_val procedure_return ret_val
  165.  
  166.         get server to srvr#
  167.  
  168.         if srvr# ne 0 begin
  169.             get which_data_set of srvr# (main_file(current_object)) to obj#
  170.             set suggested_ordering of obj# to (ordering(current_object))
  171.               // alter suggested_ordering of server that controls main_file
  172.         end
  173.     end_procedure
  174.  
  175.     procedure request_cancel
  176.         set popup_state to (old_popup_state(current_object))
  177.  
  178.         forward send request_cancel
  179.  
  180.         set current_export_server to 0
  181.         set export_server_state to false
  182.     end_procedure
  183.  
  184.     procedure add_focus integer obj returns integer
  185.         local integer exp_svr retval
  186.         local integer svr mfile
  187.  
  188.         // latch on to current record
  189.         get server to svr
  190.         if svr ne 0 begin
  191.             get main_file to mfile
  192.             send request_assign to svr mfile
  193.         end
  194.  
  195.         get export_server to exp_svr
  196.  
  197.         if exp_svr ne 0 begin
  198.             set current_export_server to exp_svr
  199.             set export_server_state to true
  200.         end
  201.         else begin
  202.             get server of (focus(desktop)) to exp_svr
  203.             if (exp_svr <> 0 and server(current_object) <> exp_svr) begin
  204.                 set current_export_server to exp_svr
  205.                 set export_server_state to true
  206.             end
  207.         end
  208.  
  209.         forward get msg_add_focus obj to retval
  210.         if retval procedure_return retval
  211.  
  212.         set old_popup_state to (popup_state(current_object))
  213.         set popup_state to true
  214.         set focus_mode to focusable
  215.     end_procedure
  216.  
  217.     procedure move_value_out
  218.         local integer exp_svr rec olddisp
  219.  
  220.         if not (export_server_state(current_object)) forward send move_value_out
  221.         else begin
  222.             get current_export_server to exp_svr
  223.             get first_selected_item to rec
  224.             get line_display_state to olddisp
  225.             set line_display_state to true
  226.             send find_by_recnum to exp_svr (main_file(current_object)) rec
  227.             set line_display_state to olddisp
  228.             set changed_state to false  //list not changed after value exported
  229.       end
  230.     end_procedure
  231.  
  232.     procedure cancel
  233.         local integer exp_svr rec
  234.  
  235.         if (export_server_state(current_object)) begin
  236.             get current_export_server to exp_svr
  237.             get original_selection to rec
  238.             if (exp_svr <> 0 and rec <> 0) ;
  239.                         send find_by_recnum to exp_svr (main_file(current_object)) rec
  240.             send request_cancel
  241.         end
  242.         else forward send cancel
  243.     end_procedure
  244. end_class
  245.  
  246. class help_maintenance_prompt_client is a client
  247.     procedure construct_object integer img
  248.         forward send construct_object img
  249.  
  250.         property integer grp_recnum   public 0
  251.         property integer sbj_recnum   public 0
  252.         property integer xrf_recnum   public 0
  253.         property integer prompt_state public 0
  254.  
  255.         set block_mouse_state to true
  256.         set popup_state       to true
  257.         set scope_state       to true
  258.     end_procedure
  259.  
  260.     procedure activate returns integer
  261.         local integer retval
  262.  
  263.         set grp_recnum to grp.recnum
  264.         set sbj_recnum to sbj.recnum
  265.         set xrf_recnum to xrf.recnum
  266.  
  267.         forward get msg_activate to retval
  268.  
  269.         procedure_return retval
  270.     end_procedure
  271.  
  272.     procedure request_cancel_area
  273.         local integer rec
  274.  
  275.         get xrf_recnum to rec
  276.         if xrf.recnum ne rec begin
  277.             clear xrf
  278.             if rec ne 0 begin
  279.                 move rec to xrf.recnum
  280.                 find eq xrf.recnum
  281.             end
  282.         end
  283.  
  284.         get sbj_recnum to rec
  285.         if sbj.recnum ne rec begin
  286.             clear sbj
  287.             if rec ne 0 begin
  288.                 move rec to sbj.recnum
  289.                 find eq sbj.recnum
  290.             end
  291.         end
  292.  
  293.         get grp_recnum to rec
  294.         if grp.recnum ne rec begin
  295.             if rec ne 0 begin
  296.                 clear grp
  297.                 move rec to grp.recnum
  298.                 find eq grp.recnum
  299.             end
  300.         end
  301.     end_procedure
  302. end_class
  303.