home *** CD-ROM | disk | FTP | other *** search
/ The Developer Connection…ice Driver Kit for OS/2 3 / DEV3-D1.ISO / devtools / dataflex / flexerr1.inc < prev    next >
Encoding:
Text File  |  1993-05-19  |  7.6 KB  |  245 lines
  1. // DataFlex Source Code
  2. // Copyright 1987-1992 Data Access Corporation, Miami FL, USA
  3. // All Rights reserved
  4. // 
  5. // LS 5/12/92
  6. // JR 2/7/92
  7.  
  8. // Since a large part of FLEXERRS.SRC was produced by DFAUTO, it seemed
  9. // reasonable to simply include the code additions where possible so
  10. // that the source could continue to be updated with DFAUTO with a minumum
  11. // of overhead. This is one of the included modules.
  12.  
  13. #REPLACE NO_DELETE_MODE         16
  14. #REPLACE NO_CREATE_MODE         64
  15.  
  16. #REPLACE LAST_USER_ERROR        100
  17. #REPLACE SYSTEM_ERROR_OFFSET    4096
  18. #REPLACE UTILITY_ERROR_OFFSET   8192
  19.  
  20. //--------------------------------------------------------------------------
  21. //--------------------------------------------------------------------------
  22.  
  23. register_Object zoomPrompt
  24. register_Object errorPrompt
  25. register_Object fileTitle
  26.  
  27. //--------------------------------------------------------------------------
  28. //--------------------------------------------------------------------------
  29.  
  30. set scope_State to TRUE
  31. set attach_Parent_State to TRUE
  32.  
  33. //--------------------------------------------------------------------------
  34. //--------------------------------------------------------------------------
  35.  
  36. procedure entry_Update integer fileNum integer flag
  37.     local integer recID
  38.     forward send entry_Update fileNum flag
  39.     if ( (errorOffset <> 0) and ;
  40.             (item_Changed_State(current_Object,base_Item(current_Object)) or flag) ) begin
  41.         get value item (base_Item(current_Object)) to recID
  42.         if ( recID <> 0 ) move ( recID - errorOffset ) to recID
  43.         move recID to Flexerrs.Recnum
  44.     end
  45. end_Procedure
  46.  
  47. procedure refresh integer mode
  48.     forward send refresh mode
  49.     if ( errorOffset <> 0 ) send display_Error_Number
  50. end_Procedure
  51.  
  52. procedure entry_Display integer fileNum integer flag
  53.     forward send entry_Display fileNum flag
  54.     if ( errorOffset <> 0 ) send display_Error_Number
  55. end_Procedure
  56.  
  57. procedure display_Error_number
  58.     local integer recID
  59.     move Flexerrs.Recnum to recID
  60.     if ( recID <> 0 ) move ( recID + errorOffset ) to recID
  61.     set value item (base_Item(current_Object)) to recID
  62. end_Procedure
  63.  
  64. //--------------------------------------------------------------------------
  65. //--------------------------------------------------------------------------
  66.  
  67. procedure request_Cancel
  68.     if ( update_Row( current_Object, ( current_Row( current_Object ) ) ) = 0 ) begin
  69.         send activate to (action_Bar_ID(current_Object))
  70.         send deactivate AREA_TYPE
  71.     end
  72. end_Procedure
  73.  
  74. procedure request_Clear
  75.     local integer svr
  76.  
  77.     [ not editOnlyState ] forward send request_Clear
  78.  
  79.     [ editOnlyState ] begin
  80.         get Server to svr
  81.  
  82.         if (current_Record(svr)) eq 0 forward send request_Clear
  83.         else send find_By_Recnum to svr (main_File(svr)) (current_Record(svr))
  84.     end
  85. end_Procedure
  86.  
  87. procedure request_Clear_All // disable this operation
  88. end_Procedure
  89.  
  90. procedure request_Delete
  91.     if (overrideEditState or ;
  92.         (not(editOnlyState) and current_Record(server(current_Object)) GT LAST_USER_ERROR)) ;
  93.         forward send request_Delete
  94.     else error DFERR_DELETE_A_PROT_REC
  95. end_Procedure
  96.  
  97. function openErrorFile string fileName string fileType number newErrorOffset integer editOnlyFlag returns integer
  98.     direct_input ( append( fileName, ".dat" ) )
  99.  
  100.     if [seqEOF] begin
  101.         close_Input
  102.         send displayError to ( errorPrompt( current_object ) ) fileName
  103.         function_Return (TRUE)
  104.     end
  105.     else begin
  106.         close_Input
  107.  
  108.         if ( update_Row( current_Object, ( current_Row( current_Object ) ) ) <> 0 ) ;
  109.             function_Return (TRUE) // save before switching!
  110.  
  111.         indicate err FALSE
  112.         close Flexerrs
  113.         open fileName as Flexerrs
  114.  
  115.         [err] begin
  116.             send request_Cancel
  117.             function_Return (TRUE)
  118.         end
  119.  
  120.         [ not overrideEditState ] indicate editOnlyState as editOnlyFlag ne 0
  121.         [ editOnlyState ] file$Mode Flexerrs (NO_DELETE_MODE + NO_CREATE_MODE)
  122.         set no_create_state to ( editOnlyState )
  123.  
  124.         move newErrorOffset to errorOffset
  125.         send setTitle to ( fileTitle( current_Object ) ) fileType fileName
  126.         send beginning_Of_Data
  127.     end
  128.  
  129.     function_Return (FALSE)
  130. end_Function
  131.  
  132. procedure openFlexerrs
  133.     if not (openErrorFile(current_Object,"FLEXERRS","User",0,FALSE)) ;
  134.         send activate
  135. end_Procedure
  136.  
  137. procedure openSystemErrors
  138.     if not (openErrorFile(current_Object,"DFERR001","System", ;
  139.             SYSTEM_ERROR_OFFSET,TRUE)) send activate
  140. end_procedure
  141.  
  142. procedure openUtilityErrors
  143.     if not (openErrorFile(current_Object,"DFERR002","Utility", ;
  144.             UTILITY_ERROR_OFFSET,TRUE)) send activate
  145. end_Procedure
  146.  
  147. //--------------------------------------------------------------------------
  148. //--------------------------------------------------------------------------
  149.  
  150. /zoomButtonImg
  151. _____________
  152. /*
  153.  
  154. object zoomButton is a button zoomButtonImg
  155.  
  156.     set location to 19 33 relative
  157.     set focus_Mode to POINTER_ONLY
  158.     set attach_Parent_State to TRUE
  159.  
  160.     item_List
  161.         on_Item "<Alt+F9=Zoom>" send zoom
  162.     end_Item_List
  163.  
  164. end_Object
  165.  
  166. //--------------------------------------------------------------------------
  167. //--------------------------------------------------------------------------
  168.  
  169. #REPLACE FLEXERRS_LOCUS  0
  170. #REPLACE DFERR001_LOCUS  1
  171. #REPLACE DFERR002_LOCUS  2
  172.  
  173. #REPLACE SEARCH_SCOPE          1
  174. #REPLACE SEARCH_POPUP          2
  175. #REPLACE SEARCH_POPUP_OR_SCOPE 3
  176.  
  177. /errorPromptImg
  178. ╔═══════════════════════════════╗
  179. ║                               ║
  180. ║         System Error...       ║
  181. ║                               ║
  182. ║ ____________ cannot be found. ║
  183. ║                               ║
  184. ║              ____             ║
  185. ║                               ║
  186. ╚═══════════════════════════════╝
  187. /*
  188.  
  189. sub_page errorMessageImg from errorPromptImg 1 
  190. sub_page errorButtonImg  from errorPromptImg 2 
  191.  
  192. object errorPrompt is a client errorPromptImg
  193.  
  194.     set location            to 5 23 absolute
  195.     set popUp_State         to TRUE
  196.     set scope_State         to TRUE
  197.     set ring_State          to TRUE
  198.     set block_Mouse_State   to TRUE
  199.  
  200.     object errorMessage is a message errorMessageImg
  201.         set focus_Mode to NONFOCUSABLE
  202.     end_object
  203.  
  204.     object errorButton is a button errorButtonImg
  205.         item_List
  206.             on_Item "<OK>" send deactivate  to ( parent( current_Object ) )
  207.         end_Item_List
  208.     end_Object
  209.  
  210.     procedure displayError string fileName
  211.         set value item 0 to ( append( fileName, ".DAT" ) )
  212.         send popUp
  213.     end_Procedure
  214.  
  215. end_Object
  216.  
  217. //--------------------------------------------------------------------------
  218. //--------------------------------------------------------------------------
  219.  
  220. /fileTitleImg
  221. ____________________________________________________________
  222. /*
  223.  
  224. object fileTitle is a message fileTitleImg
  225.  
  226.     set focus_Mode          to NONFOCUSABLE
  227.     set attach_Parent_State to TRUE
  228.     set location            to 1 10 relative
  229.  
  230.     set center_State item 0 to TRUE
  231.  
  232.     procedure setTitle string fileType string fileName 
  233.         set value item 0 to ( append( append( fileType, " Errors: " ), append( fileName, ".DAT" ) ) )
  234.     end_Procedure
  235.  
  236. end_Object
  237.  
  238. send setTitle to ( fileTitle( current_object ) ) "User" "FLEXERRS"
  239.  
  240. //--------------------------------------------------------------------------
  241. //--------------------------------------------------------------------------
  242.  
  243. set verify_Delete_Msg to get_Verify_A_Delete
  244. set verify_Save_Msg   to get_Verify_A_Save
  245.