home *** CD-ROM | disk | FTP | other *** search
/ The Developer Connection…ice Driver Kit for OS/2 3 / DEV3-D1.ISO / devtools / dataflex / menudef.src < prev    next >
Encoding:
Text File  |  1993-05-19  |  15.3 KB  |  476 lines
  1. // menudef.src
  2. //
  3. // Copyright 1987-1992 Data Access Corporation, Miami FL, USA
  4. // All Rights reserved
  5. //
  6. // Date: May 31, 1991 TvD
  7.  
  8. use data_set
  9. use menu
  10. use sellist
  11. use entryfrm
  12. use help
  13. use enterr
  14.  
  15. /main_title
  16. ________________________________________________________________________________
  17. /main_action_bar
  18.   ______  ____                                                                  
  19. /main_client
  20.                                                                                 
  21. ________________________________________________________________________________
  22.                                                                                 
  23.     Menu Number: __.                  Returns to Menu Number: __. (on escape)   
  24.    ┌────────────────────────────────┐                                           
  25.    │ ______________________________ │                                           
  26.    │ ______________________________ │ Action                         Password   
  27.    ├────────────────────────────────┤ ────────────────────────────── ────────   
  28.    │ ______________________________ │ ______________________________ ________   
  29.    │ ______________________________ │ ______________________________ ________   
  30.    │ ______________________________ │ ______________________________ ________   
  31.    │ ______________________________ │ ______________________________ ________   
  32.    │ ______________________________ │ ______________________________ ________   
  33.    │ ______________________________ │ ______________________________ ________   
  34.    │ ______________________________ │ ______________________________ ________   
  35.    │ ______________________________ │ ______________________________ ________   
  36.    │ ______________________________ │ ______________________________ ________   
  37.    └────────────────────────────────┘                                           
  38.               
  39.                 <_____________________>  <_____________________>                
  40.        <_________>  <________>  <_____________>  <___________>  <_______>       
  41. /menu_questions
  42.                                                                           
  43.     ┌─────────────────────────────────────────────────────────────────┐   
  44.     │ Question 1 ____________________________________________________ │   
  45.     │            ____________________________________________________ │   
  46.     │ Question 2 ____________________________________________________ │   
  47.     │            ____________________________________________________ │   
  48.     │ Question 3 ____________________________________________________ │   
  49.     │            ____________________________________________________ │   
  50.     │ Question 4 ____________________________________________________ │   
  51.     │            ____________________________________________________ │   
  52.     │ Question 5 ____________________________________________________ │   
  53.     │            ____________________________________________________ │   
  54.     │ Question 6 ____________________________________________________ │   
  55.     │            ____________________________________________________ │   
  56.     └─────────────────────────────────────────────────────────────────┘   
  57.                                                                           
  58. /delete_validate
  59. ╔═════════════════════════════════════════╗
  60. ║                                         ║
  61. ║ _______________________________________ ║
  62. ║                                         ║
  63. ║             <__>  <______>              ║
  64. ║                                         ║
  65. ╚═════════════════════════════════════════╝
  66. /invalid_insert
  67. ╔═════════════════════════════════════════╗
  68. ║                                         ║
  69. ║ There is no room to insert a menu item. ║
  70. ║                                         ║
  71. ║                  <__>                   ║
  72. ║                                         ║
  73. ╚═════════════════════════════════════════╝
  74. /menulist
  75. ╔═════════════════════════════════════╗
  76. ║ __. ______________________________  ║
  77. ║ ___ ______________________________  ║
  78. ║                                     ║
  79. ║ __. ______________________________  ║
  80. ║ ___ ______________________________  ║
  81. ║                                     ║
  82. ║ __. ______________________________  ║
  83. ║ ___ ______________________________  ║
  84. ║                                     ║
  85. ║ __. ______________________________  ║
  86. ║ ___ ______________________________  ║
  87. ╚═════════════════════════════════════╝
  88. /about
  89. ╔═════════════════════════════════════════════════════╗
  90. ║_____________________________________________________║
  91. ║                                                     ║
  92. ║                                                     ║
  93. ║                      Menudef                        ║
  94. ║                                                     ║
  95. ║                    Version 1.00b                    ║
  96. ║                                                     ║
  97. ║                                                     ║
  98. ║     Copyright 1987-1992 Data Access Corporation     ║
  99. ║         Miami FL, USA - All rights reserved         ║
  100. ║                                                     ║
  101. ║               Memory: __________ Bytes              ║
  102. ║                                                     ║
  103. ║                    <__>  <____>                     ║
  104. ╚═════════════════════════════════════════════════════╝
  105. /*
  106. set application_name to 'System'
  107.  
  108. open menu
  109. if lasterr eq 75 abort
  110.  
  111. name_object about global
  112. name_object about_title child about
  113. name_object about_ok child about
  114. name_object main_action_bar global
  115. name_object main_client global
  116. name_object main_title child main_client
  117. name_object client_title child main_client
  118. name_object menu_head child main_client
  119. name_object menulist child menu_head
  120. name_object menu_body child main_client
  121. name_object delete_option_validate child menu_body
  122. name_object invalid_insert child menu_body
  123. name_object invalid_insert_button child invalid_insert
  124. name_object menu_question child main_client
  125. name_object menu_button child main_client
  126. name_object delete_record_validate child main_client
  127.  
  128. class confirmation is a warning_msg
  129.   procedure construct_object integer image
  130.     forward send construct_object image
  131.  
  132.     set popup_state to true
  133.     set ring_state to true
  134.     set client_area_state to true
  135.     set center_state item 0 to true
  136.     set shadow_state item 0 to true
  137.     set location to 5 18 relative
  138.  
  139.     on_key kcancel send cancel
  140.  
  141.     sub_page image_button from image horizontal 2 2
  142.  
  143.     object image_button is a button
  144.       set auto_top_item_state to false
  145.  
  146.       item_list
  147.         on_item 'OK' send ok
  148.         on_item 'Cancel' send cancel
  149.       end_item_list
  150.     end_object
  151.   end_procedure
  152.  
  153.   procedure activating
  154.     forward send activating
  155.     set current_item of (image_button(current_object)) to 1
  156.   end_procedure
  157.  
  158.   function confirm string prompt returns integer
  159.     local integer retval
  160.  
  161.     set value item 0 to prompt
  162.     ui_accept current_object to retval
  163.     function_return (retval = msg_cancel)
  164.   end_function
  165. end_class
  166.  
  167. object about is a client
  168.   set location to 5 12 absolute
  169.   set block_mouse_state to true
  170.  
  171.   sub_page about_title from about 1 2
  172.   object about_title is a title
  173.     set center_state item 0 to true
  174.     set value item 0 to 'DataFlex Menu Maintenance Uitlity'
  175.   end_object
  176.  
  177.   sub_page about_ok from about horizontal 3 2
  178.   object about_ok is a button
  179.     item_list
  180.       on_item 'OK' send deactivate to about
  181.       on_item 'Help' send extended_help
  182.     end_item_list
  183.  
  184.     procedure init
  185.       local integer mem
  186.  
  187.       memory mem
  188.       set value of about_title item 1 to mem
  189.     end_procedure
  190.  
  191.     set entry_msg to init
  192.   end_object
  193. end_object
  194.  
  195. procedure about
  196.   send activate to about
  197. end_procedure
  198.  
  199. create_menu main_action_bar location 1 0 absolute
  200.   set action_bar_keys_msg to main_menu_keys
  201.  
  202.   #include recde_pd.inc
  203.   #include helpa_pd.inc
  204. end_menu
  205.  
  206. procedure main_menu_keys for desktop integer act_obj
  207.   on_key key_alt+key_r send activate to (record_pull_down(act_obj)) private
  208.   on_key key_alt+key_h send activate to (help_pull_down(act_obj)) private
  209. end_procedure
  210.  
  211. object main_client is a data_set main_client action_bar main_action_bar.obj ;
  212.   ring main_file menu
  213.  
  214.   set location to 2 0 absolute
  215.  
  216.   on_key kexit_application send quit
  217.  
  218.   sub_page client_title from main_client 1
  219.   sub_page menu_head from main_client 2 3 4 5
  220.   sub_page menu_body from main_client rectangular 6 3 9
  221.   sub_page menu_button from main_client horizontal 33 7
  222.  
  223.   object main_title is a title
  224.     set location to -2 0 relative
  225.     set center_state item 0 to true
  226.     set value item 0 to "DataFlex Menu Maintenance Utility"
  227.   end_object
  228.  
  229.   object client_title is a title
  230.     set center_state item 0 to true
  231.     set value item 0 to 'Create/Edit Menus'
  232.   end_object
  233.  
  234.   object menu_head is an entry_form
  235.     set auto_top_item_state to false
  236.     
  237.     on_key kcancel send quit private
  238.     on_key kdownarrow send next private
  239.     on_key kuparrow send previous private
  240.  
  241.     item_list
  242.       entry_item menu.recnum { ;
  243.         autofind, ;
  244.         ientry=msg_allow_prompt, ;
  245.         iexit=msg_disallow_prompt, ;
  246.         iprompt=menulist.obj ;
  247.        }
  248.  
  249.       object menulist is a selection_list menulist popup main_file menu
  250.         set location to 1 -2 item_relative
  251.         set select_mode to auto_select
  252.         set export_item_state to true
  253.  
  254.         begin_row
  255.           entry_item menu.recnum
  256.           entry_item (menu.header1)
  257.           entry_item ("")
  258.           entry_item (menu.header2)
  259.         end_row
  260.       end_object
  261.  
  262.       entry_item menu.default  
  263.       entry_item menu.header1  
  264.       entry_item menu.header2  
  265.     end_item_list
  266.  
  267.     procedure allow_prompt
  268.       send shadow_prompt to menu_button false
  269.     end_procedure
  270.  
  271.     procedure disallow_prompt
  272.       send shadow_prompt to menu_button true
  273.     end_procedure
  274.  
  275.     procedure entering returns integer
  276.       local integer retval
  277.  
  278.       forward get msg_entering to retval
  279.       if retval eq 0 send rotate_up to menu_body
  280.       procedure_return retval
  281.     end_procedure
  282.   end_object
  283.  
  284.   object menu_body is an entry_form
  285.     set auto_top_item_state to false
  286.  
  287.     on_key kcancel send quit private
  288.     on_key kadd_mode send insert_line private
  289.     on_key kcut send delete_option private
  290.  
  291.     item_list
  292.       entry_item menu.pr1  
  293.       entry_item menu.ac1  
  294.       entry_item menu.pw1  
  295.       entry_item menu.pr2  
  296.       entry_item menu.ac2  
  297.       entry_item menu.pw2  
  298.       entry_item menu.pr3  
  299.       entry_item menu.ac3  
  300.       entry_item menu.pw3  
  301.       entry_item menu.pr4  
  302.       entry_item menu.ac4  
  303.       entry_item menu.pw4  
  304.       entry_item menu.pr5  
  305.       entry_item menu.ac5  
  306.       entry_item menu.pw5  
  307.       entry_item menu.pr6  
  308.       entry_item menu.ac6  
  309.       entry_item menu.pw6  
  310.       entry_item menu.pr7  
  311.       entry_item menu.ac7  
  312.       entry_item menu.pw7  
  313.       entry_item menu.pr8  
  314.       entry_item menu.ac8  
  315.       entry_item menu.pw8  
  316.       entry_item menu.pr9  
  317.       entry_item menu.ac9  
  318.       entry_item menu.pw9  
  319.     end_item_list
  320.  
  321.     object delete_option_validate is a confirmation delete_validate
  322.     end_object
  323.  
  324.     object invalid_insert is a message
  325.       set popup_state to true
  326.       set ring_state to true
  327.       set client_area_state to true
  328.       set location to 5 18 relative
  329.  
  330.       sub_page invalid_insert_button from invalid_insert 1
  331.  
  332.       object invalid_insert_button is a button
  333.         item_list
  334.           on_item 'OK' send ok
  335.         end_item_list
  336.       end_object
  337.  
  338.       procedure tell_em
  339.         local integer retval
  340.  
  341.         ui_accept current_object to retval
  342.       end_procedure
  343.     end_object
  344.  
  345.     procedure no_insert
  346.       send tell_em to invalid_insert
  347.     end_procedure
  348.  
  349.     procedure delete_option
  350.       local integer option inum
  351.  
  352.       move (current_item(current_object) / 3 * 3) to option
  353.       indicate go as (value(current_object,option) = '')
  354.       [not go] indicate not go as (confirm(delete_option_validate.obj, ;
  355.         "The current menu item will be deleted.")) ne 0
  356.       [go] begin
  357.         move option to inum
  358.         while inum lt 24
  359.           set value item inum to (value(current_object,inum + 3))
  360.           set item_changed_state item inum to true
  361.           increment inum
  362.         end
  363.         send clear_option 24
  364.         set current_item to option
  365.       end
  366.     end_procedure
  367.  
  368.     procedure insert_line
  369.       local integer option inum
  370.  
  371.       move ((current_item(current_object) / 3) * 3) to option
  372.       if (value(current_object,24)) eq '' begin
  373.         move 23 to inum
  374.         while inum ge option
  375.           set value item (inum + 3) to (value(current_object,inum))
  376.           set item_changed_state item (inum + 3) to true
  377.           decrement inum
  378.         end
  379.         send clear_option option
  380.         set current_item to option
  381.       end
  382.       else send no_insert
  383.     end_procedure
  384.  
  385.     procedure clear_option integer option
  386.       local integer inum
  387.  
  388.       for inum from option to (option + 2)
  389.         set value item inum to ''
  390.         set item_changed_state item inum to true
  391.       loop
  392.     end_procedure
  393.  
  394.     procedure entering returns integer
  395.       local integer retval
  396.  
  397.       forward get msg_entering to retval
  398.       if retval eq 0 send clear_buttons to menu_button false
  399.       procedure_return retval
  400.     end_procedure
  401.  
  402.     procedure exiting integer new_obj returns integer
  403.       local integer retval
  404.  
  405.       forward get msg_exiting new_obj to retval
  406.       if retval eq 0 send clear_buttons to menu_button true
  407.       procedure_return retval
  408.     end_procedure
  409.   end_object
  410.  
  411.   object menu_questions is an entry_form
  412.     set location to 4 3 relative
  413.     set auto_top_item_state to false
  414.  
  415.     on_key kcancel send quit private
  416.  
  417.     item_list
  418.       entry_item menu.qa1  
  419.       entry_item menu.qb1  
  420.       entry_item menu.qa2  
  421.       entry_item menu.qb2  
  422.       entry_item menu.qa3  
  423.       entry_item menu.qb3  
  424.       entry_item menu.qa4  
  425.       entry_item menu.qb4  
  426.       entry_item menu.qa5  
  427.       entry_item menu.qb5  
  428.       entry_item menu.qa6  
  429.       entry_item menu.qb6  
  430.     end_item_list
  431.   end_object
  432.  
  433.   object menu_button is a button
  434.     set focus_mode to pointer_only
  435.  
  436.     item_list
  437.       on_item 'Shift+F10=Insert Item' send insert_line to menu_body
  438.       on_item 'Alt+Minus=Delete Item' send delete_option to menu_body
  439.       on_item 'F4=Prompt' send prompt to menu_head
  440.       on_item 'F5=Clear' send clear
  441.       on_item 'F6=Next Panel' send switch
  442.       on_item 'Alt+F4=Exit' send quit
  443.       on_item 'F1=Help' send extended_help
  444.     end_item_list
  445.  
  446.     procedure clear_buttons integer state
  447.       set shadow_state item 0 to state
  448.       set shadow_state item 1 to state
  449.     end_procedure
  450.  
  451.     procedure shadow_prompt integer state
  452.       set shadow_state item 2 to state
  453.     end_procedure
  454.  
  455.     send clear_buttons true
  456.     send shadow_prompt false
  457.   end_object
  458.  
  459.   object delete_record_validate is a confirmation delete_validate
  460.   end_object
  461.  
  462.   function delete_confirmation returns integer // 1 eq OK
  463.     function_return (confirm(delete_record_validate.obj, ;
  464.       "The current menu will be deleted."))
  465.   end_procedure
  466.  
  467.   set verify_delete_msg to get_delete_confirmation
  468.  
  469.   procedure quit returns integer
  470.     procedure_return 1
  471.   end_procedure
  472. end_object
  473.  
  474. start_ui main_client
  475. abort
  476.