Module Enfrm_ds.pkg
1//************************************************************************
2//
3// Confidential Trade Secret.
4// Copyright 1987-1997 Data Access Corporation, Miami FL, USA
5// All Rights reserved
6// DataFlex is a registered trademark of Data Access Corporation.
7//
8//************************************************************************/
9
10//************************************************************************
11// File Name: EnFrm_ds.Pkg
12// Creation Date: January 1, 1991
13// Modified Date: Oct 28, 1991
14// Author(s): Steven A. Lowe
15//
16// This module contains the Entry_Form_DS class definition.
17//************************************************************************/
18
19//************************************************************************
20// Version: 1.0
21// 12-09-1992 : Created
22//
23// Author: John J. Tuohy
24//
25// 1. Adds Stop_UI_State Support
26// 2. Adds Should_Save Property // (LS) not anymore!
27// 3. Modifies Changed_State to check Should_save (fixes RT bug) (LS - not modified anymore)
28// 4. Adds Request_Save_No_Clear Message. Saves without clearing.
29// 5. Adds auto-prompt
30// 6. Adds Validate_all_items_state
31// 7. Adds dependent_item support
32// 8. Adds checkbox support
33// 9. Adds movable support (ver 1.1)
34//10. Added Validate_mode (mixin). No change by default. Added here for
35// sake of completeness.
36//11. Added entry_defaults (and better retains) through mixin
37//
38// 10-07-1993 Add include file with new exit_function procedure.
39// 03/01/94 Items 5 and 6 added for 1.1
40// 03/11/94 Item 7 and 8 for 1.1
41// 03/17/94 Item 9 v.1.1
42// 04/08/94 v1.1 (LS) Added DEO delegation.
43// 05/02/94 Added Validate_Mode to handle validation (and their errors)
44// in a more friendly fashion. Done with mixin class.
45// 07/18/94 Add Clear_mx mixin for better setting of default values
46// 09/02/94 JJT Added delegate logic to request_save_no_clear
47//************************************************************************/
48
49//************************************************************************/
50// 12/22/94 JJT Merge Changes
51// Merged the 0 class into entry_form.
52// Added DEO delegate logic to request_???? messages.
53// Cleaned up request_save a little bit removing
54// redundant checks for no server.
55// 05/22/95 JJT Added object_item_validation to focus support in
56// request_clear and request_clear_all (also see deodlgmx.pkg)
57// 05/22/95 JJT Added object_item_validation to focus support in
58// request_clear and request_clear_all (also see deodlgmx.pkg)
59// 09/04/95 JJT - Code Clean up (removed dead commented code)
60// 05/31/96 JJT - coverted to entry_form_DS and enfrm_ds.pkg. Entry_Form
61// defined in entryfrm.pkg with DD logic.
62//
63// 12/14/21 JJT - auto_clear_deo_state no longer checked by delete (it just clears)
64//************************************************************************/
65
66#CHKSUB 1 1 // Verify the UI subsystem.
67
68use NESTING.pkg //include DEO nesting standard support module
69use NAVIGATE.pkg //include DEO navigation standard support module
70use VERIFY.pkg //include Verification support module
71use SERVER.pkg //include Server support module
72use ACTIONBR.pkg //include action-bar support module
73use FINDEDIT.pkg //include Finding/Editing support module
74use ENTITEM.pkg //include Entry-Item support module
75use fndmodes.pkg // special find modes
76Use Dep_item.pkg // v1.1 Auto-dependent-item support
77Use CkBox_Mx.pkg // v1.1 checkbox mixin support
78Use DEODlgMx.pkg // v1.1 DEO delegation support
79Use Val_MX.pkg // v1.1 test validate options
80Use Clear_mx.pkg // v1.1 new defaults upon clear
81
82
83//
84// Entry_form:
85//
86//
87
88class Entry_Form_DS_mixin is a mixin
89 procedure Construct_Object integer img
90 forward send construct_object img
91 set auto_top_item_state to FALSE
92 send define_nesting //invoke DEO nesting standard support constructor
93 send define_navigation //invoke DEO navigation standard support constructor
94 send define_verify //invoke Verification support constructor
95 send define_server //invoke Server support constructor
96 send define_action_bar //invoke action-bar support constructor
97 send define_find_edit //invoke finding/editing support constructor
98 send define_entry_item //invoke entry-item support constructor
99 Send Define_Validate
100 Send Define_CheckBox_Support // v1.1 support for checkbox
101
102 Send Define_DEO_Delegate // v1.1
103 Send Define_Clear_Defaults
104 end_procedure
105
106 IMPORT_CLASS_PROTOCOL Nesting_Mixin //these statements
107 IMPORT_CLASS_PROTOCOL Navigate_Mixin //import the methods
108 IMPORT_CLASS_PROTOCOL Verify_Mixin //from the mixins
109 IMPORT_CLASS_PROTOCOL Server_Mixin //into the current class
110 IMPORT_CLASS_PROTOCOL Action_Bar_Mixin //instead of using
111 IMPORT_CLASS_PROTOCOL Find_Edit_Mixin //bulky
112
113 // entry_item_mixin must mixin after Movable_cient_mixin. A message
114 // in entry-item (move_client_location) needs to replace the message
115 // in movable-client. (see entitem)
116 IMPORT_CLASS_PROTOCOL Entry_Item_Mixin //include-files
117
118 IMPORT_CLASS_PROTOCOL DEO_Dependent_item_mixin //v1.1
119 IMPORT_CLASS_PROTOCOL Entry_CheckBox_Mixin // v1.1
120 IMPORT_CLASS_PROTOCOL DEO_Delegate_Mixin // ver 1.1
121 IMPORT_CLASS_PROTOCOL Validate_Mixin // ver 1.1
122 // Note: This augments: Next and Validate_Items
123 IMPORT_CLASS_PROTOCOL Clear_Defaults_Mixin // ver 1.1
124
125 // Create the cbox object. This only gets created if required.
126 // We create this in the class and not the mixin because you seem to
127 // get odd results if objects are created in mixin procedures
128 //
129 { Visibility=Private }
130 Function Create_Cbox_Object returns Integer // returns ID of object
131 Integer Obj
132 Object CBox is a CBox_array // keep track of list of
133 Move self to Obj // items which are check_box items
134 End_Object
135 Function_return Obj
136 End_Function
137
138 //
139 // Navigation support behavior
140 //
141 { Visibility=Private }
142 procedure Top_of_Panel
143 integer retval
144 //
145 // modification for EntItem support
146 //
147 get Object_Validation to retval
148 set Object_Validation to false
149 if (focus(desktop) <> self) send activate
150// set current_item to 0
151 set item to TRUE //go to first enterable item
152
153 set Object_Validation to retval
154 end_procedure
155
156 //
157 // Navigation support behavior
158 //
159 { Visibility=Private }
160 procedure Bottom_of_Panel
161 integer lastChild
162 //
163 // modification for Nesting support
164 //
165 if (Has_Components_State(self)) begin
166 get Find_Last_DEO to lastChild
167 if lastChild ne 0 begin
168 send Bottom_Of_Panel to lastChild
169 procedure_return
170 end
171 end
172 send activate
173// set current_item to (item_count(self) - 1)
174 set item to FALSE //go to last enterable item
175 end_procedure
176
177 //
178 // navigation support standard behavior
179 //
180 { MethodType=Event Visibility=Private Obsolete=True }
181 procedure Child_Wrapping integer direction integer xorigID
182 integer origID
183
184 if NUM_ARGUMENTS gt 1 move xorigID to origID
185 else get focus of desktop to origID
186 if origID eq 0 move self to origID
187
188 send activate
189
190 //
191 //save only if wrapping forward
192 //
193 if direction EQ 1 begin
194 if (Auto_Save_State(origID)) send request_Save to origID
195 else if (auto_save_state(self)) send request_save
196 end
197
198// if direction eq 0 set current_item to (item_count(self) - 1)
199// else set current_item to 0
200
201 // JJR set item direction - go to first/last enterable item
202
203 procedure_return 1
204 end_procedure
205
206 //
207 // created for server support
208 //
209 { Visibility=Private }
210 procedure Display
211 send entry_display 0 0
212 end_procedure
213
214 //
215 // created for server support
216 //
217 { Visibility=Private }
218 procedure Clear
219 send entry_clear 1 //notification of empty record buffer(s)
220 end_procedure
221
222 //
223 // created for server support
224 //
225 { Visibility=Private }
226 procedure Clear_All
227 send entry_clear_all 1 //notification of empty data-set
228 end_procedure
229
230 //
231 // created for server support
232 //
233 { Visibility=Private }
234 procedure Clear_Set //clear required by dependency
235 send entry_clear 1
236 end_procedure
237
238 //
239 // FindEdit support behavior
240 //
241 procedure Request_Clear
242 integer obj# retval Foc
243 If (Should_delegate_Clear(self)) ;
244 Delegate Send Request_Clear
245 else begin
246 get Server to obj#
247 //
248 // modification for Verify support
249 //
250 if (Should_Save(self) AND ;
251 (Verify_Data_Loss(self) <> 0)) ;
252 procedure_return
253
254 Get Focus of desktop to Foc
255 get Object_Item_Validation of Foc to retval
256 set Object_Item_Validation of Foc to false
257 //
258 // modification for Server support
259 //
260 if obj# ne 0 send clear to obj#
261 //
262 // standard non-server behavior
263 //
264 else send entry_clear 0
265 if (Auto_Top_Panel_State(self)) send beginning_of_panel
266 set Object_Item_Validation of Foc to retval
267 End
268 end_procedure
269
270 //
271 // FindEdit support behavior
272 //
273 procedure Request_Clear_All
274 integer obj# retval Foc
275 If (Should_delegate_Clear(self)) ;
276 Delegate Send Request_Clear_all
277 else begin
278 get Server to obj#
279 //
280 // modification for Verify support
281 //
282 if (Should_Save(self) AND ;
283 (Verify_Data_Loss(self) <> 0)) ;
284 procedure_return
285
286 Get Focus of desktop to Foc
287 get Object_Item_Validation of Foc to retval
288 set Object_Item_Validation of Foc to false
289 //
290 // modification for Server support
291 //
292 if obj# ne 0 send clear_all to obj#
293 else send entry_clear_all 0
294 if (Auto_Top_Panel_State(self)) send beginning_of_panel
295 set Object_Item_Validation of Foc to retval
296 end
297 end_procedure
298
299 //
300 // FindEdit support behavior
301 //
302 procedure Request_Delete
303 integer obj#
304 If (Should_delegate_Delete(self)) ;
305 Delegate Send Request_Delete
306 else begin
307 indicate err false
308 get Server to obj#
309 if (obj# <> 0 AND can_delete(obj#) <> 0) begin
310 //
311 // modification for Verify
312 //
313 if (Verify_Delete(self) <> 0) procedure_return
314 //
315 // modification for Server
316 //
317 set changed_State to false
318 if (Deferred_State(self)) ;
319 send Request_Assign to obj# 0 //0 means main_file of Server
320 send Request_Delete to obj#
321 // ignore auto_clear_deo_state in deletes. Always clear deleted record
322 If (not(err)) send Request_Clear
323 //[not err] if (Auto_Clear_DEO_State(self)) send Request_Clear
324 end
325 End
326 end_procedure
327
328 //
329 // FindEdit support behavior
330 //
331
332 // In forms, beginning_of_data and end_of_data is supported as a legacy method
333 // of finding first/last record. These have been replaced by Find_first and Find_last
334 // and it is suggested that you always use those methods. Beginning/End_of_data has
335 // different meanings in different DEOs like lists and editors. Providing find_first
336 // and find_last provides consistent method for record finding in all DEOs
337
338 procedure Beginning_of_Data
339 //send Request_Find FIRST_RECORD FALSE
340 Send Find_First
341 end_procedure
342
343 //
344 // FindEdit support behavior
345 //
346 procedure End_of_Data
347 //send Request_Find LAST_RECORD FALSE
348 Send Find_Last
349 end_procedure
350
351 //
352 // FindEdit support behavior
353 //
354 procedure Request_Superfind integer mode
355 integer obj# datafile
356 If (Should_delegate_Find(self)) ;
357 Delegate Send Request_SuperFind Mode
358 else begin
359 get Server to obj#
360 get data_file to datafile
361 //
362 // modification for Server
363 //
364 if datafile gt 0 begin
365 if obj# ne 0 begin
366 indicate err false
367 send Request_SuperFind to obj# mode datafile ;
368 (data_field(self,CURRENT))
369 [not found not err] begin
370 if mode lt 2 error DFERR_FIND_PRIOR_BEG_OF_FILE
371 else error DFERR_FIND_PAST_END_OF_FILE
372 end
373 end
374 //
375 // standard form behavior
376 //
377 else begin
378 send Entry_SuperFind mode datafile
379 [found] send entry_display 0 0
380 end
381 end
382 end
383 end_procedure
384
385 //
386 // FindEdit support behavior
387 //
388 procedure Request_Save
389 integer obj# curItem retval
390 If (Should_delegate_Save(self)) ;
391 Delegate Send Request_Save
392 else begin
393 get Server to obj#
394 //if (obj# = 0 OR not(Read_Only_State(obj#))) begin
395 // Since serverless saves do not save it makes no sense to even
396 // allow serverless saves to get past this point. Without this a
397 // serverless save acts like a save (verifies, validates, clears) but
398 // never performs an actual save. So, no server, no save.
399 if (obj#<>0 AND not(Read_Only_State(obj#))) begin
400 indicate err false
401 //
402 // modification for EntItem support
403 // (JJT) Removed redudant checks for server's (obj) existance.
404 get current_item to curItem
405 if (exec_validate(self,curItem) <> 0) procedure_return
406 if (exec_exit(self,curItem) <> 0) procedure_return
407 if (Should_Save(self)) begin
408 //if obj# ne 0 get Request_Validate of obj# to retval
409 //else get Validate_Items FALSE to retval
410 get Request_Validate of obj# to retval
411 if retval ne 0 procedure_Return
412 //
413 // modification for Verify support
414 //
415 if (Verify_Save(self) <> 0) procedure_return
416 //
417 // modification for Save support
418 //
419 //if obj# ne 0 begin
420 if (Deferred_State(self)) ;
421 send Request_Assign to obj# 0 //0 means main_file of server
422 send Request_Save to obj#
423 //end
424 end
425 [not err] if (Auto_Clear_DEO_State(self)) send Request_Clear
426 end
427 end
428 end_procedure
429
430 // this allows us to save a record without it clearing regardless of
431 // the Auto_Clear_DEO_State value
432 //
433 Procedure Request_Save_No_Clear
434 integer oldclr
435 If (Should_delegate_Save(self)) ;
436 Delegate Send Request_Save_no_Clear
437 else begin
438 Get Auto_Clear_DEO_State to OldClr // whatever it was
439 Set Auto_Clear_DEO_State to False // it is now NO!
440 send request_save // do your magic
441 Set Auto_Clear_DEO_State to OldClr // back to whatever it was
442 end
443 End_procedure
444
445 //
446 // FindEdit support behavior
447 //
448 procedure Request_Find integer mode integer entUpdtFlag
449 integer dataFile ser# dfrdState
450 If (Should_delegate_Find(self)) ;
451 Delegate Send Request_Find mode entUpdtFlag
452 else begin
453 get Data_File to dataFile
454 If (DataFile=0) Procedure_return // if no datafile, skip the find
455 get Server to ser#
456 get Deferred_State to dfrdState
457
458 //
459 // server augmentation & deferred-state use
460 //
461 if (ser# <> 0 AND dataFile > 0) begin
462 send Item_Find to ser# mode dataFile ;
463 (Data_Field(self,CURRENT)) entUpdtFlag TRUE dfrdState
464 [found] if dfrdState send entry_display 0 0
465 end
466 //
467 // standard form behavior
468 //
469 else begin
470 send Entry_Find mode
471 [found] send entry_display 0 0
472 end
473 End
474 end_procedure
475
476 //
477 // EntItem support behavior
478 //
479 // Support passing of optinal Item to autofind on. If not passed the
480 // runtine will figure it out. Always pass the autofind-item. The runtime
481 // also calls this not passing an item but it figure it out.
482 Procedure Entry_Autofind integer eFindMode integer iItem
483 integer obj# dataFile item#
484 get Server to obj#
485 If (Num_Arguments>=2) ;
486 Move iItem to Item# // if item passed, use it for autofind
487 else ;
488 Get autofind_item to item#
489 get Data_File item item# to dataFile
490 //
491 // modification for Server support
492 //
493 if (obj# <> 0 AND dataFile > 0) send Item_Find to obj# eFindMode dataFile ;
494 (Data_Field(self,item#)) TRUE FALSE ;
495 (Deferred_State(self))
496 //
497 // standard behavior
498 //
499 else forward send entry_autofind eFindMode
500 end_procedure
501
502 procedure End_Construct_Object
503 send Mark_Components // nesting
504 send Define_Access_Keys 0 // action_bar_keys
505 forward send End_Construct_Object
506 end_procedure
507
508end_class
509
510