Module Datadict.pkg
1//************************************************************************
2// Confidential Trade Secret.
3// Copyright (c) 1997-2008 Data Access Corporation, Miami Florida
4// as an unpublished work. All rights reserved.
5// DataFlex is a registered trademark of Data Access Corporation.
6//
7//************************************************************************
8
9Register_Procedure File_Field_Value_Changed
10Register_Procedure File_Field_Mask_Changed
11Register_Procedure File_Field_Label_Changed
12Register_Procedure File_Field_Option_Changed
13Register_Function Extended_DEO_State returns Integer
14Register_Function Entry_Refresh_State Returns integer
15Register_Function Item_NoPut integer iItem Returns integer
16Register_Procedure set Entry_Refresh_State integer iState
17Register_Function Allow_Foreign_New_Save_State returns integer
18Register_Function Server returns integer
19
20use VDFBase.pkg
21Use LanguageText.pkg // language support VDF pkg replacement strings
22
23Define Support$extended$fields
24
25Use Data_Set.pkg
26Use DDValtbl.pkg // validation table classes
27
28
29// Used to assign a global validation_object. This can be used for
30// automatic prompt object on non-relational validations (checks, validation_
31// tables, etc.)
32Integer DD_Global_Validation_Prompt_Object
33Move 0 to DD_Global_Validation_Prompt_Object
34
35// Used for Dso traversal marking - Private (do not use)
36Integer DD_Current_Mark_Id
37Move 0 to DD_Current_Mark_Id
38
39// Used to validate DSO structures during Save and deletes
40Enumeration_List
41 Define DD_VALIDATE_STRUCTURE_ALWAYS // Validate each save/delete operation.
42 Define DD_VALIDATE_STRUCTURE_NEVER // Never validate these operations.
43 Define DD_VALIDATE_STRUCTURE_ONCE // Validate Once (first save or delete).
44End_Enumeration_List
45
46// Used as a start for error handing in DSOs. Only affects errors that go
47// through operation_not_allowed and Field_Error. Used by Error_Report_Mode
48Enumeration_List
49 Define DD_ERROR_REPORT // Report Error on screen
50 Define DD_ERROR_NO_REPORT // Show no Error..
51End_Enumeration_List
52
53Enumeration_List
54 Define DD_Lock_on_All for 7 // 111
55 Define DD_Lock_on_New_Save_Delete for 5 // 101
56 Define DD_Lock_on_Delete for 4 // 100
57 Define DD_Lock_on_Save for 2 // 010
58 Define DD_Lock_on_New_Save for 1 // 001
59End_Enumeration_List
60
61
62Define DD_DEFAULT_ERROR_NUMBER for 999
63
64
65// This table gives an overview of the Item_Options property of an item.
66//
67// AUTOFIND-------------------------------------------------------------------+
68// FINDREQ------------------------------------------------------------------+ |
69// NOPUT------------------------------------------------------------------+ | |
70// NOENTER--------------------------------------------------------------+ | | |
71// | | | |
72// SKIPFOUND---------------------------------------------------------+ | | | |
73// RETAIN----------------------------------------------------------+ | | | | |
74// RETAINALL-----------------------------------------------------+ | | | | | |
75// FORCEPUT----------------------------------------------------+ | | | | | | |
76// | | | | | | | |
77// AUTOFIND_GE----------------------------------------------------------------|
78// | | | | | | | | |
79// REQUIRED---------------------------+ | | | | | | | | |
80// CAPSLOCK-------------------------+ | | | | | | | | | |
81// | | | | | | | | | | |
82// ZERO_SUPPRESS-----------------+ | | | | | | | | | | |
83// | | | | | | | | | | | |
84// AUTORETURN-----------+ | | | | | | | | | | | |
85// AUTOBACK-----------+ | | | | | | | | | | | | |
86// | | | | | | | | | | | | | |
87// AUTOCLEAR-+ | | | | | | | | | | | | | |
88// | | | | | | | | | | | | | | |
89// |x|x|||x||x|x||||||x|x|x||||||||x|x||x|x|x|x||x|x|x|||||||||||||||||||||
90// | | | | || | | | || | | | || | | | || | | | || | | | || | | | || | | | |
91// |3|3|2|2||2|2|2|2||2|2|2|2||1|1|1|1||1|1|1|1||1|1| | || | | | || | | | |
92// |1|0|9|8||7|6|5|4||3|2|1|0||9|8|7|6||5|4|3|2||1|0|9|8||7|6|5|4||3|2|1|0|
93
94#REPLACE DD_OPT_DEFAULTS |CI3072
95#REPLACE DD_AUTOFIND |CI1
96#REPLACE DD_FINDREQ |CI2
97#REPLACE DD_NOPUT |CI4
98#REPLACE DD_NOENTER |CI8
99#REPLACE DD_SKIPFOUND |CI16
100#REPLACE DD_RETAINALL |CI32
101#REPLACE DD_RETAIN |CI64
102#REPLACE DD_FORCEPUT |CI128
103#REPLACE DD_DISPLAYONLY |CI12 // DD_NOPUT + DD_NOENTER
104#REPLACE DD_AUTOFIND_GE |CI257 // DD_AUTOFIND + 8th bit
105
106#REPLACE DD_REQUIRED |CI262144
107#REPLACE DD_CAPSLOCK |CI524288
108#REPLACE DD_ZERO_SUPPRESS |CI1048576
109#REPLACE DD_AUTORETURN |CI16777216
110#REPLACE DD_AUTOBACK |CI33554432
111#REPLACE DD_AUTOCLEAR |CI536870912
112
113// The next replaces will be used to indicate default item-options
114// instead of a fieldnumber which is normally used.
115#REPLACE DD_DEFAULT |CI-1
116#REPLACE DD_KEYFIELD |CI-2
117#REPLACE DD_INDEXFIELD |CI-4
118
119// Special parameter options that can get passed to Set Field_Options. The
120// purpose is to clear all fields or the remaining passed parameters. Normally,
121// these are not used so it does not matter if their interface is a bit odd.
122Enumeration_list
123 Define DD_CLEAR_FIELD_OPTIONS for -1
124 Define DD_CLEAR_ALL_FIELD_OPTIONS for -2
125End_Enumeration_list
126
127#IFDEF SUPPORT$EXTENDED$FIELDS
128
129Use DDExtFld.pkg // adds extended field/pointer support
130 // for text and binary. Must support Address Type
131#ENDIF
132
133//**************************************************************************//
134// //
135// RECORD_BUFFER //
136// //
137// Every data_set will have a object based on this class. It will hold //
138// the values for the fields, the entry_options and the messages IDs of the //
139// iEntry, iExit and iValidate messages for each field. //
140// It is assumed that an object of this class will always be used as a //
141// child object of a Data_Set object. //
142// //
143// Currently the fieldtypes Overlap, Text and Binary are *not* supported. //
144// //
145// ITEM-PROPERTY ASSIGNED-FUNCTION //
146// //
147// Value The value of the field. Will be updated whenever the //
148// value of a field changes due to data-entry or a found //
149// record. //
150// Data_File Contains the filenumber. Is the same for every item. //
151// Data_Field Contains the fieldnumber for the item. Is equal to the //
152// items' itemnumber. //
153// Item_Options Used to store the standard item-options of a field. //
154// Aux_Value Used to store the foreign-item-options of a field. //
155// //
156//**************************************************************************//
157
158{ Visibility=Private }
159Class Record_Buffer is an cm_Entrylist
160
161
162
163 //************************************************************************//
164 // End_Construct_Object. //
165 // Make sure this object cannot be activated implicitely or explicitely. //
166 //************************************************************************//
167
168 Procedure End_Construct_Object
169 Forward Send End_Construct_Object
170 Set Focus_Mode to NO_ACTIVATE
171 End_Procedure
172
173
174
175 //************************************************************************//
176 // Create_Items. //
177 // This procedure will be called from the Data_Set when the Main_File is //
178 // being set. It will create an item for each field of the file in this //
179 // object. Fields of the types DF_OVERLAP, DF_TEXT and DF_BINARY are //
180 // currently not added. //
181 //************************************************************************//
182
183 Procedure Create_Items Integer iFile
184 Integer iField_Count
185 Integer iField_Type
186 Integer iField
187 Boolean bRecnumTable
188
189 Get_Attribute DF_FILE_RECNUM_TABLE Of iFile To bRecnumTable
190 Get_Attribute DF_FILE_NUMBER_FIELDS of iFile to iField_Count
191 Send Delete_Data
192 For iField from 0 to iField_Count
193 Send Add_Item MSG_None ""
194 Get_Attribute DF_FIELD_TYPE of iFile iField to iField_Type
195 If (iField_Type<>DF_TEXT and iField_Type<>DF_BINARY and iField_Type<>DF_OVERLAP) Begin // if not text, binary or overlap
196 // only setup field 0 is there is one
197 If ((iField <> 0) or (bRecnumTable)) Begin
198 Set Data_File iField to iFile
199 Set Data_Field iField to iField
200 End
201 end
202 Loop
203 End_Procedure
204
205 //************************************************************************//
206 // New_Current_Record. //
207 // This procedure will be called from the parent Data_Set whenever the //
208 // Data_Set changes its Current_Record property, or after a Save, Delete //
209 // or Clear operation. //
210 // We use this event to store the values of the fields in our local //
211 // record buffer. //
212 //************************************************************************//
213
214 Procedure OnNewCurrentRecord RowId riOld RowId riNew
215 Integer iMain_File
216 Integer iOldState
217 Delegate Get Main_File to iMain_File
218 If not (IsNullRowId(riNew)) ;
219 Send Entry_Display iMain_File TRUE // TRUE means DisplayAll
220 Else Begin
221 // we must do this to make retains not set changed_state
222 Delegate Get Change_Disabled_State to iOldState
223 Delegate Set Change_Disabled_State to TRUE
224 // if mode is anything other than clear we do a clear all (clear keeps retains, clear all does not)
225 // also do clear-all if the DDO is foreign.
226 If (Operation_mode=MODE_CLEARING AND ;
227 ( (Operation_Origin=parent(self)) OR ;
228 (Which_data_set(Operation_Origin,iMain_File)<>0) ) ) ;
229 Send Entry_Clear FALSE // FALSE means ClearedFilesOnly = No
230 else ;
231 Send Entry_Clear_all False
232 Delegate Set Change_Disabled_State to iOldState
233 Set Changed_State to False
234 End
235 End_Procedure
236
237
238 //************************************************************************//
239 // Procedure Set Changed_State. //
240 // Make sure to set the Changed_State of the Data_Set to TRUE when a //
241 // field value changes and it's not during the Setting of the Defaults. //
242 //************************************************************************//
243
244 Procedure Set Changed_State Integer iState
245 integer iNoChange
246 // Server.pkg in dso already knows this property
247 Delegate Get Change_disabled_State to iNoChange
248 If Not iNoChange Begin
249 Forward Set Changed_State to iState
250 //If iState ; // we should always delegate.
251 Delegate Set Changed_State to iState
252 End
253 End_Procedure
254
255 // Augmented to handle non DF databases JJT-8/24/00
256 // Some tables may use some field other then recnum for their record identity.
257 // This will be dfrecnum or some other numeric field. When this happens the DD have
258 // to field buffers for the same value. When an update occurs from the DD to the DB buffer
259 // an update can occur twice. If the values are the same, this does not matter. Else the highest
260 // field value will get the update (not recnum). So if someone changes recnum but not its real field
261 // finding may not work right. The DD is updated when a record is found and the API keeps the two values
262 // the same. If the user changes recnum, the real field does not get changed. That is what we are fixing
263 // here. Note that: 1) this has no effect on Dataflex databases (or any DB that has a 0 field recnum).
264 // 2) this type of update is rarely seen anyway (you have to change just the recnum and perform an entry_update).
265 //
266End_Class // Record_Buffer
267
268
269
270
271//**************************************************************************//
272// //
273// FIELD_ATTRIBUTES //
274// //
275// Objects of this class will be used to store all kinds of attributes //
276// which belong to a field. //
277// //
278// FA_MIN_VALUE //
279// Used to store the mininum value of field. //
280// //
281// FA_MAX_VALUE //
282// Used to store the maximum value of a field. //
283// //
284// FA_CHECK_VALUE //
285// Used to store a string which contains all possible values of a field. //
286// //
287// FA_CHECKBOX_TRUE //
288// Used to store the TRUE value for a checkbox field //
289// //
290// FA_CHECKBOX_FALSE //
291// Used to store the FALSE value of a checkbox field //
292// //
293// FA_TABLE_OBJECT //
294// Stores object Id of a validation table. //
295// //
296// FA_ERROR_MESSAGE //
297// Used to store a error text which will be shown to a user when a fields //
298// value violates one of the rules defined for it. //
299// This field may contain the special strings @MIN, @MAX and @CHECK. When //
300// these are used, these will be replaced by the actual value of MIN_VALUE, //
301// MAX_VALUE or CHECK_VALUE. //
302// //
303//**************************************************************************//
304
305#REPLACE FA_COUNT 4 // Total number of options.
306
307//#REPLACE FA_VALIDATION_TYPE 0
308#REPLACE FA_MIN_VALUE 0
309#REPLACE FA_CHECK_VALUE 0 // NOTE: Same as EA_MIN_VALUE
310#REPLACE FA_CHECKBOX_TRUE 0 // NOTE: Same as EA_MIN_VALUE
311#REPLACE FA_TABLE_OBJECT 0 // NOTE: Same as EA_MIN_VALUE
312#REPLACE FA_MAX_VALUE 1
313#REPLACE FA_CHECKBOX_FALSE 1 // NOTE: Same as EA_MAX_VALUE
314#REPLACE FA_ERROR_NUMBER 2
315#REPLACE FA_ERROR_MESSAGE 3
316
317// Validation Types
318Enumeration_List
319 Define FA_VALIDATION_TYPE_NONE
320 Define FA_VALIDATION_TYPE_RANGE
321 Define FA_VALIDATION_TYPE_CHECK
322 Define FA_VALIDATION_TYPE_CHECKBOX
323 Define FA_VALIDATION_TYPE_TABLE
324End_Enumeration_List
325
326
327{ Visibility=Private }
328Class Field_Attributes is a Array
329
330 //************************************************************************//
331 // Construct_object ype //
332 // Define storage for validation types. Access to storage is private. //
333 //************************************************************************//
334
335 Procedure Construct_Object
336 Forward Send Construct_Object
337 // Private: This replaces the use of arrays to get at this value. This
338 // allows us to find specific validation types (like checkboxes) more
339 // quickly than scanning an array
340 Property String Private.Validation_Types ''
341 End_Procedure
342
343 //************************************************************************//
344 // Get/Set Field_Validation_Type //
345 // Returns the extended validation type for the passed field. //
346 //************************************************************************//
347
348 Function Field_Validation_Type Integer iField Returns Integer
349 Integer iType
350 If iField ;
351 Move (mid(Private.Validation_Types(self),1,iField)) to iType
352 Else ;
353 Move FA_VALIDATION_TYPE_NONE to iType
354 Function_Return iType
355 End_Function
356
357 Procedure Set Field_Validation_Type Integer iField String sType
358 Integer iType
359 String sTypes
360 If iField Begin
361 Get Private.Validation_Types to sTypes
362 Set Private.Validation_Types to (Overstrike(sType, sTypes, iField))
363 End
364 End_Procedure
365
366 //************************************************************************//
367 // Create_Items. //
368 // Set any defaults required by this class when the main file is created. //
369 // Create a string which contains all validation types. Set all to //
370 // No extended validation type. //
371 //************************************************************************//
372
373 Procedure Create_Items
374 String sType
375 Integer iCount
376 Delegate Get Field_Count to iCOunt
377 Move FA_VALIDATION_TYPE_NONE to sType
378 Set Private.Validation_Types to (Repeat(sType,iCount))
379 End_Procedure // Create_Items
380
381 //************************************************************************//
382 // Next_Validation_Type //
383 // Return field number of next field matching the passed validation type. //
384 // Pass validation type and last position checked. Return 0 if no match //
385 //************************************************************************//
386
387 Function Next_Validation_Type String sType Integer iOffset returns integer
388 string sTypes
389 integer iPos
390 Get Private.Validation_Types to sTypes
391 Pos sType in (mid(sTypes,255,iOffset+1)) to iPos
392 If iPos Add iOffset to iPos
393 Function_Return iPos
394 End_Function
395
396
397 //************************************************************************//
398 // Procedure Set Field_Error //
399 // This procedure will be called by the Extended_Data_Set to set the //
400 // errornumber and message which will be triggered when it needs to. //
401 //************************************************************************//
402
403 Procedure Set Field_Error Integer iField Integer iErr String sMsg
404 Integer iBase
405 Move (iField * FA_COUNT) to iBase
406 Set Value (iBase + FA_ERROR_NUMBER) to iErr
407 Set Value (iBase + FA_ERROR_MESSAGE) to sMsg
408 End_Procedure
409
410 //************************************************************************//
411 // Get Field_error_Number //
412 // Get Field_error_Message //
413 // Used to retreive the error number and message for a particular field //
414 //************************************************************************//
415
416 Function Field_Error_Number Integer iField Returns Integer
417 Integer iErr
418 Get Value (iField*FA_COUNT + FA_ERROR_NUMBER) to iErr
419 Function_Return iErr
420 End_Function
421
422 Function Field_Error_Message Integer iField Returns String
423 String sValue
424 Get Value (iField*FA_COUNT + FA_ERROR_MESSAGE) to sValue
425 Function_Return sValue
426 End_Function
427
428
429 //************************************************************************//
430 // Validate_Field //
431 // This function manages the validation of a field against its extended //
432 // validations. //
433 //************************************************************************//
434
435 Function Validate_Field Integer iField Returns Integer
436 Integer iType
437 Integer iResult
438 //Get Integer_Value ((iField * FA_COUNT) + FA_VALIDATION_TYPE) to iType
439 //If Not iType ;
440 // Function_Return
441 Get Field_Validation_Type iField to iType
442 If iType eq FA_VALIDATION_TYPE_RANGE ;
443 Get Validate_Field_Range iField to iResult
444 Else If iType eq FA_VALIDATION_TYPE_CHECK ;
445 Get Validate_Field_Check iField to iResult
446 Else If iType eq FA_VALIDATION_TYPE_CHECKBOX ;
447 Get Validate_Field_Checkbox iField to iResult
448 Else If iType eq FA_VALIDATION_TYPE_TABLE ;
449 Get Validate_Field_Table iField to iResult
450 Function_Return iResult
451 End_Function
452
453
454 //************************************************************************//
455 // Field_Fill_List //
456 // All extended validations know how to send callback messages (iMsg) to //
457 // the calling object (iObj). This allows external lists to get filled w/ //
458 // the contents of a range. Used by combo boxes, spinners, etc. //
459 //************************************************************************//
460
461 Procedure Field_Fill_List integer iField integer iObj integer iMsg
462 Integer iType
463 Integer iResult
464 //Get Integer_Value ((iField * FA_COUNT) + FA_VALIDATION_TYPE) to iType
465 //If Not iType ;
466 // Procedure_Return
467 Get Field_Validation_Type iField to iType
468 If iType eq FA_VALIDATION_TYPE_RANGE ;
469 Send Field_Fill_List_Field_Range iField iObj iMsg
470 Else If iType eq FA_VALIDATION_TYPE_CHECK ;
471 Send Field_Fill_List_Field_Check iField iObj iMsg
472 Else If iType eq FA_VALIDATION_TYPE_CHECKBOX ;
473 Send Field_Fill_List_Field_Checkbox iField iObj iMsg
474 Else If iType eq FA_VALIDATION_TYPE_TABLE ;
475 Send Field_Fill_List_Field_Table iField iObj iMsg
476 End_Procedure
477
478
479 //************************************************************************//
480 // Field_Table_Object //
481 // Return the id of the validation table if one exists. Otherwise return //
482 // a zero. //
483 //************************************************************************//
484
485 Function Field_Table_Object integer iField Returns integer
486 Integer iType
487 Integer iObj
488 Integer iBase
489 Move (iField * FA_COUNT) to iBase
490 //Get Integer_Value iBase to iType
491 Get Field_Validation_Type iField to iType
492 If iType eq FA_VALIDATION_TYPE_TABLE ;
493 Get Value (iBase + FA_TABLE_OBJECT) to iObj
494 Function_Return iObj
495 End_Function
496
497
498
499 //************************************************************************//
500 // Procedure Set Field_Value_Range //
501 // Procedure to set the range for a field. It will automatically set the //
502 // validation type of the field as well. //
503 //************************************************************************//
504
505 Procedure Set Field_Value_Range Integer iField String sMin String sMax
506 Integer iBase
507 Move (iField * FA_COUNT) to iBase
508 Set Value (iBase + FA_MIN_VALUE) to sMin
509 Set Value (iBase + FA_MAX_VALUE) to sMax
510 //Set Value iBase to FA_VALIDATION_TYPE_RANGE
511 Set Field_Validation_Type iField to FA_VALIDATION_TYPE_RANGE
512 End_Procedure
513
514 //************************************************************************//
515 // Validate_Field_Range //
516 // Function to check a fields value agains a given check string. //
517 //************************************************************************//
518
519 Function Validate_Field_Range Integer iField Returns Integer
520 String sMin
521 String sMax
522 String sValue
523 Integer iField_Type
524 Integer iResult
525 Integer iFile
526 Integer iBase
527 Move (iField * FA_COUNT) to iBase
528 Get Value (iBase + FA_MIN_VALUE) to sMin
529 Get Value (iBase + FA_MAX_VALUE) to sMax
530 Delegate Get Field_Current_Value iField to sValue
531 Delegate Get Main_File to iFile
532 Get_Attribute DF_FIELD_TYPE of iFile iField to iField_Type
533 Move 0 to iResult
534 If (iField_Type=DF_ASCII) ;
535 Move (sValue < sMin OR sValue > sMax) to iResult
536 Else If (iField_Type=DF_BCD) ;
537 Move (Number(sValue) < Number(sMin) OR ;
538 Number(sValue) > Number(sMax)) to iResult
539 Else If (iField_Type=DF_DATE) ;
540 Move (Date(sValue) < Date(sMin) OR Date(sValue) > Date(sMax)) to iResult
541 Else If (iField_Type=DF_DATETIME) ;
542 Move (Cast(sValue,DateTime) < Cast(sMin,DateTime) or Cast(sValue,DateTime) > Cast(sMax,DateTime)) to iResult
543 If iResult Begin
544 Delegate Send Field_Error iField DD_INVALID_RANGE sMin sMax
545 Function_Return 1
546 End
547 End_Function
548
549 //************************************************************************//
550 // Procedure Field_fill_list_Field_Range //
551 // Callback to provide all valid value for this validation. //
552 // Just call back with the two range values //
553 //************************************************************************//
554
555 Procedure Field_Fill_List_Field_Range Integer iField Integer iObj Integer iMsg
556 String sMin
557 String sMax
558 Integer iBase
559 Move (iField * FA_COUNT) to iBase
560 Get Value (iBase + FA_MIN_VALUE) to sMin
561 Get Value (iBase + FA_MAX_VALUE) to sMax
562 Send iMsg to iObj 0 sMin '' 0 (NullrowId())
563 Send iMsg to iObj 1 sMax '' 0 (NullrowId())
564 End_Procedure
565
566 //************************************************************************//
567 // Procedure Set Field_Value_Check //
568 // Procedure to set the check for a field. It will automatically set the //
569 // validation type of the field as well. //
570 //************************************************************************//
571
572 Procedure Set Field_Value_Check Integer iField String sCheck
573 Integer iBase
574 Move (iField * FA_COUNT) to iBase
575 Set Value (iBase + FA_CHECK_VALUE) to sCheck
576 //Set Value iBase to FA_VALIDATION_TYPE_CHECK
577 Set Field_Validation_Type iField to FA_VALIDATION_TYPE_CHECK
578 End_Procedure
579
580
581 //************************************************************************//
582 // Validate_Field_Check //
583 // Function to check a fields value agains a given check string. //
584 //************************************************************************//
585
586 Function Validate_Field_Check Integer iField Returns Integer
587 String sCheck
588 String sValue
589 Integer iBase
590 Integer iPos
591 Integer iLength
592 Integer iResult
593 Integer iFile
594 Move (iField * FA_COUNT) to iBase
595 Get Value (iBase + FA_CHECK_VALUE) to sCheck
596 Delegate Get Field_Current_Value iField to sValue
597 Delegate Get Main_File to iFile
598 Get_Attribute DF_FIELD_LENGTH of iFile iField to iLength
599 Pad sValue to sValue iLength
600 // Replace the seperation characters with two of them so the user
601 // can't bypass the check by entering a seperation character.
602 Move (Replaces("|", sValue, "||")) to sValue
603 // Report an error if rules are violated.
604 Pos sValue in sCheck to iPos
605 If Not iPos Begin
606 Delegate Send Field_Error iField DD_INVALID_CHECK sCheck
607 Function_Return 1
608 End
609 End_Function
610
611 //************************************************************************//
612 // Procedure Field_fill_list_Field_Check //
613 // Callback to provide all valid value for this validation. //
614 // Call back with all valid check values //
615 //************************************************************************//
616
617 Procedure Field_Fill_List_Field_Check Integer iField Integer iObj Integer iMsg
618 String sCheck
619 Integer iBase
620 Integer iPos
621 Integer iItem
622 Move (iField * FA_COUNT) to iBase
623 Get Value (iBase + FA_CHECK_VALUE) to sCheck
624 Append sCheck "|"
625 Pos "|" in sCheck to iPos
626 While iPos
627 If iPos gt 1 Begin
628 Send iMsg to iObj iItem (Left(sCheck,iPos-1)) '' 0 (NullrowId())
629 Increment iItem
630 End
631 Mid sCheck to sCheck 255 (iPos+1)
632 Pos "|" in sCheck to iPos
633 Loop
634 End_Procedure
635
636
637
638 //************************************************************************//
639 // Procedure Set Field_CheckBox_Values //
640 // Procedure to set up a checkbox field. We will store the TRUE and FALSE //
641 // Values in the extended array. //
642 //************************************************************************//
643
644 Procedure Set Field_CheckBox_Values Integer iField String sTrue String sFalse
645 Integer iBase
646 Move (iField * FA_COUNT) to iBase
647 Set Value (iBase + FA_CHECKBOX_TRUE) to sTrue
648 Set Value (iBase + FA_CHECKBOX_FALSE) to sFalse
649 //Set Value iBase to FA_VALIDATION_TYPE_CHECKBOX
650 Set Field_Validation_Type iField to FA_VALIDATION_TYPE_CHECKBOX
651 End_Procedure
652
653
654 //************************************************************************//
655 // Function Field_CheckBox_Value //
656 // Return the Value associated with the field and its select-state. //
657 //************************************************************************//
658
659 Function Field_CheckBox_Value Integer iField Integer iState returns String
660 Integer iBase
661 Integer iType
662 String sValue
663 Move (iField * FA_COUNT) to iBase
664 //Get Value iBase to iType
665 Get Field_Validation_Type iField to iType
666 If iType ne FA_VALIDATION_TYPE_CHECKBOX ;
667 Move iState to sValue
668 Else ;
669 Get Value (iBase + If(iState,FA_CHECKBOX_TRUE,FA_CHECKBOX_FALSE));
670 to sValue
671 Function_Return sValue
672 End_Function
673
674
675 //************************************************************************//
676 // Function Field_Value_Select_State //
677 // Return the select_state based on the passed value and field //
678 //************************************************************************//
679
680 Function Field_Value_Select_State Integer iField String sValue Returns integer
681 Integer iBase
682 Integer iType
683 String sTrue
684 Integer iState
685 Integer iFile
686 Integer iField_Type
687 Move (iField * FA_COUNT) to iBase
688 Get Field_Validation_Type iField to iType
689 Get Value (iBase + FA_CHECKBOX_TRUE) to sTrue
690 If iType ne FA_VALIDATION_TYPE_CHECKBOX ;
691 Move (Not(sValue=0 OR sValue='')) to iState
692 Else Begin
693 Delegate Get Main_File to iFile
694 Get_Attribute DF_FIELD_TYPE of iFile iField to iField_Type
695 If iField_Type EQ DF_BCD ;
696 Move (number(sValue)=number(sTrue)) to iState
697 Else ; // DF_ASCII
698 Move (sValue=sTrue) to iState
699 End
700 Function_Return iState
701 End_Function
702
703
704 //************************************************************************//
705 // Validate_Field_Checkbox
706 // Check that the buffer value is one of the two checkbox values. //
707 //************************************************************************//
708
709 Function Validate_Field_Checkbox Integer iField Returns Integer
710 String sTrue
711 String sFalse
712 String sValue
713 Integer iField_Type
714 Integer iResult
715 Integer iFile
716 Integer iBase
717 Move (iField * FA_COUNT) to iBase
718 Get Value (iBase + FA_CHECKBOX_TRUE) to sTrue
719 Get Value (iBase + FA_CHECKBOX_FALSE) to sFalse
720 Delegate Get Field_Current_Value iField to sValue
721 Delegate Get Main_File to iFile
722 Get_Attribute DF_FIELD_TYPE of iFile iField to iField_Type
723 Move 0 to iResult
724 If iField_Type EQ DF_BCD ;
725 Move (Number(sValue)=Number(sTrue) OR ;
726 Number(sValue)=Number(sFalse)) to iResult
727 Else ; // DF_ASCII
728 Move (sValue=sTrue OR sValue=sFalse) to iResult
729 If Not iResult Begin
730 Delegate Send Field_Error iField DD_INVALID_CHECKBOX sTrue sFalse
731 Function_Return 1
732 End
733 End_Function
734
735 //************************************************************************//
736 // Procedure Field_fill_list_Field_Checkbox //
737 // Callback to provide all valid value for this validation. //
738 // Just call back with the two true and false values //
739 //************************************************************************//
740
741 Procedure Field_Fill_List_Field_Checkbox Integer iField Integer iObj Integer iMsg
742 String sTrue
743 String sFalse
744 Integer iBase
745 Move (iField * FA_COUNT) to iBase
746 Get Value (iBase + FA_CHECKBOX_TRUE) to sTrue
747 Get Value (iBase + FA_CHECKBOX_FALSE) to sFalse
748 Send iMsg to iObj 0 sTrue '' 0 (NullrowId())
749 Send iMsg to iObj 1 sFalse '' 0 (NullrowId())
750 End_Procedure
751
752 //************************************************************************//
753 // Procedure Set Field_Value_Table //
754 // The object keeps track of a validation table object. This table object //
755 // can be any type of object must at a minimum understand a small message //
756 // protocol (see xvaltbl.pkg for info) //
757 //************************************************************************//
758
759 Procedure Set Field_Value_Table Integer iField Integer iObj
760 Integer iBase
761 Move (iField * FA_COUNT) to iBase
762 Set Value (iBase + FA_TABLE_OBJECT) to iObj
763 //Set Value iBase to FA_VALIDATION_TYPE_TABLE
764 Set Field_Validation_Type iField to FA_VALIDATION_TYPE_TABLE
765 End_Procedure
766
767 //************************************************************************//
768 // Validate_Field_Table //
769 // This valdates against a validation table if appropriate (if a table //
770 // exists and the table's validate_State is T). It validates by passing //
771 // the message validate_value to the validation table object //
772 //************************************************************************//
773
774 Function Validate_Field_Table Integer iField Returns Integer
775 integer iBase
776 integer iTableObj
777 String sValue
778 Integer iResult
779 Move (iField * FA_COUNT) to iBase
780 Get Value (iBase + FA_TABLE_OBJECT) to iTableObj
781 If (iTableObj AND Validate_State(iTableObj) ) Begin
782 Delegate Get Field_Current_Value iField to sValue
783 Get Validate_Value of iTableOBj sValue to iResult
784 If iResult ;
785 Delegate Send Field_Error iField DD_INVALID_VALUE_TABLE
786 End
787 Function_Return iResult
788 End_Function
789
790
791 //************************************************************************//
792 // Procedure Field_fill_list_Field_table //
793 // Callback to provide all valid value for this validation. //
794 // Pass the request on to the validation table. This is the most common //
795 // use of this. //
796 //************************************************************************//
797
798 Procedure Field_Fill_List_Field_Table Integer iField Integer iObj Integer iMsg
799 integer iBase
800 integer iTableObj
801 Move (iField * FA_COUNT) to iBase
802 Get Value (iBase + FA_TABLE_OBJECT) to iTableObj
803 If iTableObj ;
804 Send Request_Fill_From_List to iTableObj iObj iMsg
805 End_Procedure
806
807 //************************************************************************//
808 // Procedure Prompt_Object //
809 // Often extended valditation types can provide automatic prompt //
810 // objects. If the extended type supports a prompt object and there is //
811 // a global validation_list object, we will use it //
812 //************************************************************************//
813
814 Function Prompt_Object Integer iField Returns Integer
815 Integer iType
816 Integer iObj
817 //Get Integer_Value ((iField * FA_COUNT) + FA_VALIDATION_TYPE) to iType
818 Get Field_Validation_Type iField to iType
819 If Not (iType=FA_VALIDATION_TYPE_NONE OR iType=FA_VALIDATION_TYPE_RANGE) ;
820 Move DD_Global_Validation_Prompt_Object to iObj
821 Function_Return iObj
822 End_Function
823
824
825End_Class
826
827#Replace FMA_COUNT 6 // Total number of options.
828
829#REPLACE FMA_MASK_TYPE 0
830#REPLACE FMA_MASK_VALUE_STATE 1
831#REPLACE FMA_MASK 2
832#REPLACE FMA_SHORT_NAME 3
833#REPLACE FMA_LONG_NAME 4
834#Replace FMA_CLASS_NAME 5
835
836// use to keep track of file field pairs such as system file file/field
837Struct tDDFileField
838 Integer iFile
839 Integer iField
840End_Struct
841
842{ Visibility=Private }
843Class Field_Mask_Array is an Array
844
845 //************************************************************************//
846 // Get Array_Name: returns string value (and checks for 0) //
847 //************************************************************************//
848
849 Function Array_Name integer iField integer iType Returns String
850 String sName
851 Move (iField*FMA_COUNT+iType) to iField
852 if (Item_Count(self)>iField) ;
853 Get value iField to sName
854 // sometimes an array value that is undefined returns a 0, we must change this to ''
855 If sName eq '0' Move '' to sName
856 function_return sName
857 End_Function
858
859
860 //************************************************************************//
861 // Get/Set Field_Mask_Type //
862 //************************************************************************//
863
864 Procedure Set Field_Mask_Type Integer iField integer iType
865 Set Value (iField*FMA_COUNT+FMA_MASK_TYPE) to iType
866 End_procedure
867
868 Function Field_Mask_Type integer iField returns integer
869 integer iType
870 Move (iField*FMA_COUNT+FMA_MASK_TYPE) to iField
871 if (Item_Count(self)>iField) ;
872 Get value iField to iType
873 function_return iType
874 End_Function
875
876 //************************************************************************//
877 // Get/Set Field_Mask_Value_state //
878 //************************************************************************//
879
880 Procedure Set Field_Mask_Value_State Integer iField integer iState
881 Set Value (iField*FMA_COUNT+FMA_MASK_VALUE_STATE) to iState
882 End_procedure
883
884 Function Field_Mask_Value_State integer iField returns integer
885 integer iState
886 Move (iField*FMA_COUNT+FMA_MASK_VALUE_STATE) to iField
887 if (Item_Count(self)>iField) ;
888 Get value iField to iState
889 function_return iState
890 End_Function
891
892 //************************************************************************//
893 // Get/Set Field_Mask //
894 //************************************************************************//
895
896 Procedure Set Field_Mask Integer iField string sMask
897 Set Value (iField*FMA_COUNT+FMA_MASK) to sMask
898 End_procedure
899
900 Function Field_Mask integer iField returns string
901 Function_Return (Array_Name(self,iField,FMA_MASK))
902 End_Function
903
904 //************************************************************************//
905 // Get/Set Field_Label_Short //
906 //************************************************************************//
907
908 Procedure Set Field_Label_Short Integer iField string sName
909 Set Value (iField*FMA_COUNT+FMA_SHORT_NAME) to sName
910 End_procedure
911
912 Function Field_Label_Short integer iField returns string
913 Function_Return (Array_Name(self,iField,FMA_SHORT_NAME))
914 End_Function
915
916 //************************************************************************//
917 // Get/Set Field_Label_Long //
918 //************************************************************************//
919
920 Procedure Set Field_Label_Long Integer iField string sName
921 Set Value (iField*FMA_COUNT+FMA_LONG_NAME) to sName
922 End_procedure
923
924 Function Field_Label_Long integer iField returns string
925 Function_Return (Array_Name(self,iField,FMA_LONG_NAME))
926 End_Function
927
928 //************************************************************************//
929 // Get/Set Field_Class_Name //
930 //************************************************************************//
931
932 Procedure Set Field_Class_Name Integer iField string sName
933 Set Value (iField*FMA_COUNT+FMA_CLASS_NAME) to sName
934 End_procedure
935
936 Function Field_Class_Name integer iField returns string
937 Function_Return (Array_Name(self,iField,FMA_CLASS_NAME))
938 End_Function
939
940End_Class
941
942//************************************************************************//
943// This image is used when creating the Record_Buffer object. //
944// Because the Record_Buffer is based on an Entrylist, it needs to have //
945// an image. //
946//************************************************************************//
947
948/Record_Buffer
949__
950/*
951
952
953//**************************************************************************//
954// //
955// EXTENDED_DATA_SET //
956// //
957// This is the extended version of the Data_Set class. //
958// //
959// It provides the following extra's to the standard Data_Set class: //
960// //
961// - SETTING ITEM-OPTIONS PER FIELD //
962// These item-options will be used automatically when an DEO is used //
963// which recognizes the Extended_Data_Set. You can specify two types of //
964// item-options. //
965// 1. The ones that will be used when the Server of the DEO is the same //
966// as the Data_File of the item. We call those the stadard-item- //
967// options. //
968// 2. The ones that will be used when the Server of the DEO is different //
969// from the Data_File of the item. We call those options Foreign- //
970// item-options. //
971// //
972// - PROTECTING KEY FIELDS //
973// You can set the Key_Field_State of a field to true to identify Key- //
974// fields. When the property Protect_Key_State is TRUE (Default) then //
975// a user will not be able to change the value of a field which has been //
976// marked as Key-field from an existing record. //
977// //
978// - VALIDATING FIELDS //
979// A validation message can be set per field. This message will be //
980// executed when the Data_Set needs to validate all fields. The message //
981// will also be send when a DEO need to validate an item. //
982// //
983// - FIELD ENTRY AND EXITS MESSAGES //
984// One can specify a message which has to be send to the Data_Set when //
985// a item of a DEO is being entered or exited. //
986// //
987// Currently the fieldtypes Overlap, Text and Binary are *not* supported. //
988// //
989// PROPERTIES //
990// //
991// EXISTING_KEY_VALUE //
992// This property will hold the complete value of all the fields which //
993// have been flagged to be a key-field. It is used to check if a user //
994// has changed one of the fields which make up the key for a record. //
995// //
996// PROTECT_KEY_STATE //
997// When this property is TRUE, is will force a key to be read-only. A //
998// transaction will be aborted when this Data_Set detects that a key //
999// value for an existing record has been changed. //
1000// //
1001// KEY_FIELDS //
1002// This property contains a comma separated list of all fieldnumbers //
1003// which have been marked to be part of a key. This list is not sorted //
1004// and should be considered read-only. //
1005// //
1006// FOREIGN_FIELD_OPTIONS PRIVATE //
1007// This property hold the fields' item-options which are copied to a //
1008// DEO item when this field is used as a foreign (related) field. //
1009// These options will be applied for fields which are not part of an //
1010// index. //
1011// //
1012// FOREIGN_KEY_FIELD_OPTIONS PRIVATE //
1013// See Foreign_Field_Options. //
1014// These options will be applied for fields which are part of the key. //
1015// //
1016// FOREIGN_INDEX_FIELD_OPTIONS PRIVATE //
1017// See Foreign_Field_Options. //
1018// These options will be applied for fields which are part of an index, //
1019// but not of a key. //
1020// //
1021//**************************************************************************//
1022
1023{ ClassLibrary=Common }
1024{ ddClass=True }
1025{ ComponentType=DDClass } //JVH
1026{ HelpTopic=DataDictionary }
1027Class DataDictionary is a DataSet
1028
1029 //************************************************************************//
1030 // Construct_Object. //
1031 // Augmented to set the Focus_Mode to NO_ACTIVATE. If we don't do this, //
1032 // the object might try to take the focus. //
1033 //************************************************************************//
1034
1035 Procedure Construct_Object Integer iImage
1036 Forward Send Construct_Object No_Image //iImage
1037
1038 { DesignTime=False }
1039 Property String Existing_Key_Value ""
1040 { Category=Data }
1041 { PropertyType=Boolean }
1042 Property Integer Protect_Key_State True
1043
1044 { Visibility=Private }
1045 Property String Key_Fields ""
1046
1047 // Used to store default foreign item-options.
1048 { Visibility=Private }
1049 Property Integer private.Foreign_Field_Options 0
1050
1051 // Used to store default foreign item-options for key field.
1052 { Visibility=Private }
1053 Property Integer private.Foreign_Key_Field_Options 0
1054
1055 // Used to store default foreign item-options for non-key index field.
1056 { Visibility=Private }
1057 Property Integer private.Foreign_Index_Field_Options 0
1058
1059 // These are added to support the checking of DSO connections
1060 // during deletes and saves. Only the first two properties are Public
1061 { EnumList="DD_Validate_Structure_Always, DD_Validate_Structure_Never, DD_Validate_Structure_Once"}
1062 { Category=Data }
1063 Property Integer Validate_Save_Structure_Mode DD_Validate_Structure_Once
1064 { EnumList="DD_Validate_Structure_Always, DD_Validate_Structure_Never, DD_Validate_Structure_Once"}
1065 { Category=Data }
1066 Property Integer Validate_Delete_Structure_Mode DD_Validate_Structure_Once
1067 { Visibility=Private }
1068 Property Integer Save_Structure_Validated_State False
1069 { Visibility=Private }
1070 Property Integer Cascade_Delete_Structure_Validated_State False
1071 { Visibility=Private }
1072 Property Integer No_Cascade_Delete_Structure_Validated_State False
1073
1074 { Visibility=Private }
1075 Property Integer Last_Mark_Sequence_Id 0
1076
1077 // These are added for optimized traversal of
1078 // entry-update and validation and maybe more
1079 { Visibility=Private }
1080 Property String Visited_Fields ""
1081 { Visibility=Private }
1082 Property Integer Visited_State False
1083
1084 // these are set by the define_auto_increment, which is obsolete and has been replaced
1085 // the Set Field_auto_increment method.
1086 { Visibility=Private }
1087 Property Integer Auto_Increment_Source_File 0
1088 { Visibility=Private }
1089 Property Integer Auto_Increment_Source_Field 0
1090 { Visibility=Private }
1091 Property Integer Auto_Increment_Dest_Field 0
1092
1093 // used by the set Field_auto_increment method
1094 // these are split into two arrays to make searching for the field easier
1095 // the arrays should always be synched.
1096 { Visibility=Private }
1097 Property Integer[] pAutoIncrementFields
1098 { Visibility=Private }
1099 Property tDDFileField[] pAutoIncrementSysFileFields
1100
1101 // Error Reporting Related
1102 // If DD_Error_No_Report errors would be supressed (only ERR gets set)
1103 { EnumList="DD_Error_Report, DD_Error_No_Report" }
1104 { Category="Error Handling" }
1105 Property Integer Error_Report_Mode DD_Error_Report
1106
1107 // During validation, this is the field being validated.
1108 { Visibility=Private }
1109 Property integer Current_Validate_Field 0
1110
1111 // when errors are redirected locally this maintains the original handler.
1112 { Visibility=Private }
1113 Property integer Old_Error_Object_Id 0
1114
1115 // Must be provided if local error handler is to be created
1116 { Visibility=Private }
1117 Property integer Error_Processing_State 0
1118
1119 // These should be changed most carefully and possible only and the
1120 // DSO level. These allow you to defeat full field validation which
1121 // makes it easier to corrupt data! Validate_DEO_Only_State limits
1122 // save validation to DEOs (which is what data-sets have always done).
1123 // Validate_foreign_File_State will skip validation under the following
1124 // conditions: 1) DSO if for a parent (it did not originate the save).
1125 //
1126 { Category=Data }
1127 { PropertyType=Boolean }
1128 Property Integer Validate_DEOs_Only_State False
1129 { Category=Data }
1130 { PropertyType=Boolean }
1131 Property Integer Validate_Foreign_File_State True
1132 // if set true, a field validation requested started with this
1133 // DD will check all fields, even in an error is encountered
1134 { Category=Data }
1135 { PropertyType=Boolean }
1136 Property Integer Validate_All_Fields_State False
1137
1138 // If true, all entry updates will occur through the DD. Else
1139 // saves occur through the DD and find occur through the DEOs
1140 { Visibility=Private }
1141 Property Integer EntryUpdateLocalState False
1142
1143 // can be used by Refind_records method (remote refind of recs). Obsolete. Use Find_RowId
1144 { Visibility=Private }
1145 Property integer Find_Record_Id 0
1146
1147 // can be used by Refind_records method (remote refind of recs)
1148 { Visibility=Private }
1149 Property RowId Find_RowId (NullRowId())
1150
1151#IFDEF SUPPORT$EXTENDED$FIELDS
1152 // Private: Id of field_objects container. This is not created until needed
1153 { Visibility=Private }
1154 Property Integer Field_Objects 0
1155#ENDIF
1156
1157 // Public: If set the DDO will never be foreign, allowing
1158 // you to create new parents when a child is saved. This would
1159 // normally only be set within the DDO and not the class. This would be
1160 // used where a child table wants to save the parent (header) when the
1161 // first child is saved. It would disable the foreign key and index
1162 // find_Req and required settings (as well as any displayonly).
1163 { Category=Data }
1164 { PropertyType=Boolean }
1165 Property Integer Allow_Foreign_New_Save_State False
1166
1167 // This makes the attach use the DD structure instead of just doing an attach
1168 // on all open files. Existing programs should work fine with this. If they don't,
1169 // you can reset this in your class (although it would be smarter to find out why it
1170 // is not working.
1171 { Category=Data }
1172 { PropertyType=Boolean }
1173 Property Integer pbDDAttach True
1174
1175 // Create the local buffer.
1176 Object Record_Buffer is a Record_Buffer
1177 End_Object
1178
1179 // Create the extended field attributes array.
1180 Object Field_Attributes is a Field_Attributes
1181 End_Object
1182
1183 // Create an array to maintain Status help values for each field
1184 Object Statushelp_Array is an array
1185 end_object
1186
1187 Object FieldMask_Array is an Field_Mask_array
1188 end_object
1189
1190
1191 // keep track of all system/unknown files that must be set to
1192 // default for smart file mode to work right.
1193 Object System_File_obj is an Array
1194 end_object
1195
1196 //Set Focus_Mode to NO_ACTIVATE
1197
1198 Set Smart_FileMode_State to True // extended DSOs should default to
1199 // true
1200 Send Define_Fields // Developer Hook - define all field rules
1201 End_Procedure
1202
1203// // NEW: Returns true if record is active in DD. This is more intuitive than using the current record/rowid
1204// //Doc/ Visibility=Public
1205// Function HasRecord Returns Boolean
1206// Function_Return (Not(IsNullRowId(CurrentRowId(self))))
1207// End_Function
1208
1209 //************************************************************************//
1210 // Extended_DSO_State //
1211 // Returns 1 to indicate that this is a DD class. //
1212 //************************************************************************//
1213
1214 { Visibility=Private MethodType=Property }
1215 Function Extended_DSO_State Returns Integer
1216 Function_Return 1
1217 End_Function // Extended_DSO_State
1218
1219
1220 //************************************************************************//
1221 // Define_Fields //
1222 // Used to set up all XDS functions and rules. Called by construct_object //
1223 // and considered a bit more user friendly. //
1224 //************************************************************************//
1225
1226 { MethodType=Event Obsolete=True }
1227 Procedure Define_Fields
1228 End_Procedure
1229
1230
1231
1232 //************************************************************************//
1233 // Set Main_File. //
1234 // This message has been augmented to create a local recordbuffer for a //
1235 // file. We cannot do this earlier because we need the file to count the //
1236 // number of necessary fields. //
1237 //************************************************************************//
1238
1239 { MethodType=Property NoDoc=True }
1240 { DesignTime=False }
1241 Procedure Set Main_File Integer iFile
1242 Integer iCurrent_File
1243 If iFile Begin
1244 Get Main_File to iCurrent_File
1245 If (iCurrent_File AND iCurrent_File <> iFile) Begin
1246 Send Data_Set_Error -1 0 DD_CANNOT_CHANGE_MAIN_FILE
1247 Procedure_Return
1248 End
1249 Forward Set Main_File to iFile
1250 Send Create_Items to (Record_Buffer(self)) iFile
1251 Send Create_Items to (Field_Attributes(self))
1252 End
1253 End_Procedure
1254
1255
1256
1257 //************************************************************************//
1258 // Set Key_Field_State //
1259 // This procedure will update the Key_Fields property to include or //
1260 // excluded the fieldnumber passed in the list of fieldnumbers which make //
1261 // up an keyvalue. //
1262 //************************************************************************//
1263
1264 { MethodType=Property }
1265 Procedure Set Key_Field_State Integer iField Integer iState
1266 String sKeys
1267 Get Key_Fields to sKeys
1268 Set Key_Fields to (Overstrike(If(iState, "X", " "), sKeys, iField))
1269 End_Procedure
1270
1271
1272
1273 //************************************************************************//
1274 // Function Key_Field_State //
1275 // Will return TRUE if the field passed has been defined as a key. //
1276 //************************************************************************//
1277
1278 { MethodType=Property }
1279 Function Key_Field_State Integer iField Returns Integer
1280 String sKeys
1281 Get Key_Fields to sKeys
1282 Function_Return (Mid(sKeys, 1, iField) <> " ")
1283 End_Function
1284
1285 //************************************************************************//
1286 // Function Key_Value //
1287 // Returns complete key value. //
1288 //************************************************************************//
1289
1290 { MethodType=Property }
1291 Function Key_Value Returns String
1292 String sKeys
1293 String sKey_Value
1294 String sValue
1295 Integer iField
1296 Get Key_Fields to sKeys
1297 Move "" to sKey_Value
1298 Repeat
1299 Pos "X" in sKeys to iField
1300 If iField Begin
1301 Get Field_Current_Value iField to sValue
1302 Append sKey_Value sValue
1303 Move (Overstrike(" ", sKeys, iField)) to sKeys
1304 End
1305 Until Not iField
1306 Function_Return sKey_Value
1307 End_Function
1308
1309 //************************************************************************//
1310 // New_Current_Record. //
1311 // This procedure will be called whenever the Data_Set changes its //
1312 // Current_Record property, or after a Save, Delete or Clear operation. //
1313 // We send this message to the Record_Buffer object to update its values. //
1314 //************************************************************************//
1315
1316 { MethodType=Event Obsolete=True }
1317 Procedure New_Current_Record integer iOld integer iNew
1318 // does nothing, but exists if developer is using this for some purpose. Is called after
1319 // OnNewCurrentRecord (if recnum based table)
1320 End_Procedure
1321
1322 { MethodType=Event }
1323 Procedure OnNewCurrentRecord RowId riOld RowId riNew
1324 Integer iObj
1325 Integer iOldst
1326 Integer iFoc
1327 Integer iIsExt
1328 Forward Send OnNewCurrentRecord riOld riNew
1329 Move (Record_Buffer(self)) to iObj
1330 If iObj Begin
1331 Send OnNewCurrentRecord of iObj riOld riNew
1332#IFDEF SUPPORT$EXTENDED$FIELDS
1333 // must also refresh all defined extended fields
1334 Send ExtendedFieldsRefresh (IsNullRowId(riNew)) // pass bCleared (true if a clear)
1335#ENDIF
1336 Get Focus of Desktop to iFoc
1337 Get Extended_DEO_State of iFoc to iIsExt // if focus is deo item
1338 If iIsExt Begin // disable the state so
1339 Get Entry_Refresh_State of iFoc to iOldSt // value will come
1340 set Entry_Refresh_State of iFoc to True // from Local buffer.
1341 End
1342 Set Existing_Key_Value to (Key_Value(self))
1343 If iIsExt ;
1344 Set Entry_Refresh_State of iFoc to iOldSt
1345 // Only set defaults when the record is new
1346 If (IsNullRowId(riNew)) Send Prepare_Default_Values
1347 End
1348 End_Procedure
1349
1350 //************************************************************************//
1351 // Procedure Prepare_Default_Values //
1352 // Shuts off change mode and sends initialize_default_values which is //
1353 // a user hook routine. //
1354 //************************************************************************//
1355
1356 { Visibility=Private }
1357 Procedure Prepare_Default_Values
1358 integer iOldState
1359 Get Change_disabled_State to iOldState
1360 Set Change_disabled_State to TRUE
1361 Send Private_Field_Defaults
1362 // set defaults if this is the main DDO or the DDO is
1363 // flagged as supporting saving new records when foreign (a parent)
1364 If (Operation_Origin=self OR ;
1365 Allow_Foreign_New_Save_State(self)) ;
1366 Send Field_Defaults
1367 Set Change_disabled_State to iOldState
1368 End_Procedure
1369
1370 //************************************************************************//
1371 // Private_Field_Defaults //
1372 // Set all checkbox fields to default to False data value. //
1373 //************************************************************************//
1374
1375 { Visibility=Private }
1376 Procedure Private_Field_Defaults
1377 Integer iField
1378 Repeat
1379 Get Next_Validation_Type of (Field_Attributes(self)) ;
1380 FA_VALIDATION_TYPE_CHECKBOX iField to iField
1381 If iField eq 0 Procedure_Return
1382 Set Field_Select_State iField to False
1383 Set Field_Changed_State iField to True
1384 Loop
1385 End_Procedure
1386
1387
1388 //************************************************************************//
1389 // Procedure Field_Defaults //
1390 // Will be called after a clear operation to let the application //
1391 // programmer set the default values for the record. This should be done //
1392 // by sending SET Field_Current_Value. //
1393 //************************************************************************//
1394
1395 { MethodType=Event }
1396 Procedure Field_Defaults
1397 End_Procedure
1398
1399 //************************************************************************//
1400 // Function IsDataInvalid //
1401 // Pass type and string value and see if this is valid data for this //
1402 // type. Currently we check for numbers and dates. Return non-zero //
1403 // if invalid. //
1404 //************************************************************************//
1405
1406 { Visibility=Private }
1407 Function IsDataInvalid integer iType String sValue Returns integer
1408 Date dVal
1409 DateTime dtVal
1410 Number nVal
1411 integer bOK
1412 integer bInvalid
1413 integer OldRepMode
1414 integer hOldErrorObj
1415 Move 0 to bInvalid
1416 If (iType=DF_BCD or iType=DF_DATE or iType=DF_DATETIME) Begin
1417 // if there is an error we do not want this to be reported. So we
1418 // will direct errors locally and turn off error reporting. This fixes
1419 // problems where an invalid date returns an error when the view
1420 // is being switched (focus loss causes attempt to update DDO).
1421 //Get Direct_Error_Local TRUE to bOK
1422 move error_object_id to hOldErrorObj
1423 Move self to Error_Object_id
1424 Get Error_Report_Mode to OldRepMode
1425 Set Error_Report_Mode to DD_ERROR_NO_REPORT
1426 Indicate Err False // clear thyself of errors
1427 If (iType=DF_DATE) Begin
1428 Move (Date(sValue)) to dVal // this may gen an error.
1429 Move (Err) to bInvalid
1430 End
1431 Else If (iType=DF_DATETIME) Begin
1432 Move (Cast(sValue,DateTime)) to dtVal
1433// Move (not(IsDateValid(dtVal))) to bInvalid //jjt-uncomment when working
1434 End
1435 Else Begin
1436 Move (Number(sValue)) to nVal // this may gen an error.
1437 Move (Err) to bInvalid
1438 End
1439// if bOK Get Direct_Error_Local FALSE to bOK
1440 Set Error_Report_Mode to OldRepMode
1441 move hOldErrorObj to error_object_id
1442 Indicate Err False
1443 End
1444 Function_Return bInvalid
1445 End_Function
1446
1447 //************************************************************************//
1448 // Function IsDeoOwned //
1449 // Return 1 if the passed DEO is part of the DDs list of connected DEOs //
1450 // First check if server of DEO is this DD. If so, we are owned. If not //
1451 // we must check the DD's UI DEO list. //
1452 // The passed object MUST be a valid DEO or an error will occur. //
1453 //************************************************************************//
1454
1455 { Visibility=Private }
1456 Function IsDEOOwned integer iDEO Returns integer
1457 integer iMax iCount
1458 // if DEOs server is same as current DD it is owned. This is the
1459 // fast check
1460 If (Server(iDEO)=self) Function_return 1
1461 // else see if the DEO is in the DD's DEO list
1462 Get Data_Set_User_Interface_Count to iMax
1463 Decrement iMax
1464 For iCount from 0 to iMax
1465 If (Data_Set_User_Interface(self,iCount)=iDEO) ;
1466 Function_return 1
1467 Loop
1468 Function_Return 0
1469 End_Function
1470
1471 //************************************************************************//
1472 // Procedure Set Field_Current_Value //
1473 // This procedure changes the field value of the given field in the //
1474 // record-buffer object. //
1475 // It also sends Field_Value_Changed to notify every the attached DEOs. //
1476 // This has been optimized so this message is only sent when data is //
1477 // actually changed. //
1478 //************************************************************************//
1479
1480 { MethodType=Property }
1481 Procedure Set Field_Current_Value Integer iField String sValue
1482 Integer iObj
1483 String sOldVal
1484 Integer iChanged
1485 Integer iType
1486 Integer iFile
1487 Integer iFocObj
1488 Integer iCrnt
1489 Integer bInvalid
1490 integer iIdentity
1491#IFDEF SUPPORT$EXTENDED$FIELDS
1492 Address pData
1493 Integer iLen
1494#ENDIF
1495
1496 Get Main_File to iFile
1497 Get_Attribute DF_FIELD_TYPE of iFile iField to iType
1498
1499 // Overlap fields are not supported directly in DDs. It is expected
1500 // that you will use the underlying fields instead
1501 If iType EQ DF_OVERLAP Begin
1502 Send Data_set_Error iField 0 DD_EXTENDED_OVERLAP_ERROR
1503 Procedure_return
1504 End
1505
1506#IFDEF SUPPORT$EXTENDED$FIELDS
1507 If (iType=DF_TEXT or iType=DF_BINARY) Begin // if text or binary direct to pointer
1508 Move (Length(sValue)) to iLen // length to copy
1509 Move (AddressOf(sValue)) to pData // first byte of string
1510 // will gen error if ext. field does not exist
1511 Set Field_Current_Pointer_Value iField iLen to pData
1512 Procedure_Return
1513 end
1514#ELSE
1515 If (iType=DF_TEXT or iType=DF_BINARY) Begin
1516 Send Data_set_Error iField 0 DD_EXTENDED_FIELD_NOT_SUPPORTED
1517 Procedure_return
1518 end
1519#ENDIF
1520
1521
1522 // If date or number, force conversion so any error is detected before
1523 // the buffer is updated. We don't want the record buffer to contain
1524 // invalid data
1525 Get IsDataInvalid iType sValue to bInvalid
1526 If bInvalid ; // If an error occurred we have
1527 Procedure_return // a bad number or a bad date. Do no more!
1528
1529 Move (Record_Buffer(self)) to iObj
1530 Get Value of iObj iField to sOldVal
1531
1532 Set Value of iObj iField to sValue
1533
1534 // Augmented to handle non DF databases JJT-11/14/2001
1535 // Some tables may use some field other then recnum for their record identity.
1536 // This will be dfrecnum or some other numeric field. When this happens the DD have
1537 // to field buffers for the same value. When an update occurs from the DD to the DB buffer
1538 // an update can occur twice. If the values are the same, this does not matter. Else the highest
1539 // field value will get the update (not recnum). So if someone changes recnum but not its real field
1540 // finding may not work right. The DD is updated when a record is found and the API keeps the two values
1541 // the same. If the user changes recnum, the real field does not get changed. That is what we are fixing
1542 // here. Note that: 1) this has no effect on Dataflex databases (or any DB that has a 0 field recnum).
1543 // 2) this type of update is rarely seen anyway (you have to change just the recnum and perform an entry_update).
1544 //
1545 // if field is recnum and record identity is not 0, we must also update the other field.
1546 If (iField=0) Begin
1547 Get_Attribute DF_FILE_RECORD_IDENTITY of iFile to iIdentity
1548 If (iIdentity>0) ;
1549 Set Value of iObj iIdentity to sValue
1550 End
1551
1552 //Set Item_Changed_State of iObj iField to TRUE
1553 //Set Changed_State of iObj to TRUE
1554 // When data-sets are working they should not update the
1555 // DEOs.
1556
1557 // prior to vdf7, we stopped all operation modes of non-zero. We now allow
1558 // validates to pass through and we have a new operation mode for this. This
1559 // should be ok, since we already allowed navigation validation through - we just
1560 // stopped request_validate validations.
1561 If (Operation_Mode=0 OR Operation_Mode=MODE_VALIDATING) Begin
1562 If (iType=DF_BCD) ;
1563 Move (Number(sValue)<>Number(sOldVal)) to iChanged
1564 Else If (iType=DF_DATE) ;
1565 Move (Date(sValue)<>Date(sOldVal)) to iChanged
1566 Else If (iType=DF_DATETIME) ;
1567 Move (Cast(sValue,DateTime)<>Cast(sOldVal,DateTime)) to iChanged
1568 Else ;
1569 Move (sValue<>sOldVal) to iChanged
1570 // if changed, notify all DEOs of this change
1571 If iChanged ;
1572 Send Field_Value_Changed iField sValue
1573 Else Begin
1574 // If here the set value did not change the contents of the DD.
1575 // However, it is possible that the current focus DEO may contain
1576 // a different value than the one we are setting. In such a case
1577 // we must re-synchronize the DEO. Only the one DEO can be affected
1578 // because it is the current focus deo/item that can contain a value
1579 // that is not yet updated in the DD. This fixes a bug where the
1580 // iexit was setting a value which was different from what was in
1581 // the DEO but was the same as the old DD value (iExit is called
1582 // before the DD is re-synched with the DEO). This could happen
1583 // also by sending this message directly with a different value in
1584 // the DEO focus item.
1585 Get Focus of Desktop to iFocObj
1586 // similar logic to Get Field_Current_Value. We check that the DEO
1587 // is extended, that entry_refresh is not disabled and that the
1588 // DEO's server is this DD.
1589 If ( Extended_DEO_State(iFocObj) AND ;
1590 (Entry_Refresh_State(iFocObj)=0)) Begin
1591 Get Current_item of iFocObj to iCrnt
1592 // If Focus DEO has same file and field and it is not checkbox
1593 // we must set its value. Set local value directly sets the value
1594 // in the DEO item. If we used value we'd get recursion!
1595 If ( Data_File(iFocObj,iCrnt)=iFile AND ;
1596 Data_Field(iFocObj,iCrnt)=iField AND ;
1597 IsDEOOwned(self,iFocObj) AND ;
1598 Checkbox_item_State(iFocObj,iCrnt)=0 ) ;
1599 Send File_Field_Value_Changed to iFocObj iFile iField sValue TRUE
1600 //Set Local_Value of iFocObj iCrnt to sValue
1601 End
1602 End
1603 End
1604 End_Procedure
1605
1606 //************************************************************************//
1607 // Procedure Set Field_Changed_Value //
1608 // Sets Field_Current_Value and Sets Field_Changed_State for passed field.//
1609 //************************************************************************//
1610
1611 { MethodType=Property }
1612 Procedure Set Field_Changed_Value Integer iField String sValue
1613 Set Field_Changed_State iField to TRUE
1614 Set Field_Current_Value iField to sValue
1615 End_Procedure
1616
1617 //************************************************************************//
1618 // Function Field_Current_Value //
1619 // Returns the value from the record buffer for the field of which the //
1620 // fieldnumber has been passed. //
1621 // If the file/field requested is the focus file/field the use the DEO's //
1622 // value. //
1623 //*************************************************************************//
1624
1625 { MethodType=Property }
1626 Function Field_Current_Value Integer iField Returns String
1627 Integer iType
1628 Integer iFile
1629 String sValue
1630 Integer iFoc
1631 Integer iCrnt
1632#IFDEF SUPPORT$EXTENDED$FIELDS
1633 Integer iStrSize
1634 Integer iFldSize
1635 Address pData
1636#ENDIF
1637
1638 Get Focus of desktop to iFoc
1639 Get Main_File to iFile
1640 Get_Attribute DF_FIELD_TYPE of iFile iField to iType
1641
1642 // Overlap fields are not supported directly in DDs. It is expected
1643 // that you will use the underlying fields instead
1644 If (iType=DF_OVERLAP) Begin
1645 Send Data_set_Error iField 0 DD_EXTENDED_OVERLAP_ERROR
1646 Function_Return ''
1647 End
1648#IFDEF SUPPORT$EXTENDED$FIELDS
1649 If (iType=DF_TEXT or iType=DF_BINARY) Begin // if overlap, text or binary direct to pointer
1650 // we assume a string is passed here. If we return to a string the
1651 // pointer message will convert this to a string. First check that max string
1652 // length is ok for this field. Pointer will check that the extended field
1653 // actually exists
1654 Get_Argument_Size to iStrSize
1655 Get_Attribute DF_FIELD_LENGTH of iFile iField to iFldSize
1656 // check that the string size is large enough to hold the value
1657 If (iStrSize < iFldSize) Begin
1658 Send Data_set_Error iField 0 DD_EXTENDED_FIELD_TOO_BIG
1659 End
1660 Else Begin
1661 Get Field_Current_Pointer_Value iField to pData // get pointer to data
1662 Move pData to sValue // move to a string
1663 End
1664 Function_Return sValue
1665 End
1666#ELSE
1667 If (iType=DF_TEXT or iType=DF_BINARY) Begin
1668 Send Data_set_Error iField 0 DD_EXTENDED_FIELD_NOT_SUPPORTED
1669 Function_Return ''
1670 End
1671#ENDIF
1672
1673 // This was extended to also make sure that the focus's server
1674 // is this DD. This prevent the (very unlikely) case of a focus
1675 // file/field being the right file/field but for a different view.
1676 // 12.1: Also check operation mode, if within an operation assume that the
1677 // ddos have the information they need from the deos. During a refresh we don't
1678 // the data to be taken from a DEO - the DD buffer has the information you want. Note that
1679 // we also changed all methods that set operation_mode to update the DD with the current
1680 // DEO field, so the buffer is always correct.
1681 If ( (OPERATION_MODE=MODE_WAITING) and ;
1682 Extended_DEO_State(iFoc) and (Entry_Refresh_State(iFoc)=0) ) Begin
1683 Get Current_item of iFoc to iCrnt
1684 If ( Data_File(iFoc,iCrnt)=iFile and Data_Field(iFoc,iCrnt)=iField and ;
1685 IsDEOOwned(Self,iFoc) and ;
1686 (Checkbox_item_State(iFoc,iCrnt)=0) and ;
1687 (Item_NoPut(iFoc,iCrnt)=0) ) Begin
1688 Get Data_Value of iFoc iCrnt to sValue
1689 End
1690 Else Begin
1691 Get Value of (Record_Buffer(Self)) iField to sValue
1692 End
1693 End
1694 Else Begin
1695 Get Value of (Record_Buffer(Self)) iField to sValue
1696 End
1697
1698 // cast value to the proper datatype
1699 If (iType=DF_BCD) Begin
1700 Function_Return (Number(sValue))
1701 End
1702 Else If (iType=DF_DATE) Begin
1703 Function_Return (Date(sValue))
1704 End
1705 Else If (iType=DF_DATETIME) Begin
1706 Function_Return (Cast(sValue,DateTime))
1707 End
1708 // else return as string
1709 Function_Return sValue
1710 End_Function
1711
1712 //************************************************************************//
1713 // Procedure Set Field_Default_Value //
1714 // Procedure Set File_Field_Default_Value //
1715 // This sets a default value without setting the DSO's changed_State //
1716 //************************************************************************//
1717
1718 { MethodType=Property }
1719 Procedure Set Field_Default_Value Integer iField String sValue
1720 integer iOldState
1721 Get Change_disabled_State to iOldState
1722 Set Change_disabled_State to TRUE
1723 Set Field_Changed_Value iField to sValue
1724 Set Change_disabled_State to iOldState
1725 End_Procedure
1726
1727 { MethodType=Property }
1728 procedure Set File_Field_default_Value integer iFile integer iField string sValue
1729 integer iDSO
1730 Get Data_set iFile to iDSO
1731 If iDSO ;
1732 Set Field_default_Value of iDSO iField to sValue
1733 End_Procedure
1734
1735 //************************************************************************//
1736 // Get/Set File_Field_Current_Value //
1737 // Set File_Field_Changed_Value //
1738 // Methods to set and get the value of a field. When set all DSOs and //
1739 // DEOs are notified. //
1740 //************************************************************************//
1741
1742 { MethodType=Property }
1743 Procedure Set File_Field_Current_Value Integer iFile Integer iField String sValue
1744 integer iDSO
1745 Get Data_set iFile to iDSO
1746 If iDSO ;
1747 Set Field_Current_Value of iDSO iField to sValue
1748 End_Procedure
1749
1750 { MethodType=Property }
1751 Procedure Set File_Field_Changed_Value Integer iFile Integer iField String sValue
1752 integer iDSO
1753 Get Data_set iFile to iDSO
1754 If iDSO ;
1755 Set Field_Changed_Value of iDSO iField to sValue
1756 End_Procedure
1757
1758 { MethodType=Property }
1759 Function File_Field_Current_Value Integer iFile Integer iField returns string
1760 integer iDSO
1761 String sValue
1762 Get Data_set iFile to iDSO
1763 If iDSO ;
1764 Get Field_Current_Value of iDSO iField to sValue
1765 Function_Return sValue
1766 End_Function
1767
1768
1769 //************************************************************************//
1770 // Procedure Field_Value_Changed //
1771 // This procedure will notify every attached DEO that the value of a //
1772 // field has been changed. Every DEO needs to update its value to reflect //
1773 // the new value. //
1774 //************************************************************************//
1775
1776 { Visibility=Private MethodType=Procedure }
1777 Procedure Field_Value_Changed Integer iField String sValue
1778 Integer iMax
1779 Integer iCount
1780 Integer iDEO
1781 Integer iMain_File
1782 Integer iNoChange
1783 Get Change_Disabled_State to iNoChange
1784 Get Main_File to iMain_File
1785 Get Data_Set_User_Interface_Count to iMax
1786 Decrement iMax
1787 For iCount from 0 to iMax
1788 Get Data_Set_User_Interface iCount to iDEO
1789 If (Extended_DEO_State(iDEO)) ;
1790 Send File_Field_Value_Changed to iDEO ;
1791 iMain_File iField sValue iNoChange
1792 Loop
1793 End_Procedure
1794
1795
1796 //************************************************************************//
1797 // Get/Set Field_Changed_State //
1798 // Gets/Sets Field_Changed_State of the passed field. Will Set Changed_ //
1799 // state if appropriate (if change_disabled_state is false) //
1800 //************************************************************************//
1801
1802
1803 { MethodType=Property }
1804 Function Field_Changed_State Integer iField Returns Integer
1805 Function_Return ;
1806 (Item_Changed_State(Record_Buffer(self), iField))
1807 End_Function
1808
1809 { MethodType=Property }
1810 Procedure Set Field_Changed_State Integer iField Integer iState
1811 Set Item_Changed_State ;
1812 of (Record_Buffer(Self)) iField to iState
1813 End_Function
1814
1815
1816 //************************************************************************//
1817 // Get/Set File_Field_Changed_State //
1818 // As above, but passes both file and field //
1819 //************************************************************************//
1820
1821 { MethodType=Property }
1822 Function File_Field_Changed_State Integer iFile Integer iField Returns Integer
1823 Integer iDSO
1824 Get Data_Set iFile to iDSO
1825 If iDSO ;
1826 Function_Return (Field_Changed_State(iDSO, iField))
1827 End_Function
1828
1829 { MethodType=Property }
1830 Procedure Set File_Field_Changed_State Integer iFile Integer iField Integer iState
1831 Integer iDSO
1832 Get Data_Set iFile to iDSO
1833 If iDSO ;
1834 Set Field_Changed_State of iDSO iField to iState
1835 End_Function
1836
1837 //************************************************************************//
1838 // This simulates entering a value into a field from a keyboard. Pass the //
1839 // Field and DD Options and the value. It is up to you to pass the proper //
1840 // DD options. This is normally sent by File_Field_Entry and you are //
1841 // advised to use that message and not this one. //
1842 //************************************************************************//
1843
1844 { Visibility=Private MethodType=Procedure }
1845 Procedure set Field_Entry integer iField integer iOpts integer bShowErr String sValue
1846 integer iFile
1847 Integer iType
1848 Integer bChanged
1849 Integer bInvalid
1850 Integer hObj
1851 String sOldVal
1852#IFDEF SUPPORT$EXTENDED$FIELDS
1853 Address pData
1854 Integer iLen
1855#ENDIF
1856
1857 Get Main_File to iFile
1858
1859 // if No-enter or Displayonly, this shouldn't be changed. For now we will
1860 // let NoPut through, since a user might need it for finding.
1861 If (iOpts IAND DD_NOENTER) Procedure_Return
1862
1863 // Force a caplsock if required
1864 If (iOpts IAND DD_CAPSLOCK) Move (Uppercase(sValue)) to sValue
1865
1866 // If date or number, force conversion so any error is detected before
1867 // the buffer is updated. We don't want the record buffer to contain
1868 // invalid data
1869 Get_Attribute DF_FIELD_TYPE of iFile iField to iType
1870
1871 // Overlap fields are not supported directly in DDs. It is expected
1872 // that you will use the underlying fields instead
1873 If iType EQ DF_OVERLAP Begin
1874 Send Data_set_Error iField 0 DD_EXTENDED_OVERLAP_ERROR
1875 Procedure_return
1876 End
1877
1878#IFDEF SUPPORT$EXTENDED$FIELDS
1879 If (iType=DF_TEXT or iType=DF_BINARY) Begin // if text or binary direct to pointer
1880 Move (Length(sValue)) to iLen // length to copy
1881 Move (AddressOf(sValue)) to pData // first byte of string
1882 // will gen error if ext. field does not exist
1883 Set Field_Pointer_Entry iField iOpts iLen bShowErr to pData
1884 Procedure_Return
1885 end
1886#ELSE
1887 If (iType=DF_TEXT or iType=DF_BINARY) Begin
1888 Send Data_set_Error iField 0 DD_EXTENDED_FIELD_NOT_SUPPORTED
1889 Procedure_return
1890 end
1891#ENDIF
1892
1893
1894 Get IsDataInvalid iType sValue to bInvalid
1895 If bInvalid begin // If an error occurred we have
1896 If bShowErr ;
1897 Send Data_set_error iField (If(iType=DF_DATE or iType=DF_DATETIME, DFERR_ENTER_VALID_DATE, DFERR_BAD_ENTRY)) ;
1898 (" ("-sValue-")")
1899 Procedure_return // a bad number or a bad date. Do no more!
1900 end
1901 // update the value only if the value is changed.
1902 Move (Record_Buffer(self)) to hObj
1903 Get Value of hObj iField to sOldVal
1904 If (iType=DF_BCD) ;
1905 Move (Number(sValue)<>Number(sOldVal)) to bChanged
1906 Else If (iType=DF_DATE) ;
1907 Move (Date(sValue)<>Date(sOldVal)) to bChanged
1908 Else If (iType=DF_DATETIME) ;
1909 Move (Cast(sValue,DateTime)<>Cast(sOldVal,DateTime)) to bChanged
1910 Else ;
1911 Move (sValue<>sOldVal) to bChanged
1912
1913 // if changed or force put, update the value.
1914 If ( bChanged or (iOpts IAND DD_FORCEPUT) ) ;
1915 Set Field_Current_Value iField to sValue
1916
1917 // Set changed state if changed and it is not No_put. This
1918 // is an improvement on DEOs which would set changed-state for
1919 // a no-put. This way, finds use the changed value but saves will
1920 // not trigger a phony data loss
1921 If ( bChanged AND Not(iOpts IAND DD_NOPUT) ) ;
1922 Set Field_Changed_State iField to True
1923
1924 // perform autofinds if needed. Note that required checking will occur as
1925 // part of validation.
1926 // We will only autofind if the field value is changed. This is consistent with
1927 // DEOs which do not autofind on unchanged values. This provides optimizations
1928 // when a parent record is already loaded.
1929 If (bChanged OR Field_Changed_state(self,iField)) Begin
1930 // note that autofind is 1 and _ge is 100000001 (8th bit set). So order of
1931 // testing is important and make sure we test for exact bit match. Must first
1932 // test _GE and the EQ (because EQ bit is part of GE)
1933 If ((iOpts IAND DD_AUTOFIND_GE)=DD_AUTOFIND_GE) Send File_Field_AutoFind iFile iField GE
1934 else If ((iOpts IAND DD_AUTOFIND)=DD_AUTOFIND) Send File_Field_AutoFind iFile iField EQ
1935 End
1936
1937 End_Procedure
1938
1939 // **********************************************************************
1940 // Private: This returns file-field options for a Field_Entry type of environment.
1941 // It will strip autofind from main-file DDs but leave foreign field alone.
1942 // This is needed for Field_entry. Otherwise adding a field value to an autofind
1943 // for save or find causes an autofind to trigger first which either causes the
1944 // wrong rec to save or for a double find.
1945 // **********************************************************************
1946
1947 { Visibility=Private MethodType=Procedure }
1948 Function File_Field_Entry_Options integer iFile integer iField returns integer
1949 integer iOpts
1950 // this will get the appropriate field and foreign field opts
1951 Get File_Field_Options iFile iField to iOpts
1952 // If the main file (not foreign) we will strip autofind. Autofind should not
1953 // be an automatic part of main file entry while it should with foreign fields.
1954 If (iFile=Main_File(Self)) Begin
1955 // note that autofind is 1 and _ge is 100000001 (8th bit set). So order of
1956 // testing is important and make sure we test for exact bit match. Must first
1957 // test _GE and the EQ (because EQ bit is part of GE)
1958 If ((iOpts IAND DD_AUTOFIND_GE)=DD_AUTOFIND_GE) Move (iOpts - DD_AUTOFIND_GE) to iOpts
1959 else If ((iOpts IAND DD_AUTOFIND)=DD_AUTOFIND) Move (iOpts - DD_AUTOFIND) to iOpts
1960 end
1961 Function_Return iOpts
1962 End_Function
1963
1964
1965
1966 //************************************************************************//
1967 // This simulates entering a value into a field from a keyboard. The DD //
1968 // receiving this message determines if it is Main or Foreign (just like //
1969 // server). It will do an uppercase, will respect No_Enter and DisplayOnly//
1970 // and will do a autofind if required. It does not do a field validation. //
1971 //************************************************************************//
1972
1973 { MethodType=Procedure }
1974 Procedure set File_Field_Entry integer iFile integer iField integer bShowErr string sValue
1975 integer iOpts
1976 integer hDD
1977 Get Data_Set iFile to hDD
1978 If hDD Begin
1979 // this will get the appropriate field and foreign field opts
1980 Get File_Field_Entry_Options iFile iField to iOpts
1981 Set Field_Entry of hDD iField iOpts bShowErr to sValue
1982 End
1983 End_Procedure
1984
1985
1986#IFDEF SUPPORT$EXTENDED$FIELDS
1987
1988 //************************************************************************//
1989 // return object ID of extended field, 0 if none //
1990 //************************************************************************//
1991
1992 { Visibility=Private MethodType=Property }
1993 Function Field_Object integer iField Returns integer
1994 integer hFlds
1995 Get Field_Objects to hFlds
1996 // if Flds object is not defined, there are no extended fields.
1997 Function_Return ( if(hFlds, Field_object(hFlds,iField),0 ))
1998 End_Function
1999
2000 //************************************************************************//
2001 // This is the same as Field_entry except the value is passed via a //
2002 // pointer. If data-type is extended (text/binary) it will use and an //
2003 // extended field object to handle this. If date/number/string we will //
2004 // convert this to a string and use Field_Entry. It is the caller's //
2005 // responsibility to pass a valid pointer to valid data...else !@#$%^&^ //
2006 // If an extended Field object is needed and not defined, an error is //
2007 // returned. If pointer is null, assume empty string passed (this is a //
2008 // change as of 8.3 - it used to ignore null pointers) //
2009 //************************************************************************//
2010
2011 { Visibility=Private MethodType=Procedure }
2012 Procedure Set Field_Pointer_Entry integer iField integer iOpts integer iLen integer bShowErr Address pData
2013 integer hFld
2014 string sValue
2015 integer iFile
2016 integer iType
2017
2018 Get Main_file to iFile
2019 Get_Attribute DF_FIELD_TYPE of iFile iField to iType
2020
2021 // Overlap fields are not supported directly in DDs. It is expected
2022 // that you will use the underlying fields instead
2023 If iType EQ DF_OVERLAP ;
2024 Send Data_set_Error iField 0 DD_EXTENDED_OVERLAP_ERROR
2025 Else If (iType=DF_TEXT or iType=DF_BINARY) Begin
2026 Get Field_Object iField to hFld // the object that handles this large text
2027 If hFld ;
2028 Set Field_pEntry of hFld iOpts iLen bShowErr to pData
2029 Else ;
2030 Send Data_set_Error iField 0 DD_EXTENDED_FIELD_NOT_DEFINED
2031 end
2032 Else Begin
2033 // if number,date or string convert the pointer data to
2034 // string data and do a normal entry with it.
2035 Move pData to sValue // create string from pointer data
2036 Set Field_Entry iField iOpts bShowErr to sValue
2037 End
2038 End_procedure
2039
2040 //************************************************************************//
2041 // This is the same as File_Field_entry except the value is passed via a //
2042 // pointer. See Field_Pointer_Entry for more on this //
2043 //************************************************************************//
2044
2045 { MethodType=Procedure }
2046 Procedure Set File_Field_Pointer_Entry integer iFile integer iField integer iLen integer bShowErr Address pData
2047 integer iOpts
2048 integer hDD
2049 Get Data_Set iFile to hDD
2050 If hDD Begin
2051 // this will get the appropriate field and foreign field opts
2052 Get File_Field_Entry_Options iFile iField to iOpts
2053 Set Field_Pointer_Entry of hDD iField iOpts iLen bShowErr to pData
2054 End
2055 End_procedure
2056
2057 //************************************************************************//
2058 // This is the same as Field_Current_Value except the value is passed via //
2059 // a pointer. If data-type is extended (text/binary) it will use and an //
2060 // extended field object to handle this. If date/number/string we will //
2061 // convert this to a string and use Field_Entry. It is the caller's //
2062 // responsibility to pass a valid pointer to valid data...else !@#$%^&^ //
2063 // If an extended Field object is needed and not defined, an error is //
2064 // returned. If pointer is null, assume empty string passed (this is a //
2065 // change as of 8.3 - it used to ignore null pointers) //
2066 //************************************************************************//
2067
2068 { MethodType=Property }
2069 Procedure Set Field_Current_Pointer_Value integer iField integer iLen Address pData
2070 integer hFld
2071 string sValue
2072 integer iFile iType
2073
2074 Get Main_file to iFile
2075 Get_Attribute DF_FIELD_TYPE of iFile iField to iType
2076 // Overlap fields are not supported directly in DDs. It is expected
2077 // that you will use the underlying fields instead
2078 If iType EQ DF_OVERLAP ;
2079 Send Data_set_Error iField 0 DD_EXTENDED_OVERLAP_ERROR
2080 Else If (iType=DF_TEXT or iType=DF_BINARY) Begin
2081 Get Field_Object iField to hFld // the object that handles this large text
2082 If hFld ;
2083 Set Field_pValue of hFld iLen to pData
2084 Else ;
2085 Send Data_set_Error iField 0 DD_EXTENDED_FIELD_NOT_DEFINED
2086 end
2087 Else Begin
2088 // if number,date or string convert the pointer data to
2089 // string data and do a normal entry with it.
2090 Move pData to sValue // create string from pointer data
2091 Set Field_Current_Value iField to sValue
2092 End
2093 End_procedure
2094
2095 //************************************************************************//
2096 // This is the same as File_Field_Current_Value except the value is passed//
2097 // via a pointer. See Field_current_Pointer_Value for more on this //
2098 //************************************************************************//
2099
2100 { MethodType=Property }
2101 Procedure Set File_Field_Current_Pointer_Value integer iFile integer iField integer iLen Address pData
2102 integer hDD
2103 Get Data_Set iFile to hDD
2104 If hDD ;
2105 Set Field_Current_Pointer_Value of hDD iField iLen to pData
2106 End_procedure
2107
2108
2109 //************************************************************************//
2110 // Field_Current_Pointer_Value //
2111 // File_Field_Current_Pointer_Value //
2112 // This returns the data pointer to the extended field. At this point //
2113 // this is the data. Be careful if you change the data, be even more //
2114 // careful if you change the pointer (don't do it!!!!) //
2115 //************************************************************************//
2116
2117 { MethodType=Property }
2118 Function Field_Current_Pointer_Value integer iField returns Address
2119 integer hFld
2120 Get Field_Object iField to hFld // the object that handles this large text
2121 If hFld ;
2122 Function_Return (FieldPointer(hFld))
2123 Send Data_set_Error iField 0 DD_EXTENDED_FIELD_NOT_DEFINED
2124 Function_Return 0
2125 End_function
2126
2127
2128 { MethodType=Property }
2129 Function File_Field_Current_Pointer_Value integer iFile integer iField Returns Address
2130 Address pValue
2131 integer hDD
2132 Get Data_Set iFile to hDD
2133 If hDD Begin
2134 Get Field_Current_Pointer_Value of hDD iField to pValue // return pointer to first byte of
2135 Function_Return pValue // data
2136 End
2137 End_Function
2138
2139 //************************************************************************//
2140 // Create an extended field object for the passed field. . //
2141 // If field already exists, do nothing. This should only be used with //
2142 // text and binary fields. //
2143 //************************************************************************//
2144
2145 Procedure DefineExtendedField integer iField
2146 integer hFlds
2147 Get Field_Objects to hFlds // this may not be created yet.
2148 If not hFlds Begin // if not created, create extended-fields wrapper
2149 #PUSH !Zb // save current definition state
2150 #SET ZB$ -1 // Object will append to parent
2151 Object ExtendedFieldObjects Is A FieldObjects
2152 Move self to hFlds
2153 End_Object
2154 #POP ZB$ //restore obj_flag
2155 Set Field_Objects to hFlds
2156 End
2157 Send DefineFieldObject to hFlds iField
2158 End_Procedure
2159
2160 //************************************************************************//
2161 // create extended DD fields for all text and binary files //
2162 //************************************************************************//
2163
2164 Procedure DefineAllExtendedFields
2165 Integer iCount iType iField iFile
2166 get Main_file to iFile
2167 Get_Attribute DF_FILE_NUMBER_FIELDS of iFile to iCount
2168 For iField from 1 to iCount
2169 Get_Attribute DF_FIELD_TYPE of iFile iField to iType
2170 If (iType=DF_TEXT or iType=DF_BINARY) ; // if text or binary
2171 Send DefineExtendedField iField
2172 Loop
2173 End_Procedure
2174
2175 //************************************************************************//
2176 // Update Extended fields to FileBuffer. DD-Fields ---> FileBuffer //
2177 // Private //
2178 //************************************************************************//
2179
2180 { Visibility=Private }
2181 Procedure ExtendedFieldsUpdate integer bSave
2182 integer hFlds
2183 Get Field_Objects to hFlds
2184 If hFlds ;
2185 Send ExtendedFieldsUpdate to hFlds bSave
2186 End_procedure
2187
2188 //************************************************************************//
2189 // Refresh Extended field from FileBuffer. DD-Fields <--- FileBuffer //
2190 // Private //
2191 //************************************************************************//
2192
2193 { Visibility=Private }
2194 Procedure ExtendedFieldsRefresh Boolean bCleared
2195 integer hFlds
2196 Get Field_Objects to hFlds
2197 If hFlds ;
2198 Send ExtendedFieldsRefresh to hFlds bCleared
2199 End_procedure
2200
2201#ENDIF
2202
2203 //************************************************************************//
2204 // Procedure Set Field_Options //
2205 // This procedure can be used to set the Item_Options of a field. This can//
2206 // be passed any number of arguments. //
2207 // Support the following special first parameters: //
2208 // DD_CLEAR_FIELD_OPTIONS - clear all following passed otpions //
2209 // DD_CLEAR_ALL_FIELD_OPTIONS - clear all options //
2210 //************************************************************************//
2211
2212 { MethodType=Property }
2213 Procedure Set Field_Options Integer iField Integer iArg1 // plus unknown arguments
2214 Integer iObj
2215 Integer iOptions
2216 Integer iOption
2217 Integer iArg
2218 Integer iClear
2219 integer iType
2220 Move (Record_Buffer(self)) to iObj
2221 Get Item_Options of iObj iField to iOptions
2222 //
2223 For iArg from 2 to Num_Arguments
2224 MoveStr iArg& to iOption // tricky way to parse passed arguments
2225 if iOption eq DD_CLEAR_ALL_FIELD_OPTIONS ;
2226 Move 0 to iOptions
2227 Else if iOption eq DD_CLEAR_FIELD_OPTIONS ;
2228 Move 1 to iClear
2229 Else if Not iClear ;
2230 Move (iOptions IOR iOption) to iOptions
2231 Else ; // only unset bits already set! Note multiple bits can be passed
2232 Move (iOptions - (iOptions IAND iOption)) to iOptions
2233 Loop
2234 //
2235 //Get_Attribute DF_FIELD_TYPE of (Main_File(self)) iField to iType
2236 //If (iType=DF_TEXT or iType=DF_BINARY) ; // if text of binary
2237 // Move (iOptions iOR DD_DISPLAYONLY) to iOptions // make sure DO is set
2238
2239 Set Item_Options of iObj iField to iOptions
2240 End_Procedure
2241
2242 //************************************************************************//
2243 // Function Field_Options //
2244 // This function returns all the item_options which have been set for //
2245 // a field. The value from the Record_Buffer object will be binary or'ed //
2246 // with constand Default_Item_Options and the DD_AUTOCLEAR constants when //
2247 // the Autoclear_State of the field has been set. //
2248 // Keep in mind that Autoclear is *not* kept in the Item_Options //
2249 // property. //
2250 //************************************************************************//
2251
2252 { MethodType=Property }
2253 Function Field_Options Integer iField Returns Integer
2254 Function_Return (Item_Options(Record_Buffer(self), iField))
2255 End_Function
2256
2257 { MethodType=Property }
2258 Function Field_Option Integer iField Integer iOption returns integer
2259 Integer iOptions
2260 Integer iState
2261 Get Item_Options of (Record_Buffer(Self)) iField to iOptions
2262 // All bits must match for it to be True (e.g., displayonly requires noput & noenter)
2263 Move ((iOptions iand iOption)=iOption) to iState
2264 Function_Return iState
2265 End_Function
2266
2267 { MethodType=Property }
2268 Procedure Set Foreign_Field_Options Integer iField Integer iArg1 // Integer iOption
2269 Integer iObj
2270 Integer iOptions
2271 Integer iOption
2272 Integer iArg
2273 Integer iClear
2274 //
2275 If iField GE 0 Begin
2276 Move (Record_Buffer(self)) to iObj
2277 Get Aux_Value of iObj iField to iOptions
2278 End
2279 Else If iField EQ DD_DEFAULT ;
2280 Get private.Foreign_Field_Options to iOptions
2281 Else If iField EQ DD_INDEXFIELD ;
2282 Get private.Foreign_Index_Field_Options to iOptions
2283 Else ;
2284 Get private.Foreign_Key_Field_Options to iOptions
2285 //
2286 For iArg from 2 to Num_Arguments
2287 MoveStr iArg& to iOption // tricky way to parse passed arguments
2288 if iOption eq DD_CLEAR_ALL_FIELD_OPTIONS ;
2289 Move 0 to iOptions
2290 Else if iOption eq DD_CLEAR_FIELD_OPTIONS ;
2291 Move 1 to iClear
2292 Else if Not iClear ;
2293 Move (iOptions IOR iOption) to iOptions
2294 Else ; // only unset bits already set! Note multiple bits can be passed
2295 Move (iOptions - (iOptions IAND iOption)) to iOptions
2296 Loop
2297 //
2298 If iField GE 0 ;
2299 Set Aux_Value of iObj iField to iOptions
2300 Else If iField EQ DD_DEFAULT ;
2301 Set private.Foreign_Field_Options to iOptions
2302 Else If iField EQ DD_INDEXFIELD ;
2303 Set private.Foreign_Index_Field_Options to iOptions
2304 Else ;
2305 Set private.Foreign_Key_Field_Options to iOptions
2306 End_Procedure
2307
2308 { MethodType=Property }
2309 Function Foreign_Field_Options Integer iField Returns Integer
2310 Integer iOpts
2311 Integer iAux
2312 Integer iFile
2313 Integer iIndex
2314
2315 // if one of the special field types, we return the value of the type
2316 If (iField=DD_KEYFIELD) Begin
2317 Get private.Foreign_Key_Field_Options to iOpts
2318 End
2319 Else If (iField=DD_INDEXFIELD) Begin
2320 Get private.Foreign_Index_Field_Options to iOpts
2321 End
2322 Else If (iField=DD_DEFAULT) Begin
2323 Get private.Foreign_Field_Options to iOpts
2324 End
2325 Else Begin
2326 // if a field number is passed we return the calculated value based on
2327 // the type of field this actually is plus anything applied to this field.
2328 If (Key_Field_State(Self, iField)) ;
2329 Get private.Foreign_Key_Field_Options to iOpts
2330 Else Begin
2331 Get Main_File to iFile
2332 Get_Attribute DF_FIELD_INDEX of iFile iField to iIndex
2333 If iIndex ;
2334 Get private.Foreign_Index_Field_Options to iOpts
2335 Else ;
2336 Get private.Foreign_Field_Options to iOpts
2337 End
2338 Get Aux_Value of (Record_Buffer(Self)) iField to iAux
2339 Move (iAux ior iOpts) to iOpts
2340 End
2341 Function_Return iOpts
2342 End_Function
2343
2344 { MethodType=Property }
2345 Procedure Set Foreign_Field_Option Integer iField Integer iOption Integer bSet
2346 If bSet Begin
2347 Set Foreign_Field_Options iField to iOption
2348 End
2349 Else Begin
2350 Set Foreign_Field_Options iField to DD_CLEAR_FIELD_OPTIONS iOption
2351 End
2352 End_Procedure
2353
2354 { MethodType=Property }
2355 Function Foreign_Field_Option Integer iField Integer iOption Returns Integer
2356 Integer iOptions
2357 Integer iState
2358 Get Foreign_Field_Options iField to iOptions
2359 Move ((iOptions iand iOption)=iOption) to iState
2360 Function_Return iState
2361 End_Function
2362
2363 //************************************************************************//
2364 // Function File_Field_Options //
2365 // This procedure is being used by DEOs when they need to copy the item- //
2366 // options from the Data_Set. When the filenumber being passed is not //
2367 // equal to the Main_File of this Data_Set, then the Foreign_Field_Options//
2368 // will be applied. //
2369 //************************************************************************//
2370
2371 { MethodType=Property }
2372 Function File_Field_Options Integer iFile Integer iField Returns Integer
2373 Integer iDSO
2374 Integer iMain_File
2375 Integer iOpts
2376 Integer iRB
2377 integer iType
2378 Get Main_File to iMain_File
2379 If iFile NE iMain_File ;
2380 Get Data_Set iFile to iDSO
2381 Else ;
2382 Move self to iDSO
2383 If iDSO Begin
2384 Get Field_Options of iDSO iField to iOpts
2385 // if data-type is Text or Binary we must remove the DisplayOnly
2386 // attributes since these have to be set in the entrylist. This is
2387 // a compromise that means that text/binary cannot be primarily
2388 // no-enter or no-put. Foreign settings can still be applied
2389 //Get_Attribute DF_FIELD_TYPE of iFile iField to iType
2390 // this assumes that text and binary are set to displayonly which is what
2391 // the DD does.
2392 //If (iType=DF_TEXT OR iType=DF_BINARY) Subtract DD_DISPLAYONLY from iOpts
2393 // we consider the item to be foreign if the DDO main file is different than the one
2394 // passed and we do not allow foreign (parent) new records to be saved.
2395 If (iFile<>iMain_File AND Allow_Foreign_New_Save_State(iDSO)=0) ; // Add Foreign_Field_Options
2396 Move (iOpts IOR Foreign_Field_Options(iDSO, iField)) to iOpts
2397 Function_Return iOpts
2398 End
2399 End_Function
2400
2401
2402 //************************************************************************//
2403 // Procedure to set the message to be send on item entry. //
2404 //************************************************************************//
2405
2406 { MethodType=Property }
2407 Procedure Set Field_Entry_msg Integer iField Integer iMsg
2408 Set Item_Entry_MSG of (Record_Buffer(Self)) iField to iMsg
2409 End_Procedure
2410
2411 //************************************************************************//
2412 // Function to return the message to be send on item entry. //
2413 //************************************************************************//
2414
2415 { MethodType=Property }
2416 Function Field_Entry_msg Integer iField returns integer
2417 Function_Return (Item_Entry_MSG(Record_Buffer(self), iField))
2418 End_Function
2419
2420
2421
2422 //************************************************************************//
2423 // Procedure to sent the message to be send on item exit. //
2424 //************************************************************************//
2425
2426 { MethodType=Property }
2427 Procedure Set Field_Exit_msg Integer iField Integer iMsg
2428 Set Item_Exit_MSG of (Record_Buffer(Self)) iField to iMsg
2429 End_Procedure
2430
2431 //************************************************************************//
2432 // Function to return the message to be send on item exit. //
2433 //************************************************************************//
2434
2435 { MethodType=Property }
2436 Function Field_Exit_msg Integer iField Returns Integer
2437 Function_Return (Item_Exit_MSG(Record_Buffer(self), iField))
2438 End_Function
2439
2440
2441
2442 //************************************************************************//
2443 // Procedure to set the message to be send on item validation. //
2444 //************************************************************************//
2445
2446 { MethodType=Property }
2447 Procedure Set Field_Validate_msg Integer iField Integer iMsg
2448 Set Item_Validate_MSG of (Record_Buffer(Self)) iField to iMsg
2449 End_Procedure
2450
2451 //************************************************************************//
2452 // Function to return the message to be send on item validation. //
2453 //************************************************************************//
2454
2455 { MethodType=Property }
2456 Function Field_Validate_msg Integer iField Returns Integer
2457 Function_Return (Item_Validate_MSG(Record_Buffer(self), iField))
2458 End_Function
2459
2460
2461
2462 //************************************************************************//
2463 // Set/Get Field_Prompt_Object //
2464 // Set/Get Field_Zoom_Object //
2465 // Used to Get/Set the Prompt_Object for a Field. //
2466 //************************************************************************//
2467
2468 { MethodType=Property }
2469 Procedure Set Field_Prompt_Object Integer iField Integer iObj
2470 Set Prompt_Object of (Record_Buffer(self)) iField to iObj
2471 End_Procedure
2472
2473 { MethodType=Property }
2474 Function Field_Prompt_Object Integer iField Returns Integer
2475 integer iObj
2476 Get Prompt_Object of (Record_Buffer(self)) iField to iObj
2477 If iObj eq 0 ;
2478 Get Prompt_Object of (Field_Attributes(Self)) iField to iObj
2479 Function_Return iObj
2480 End_Function
2481
2482 { MethodType=Property }
2483 Procedure Set Field_Zoom_Object Integer iField Integer iObj
2484 Set Zoom_Object of (Record_Buffer(Self)) iField to iObj
2485 End_Procedure
2486
2487 { MethodType=Property }
2488 Function Field_Zoom_Object Integer iField Returns Integer
2489 Function_Return (Zoom_Object(Record_Buffer(self), iField))
2490 End_Function
2491
2492
2493
2494 //************************************************************************//
2495 // Set/Get File_Field_Prompt_Object //
2496 // Set/Get File_Field_Zoom_Object //
2497 // Used to Get/Set the Prompt_Object for a Field. //
2498 //************************************************************************//
2499
2500 { MethodType=Property }
2501 Function File_Field_Prompt_Object Integer iFile Integer iField Returns Integer
2502 Integer iObj
2503 Get File_Field_Property iFile iField GET_Field_Prompt_Object to iObj
2504 Function_Return iObj
2505 End_Function
2506
2507 { MethodType=Property }
2508 Function File_Field_Zoom_Object Integer iFile Integer iField Returns Integer
2509 Integer iObj
2510 Get File_Field_Property iFile iField GET_Field_Zoom_Object to iObj
2511 Function_Return iObj
2512 End_Function
2513
2514
2515 //************************************************************************//
2516 // Get Field_Validation_Type //
2517 // Return the extended validation type for this field. //
2518 //************************************************************************//
2519
2520 { Visibility=Private MethodType=Property }
2521 Function Field_Validation_Type Integer iField Returns Integer
2522 Integer iType
2523 Get Field_Validation_Type of (Field_Attributes(self)) iField ;
2524 to iType
2525 Function_Return iType
2526 End_Function
2527
2528 //************************************************************************//
2529 // Procedure Set Field_Value_Range //
2530 // Procedure to define a valid value range for a field. //
2531 //************************************************************************//
2532
2533 { MethodType=Property }
2534 Procedure Set Field_Value_Range Integer iField String sMin String sMax
2535 Set Field_Value_Range of (Field_Attributes(self)) iField ;
2536 to sMin sMax
2537 End_Procedure
2538
2539
2540 //************************************************************************//
2541 // Required Messaging to Support Validation Tables //
2542 //************************************************************************//
2543
2544 //************************************************************************//
2545 // Procedure Set Field_Value_Table //
2546 // Procedure to define a validate table for a field. //
2547 //************************************************************************//
2548
2549 { MethodType=Property }
2550 Procedure Set Field_Value_Table Integer iField integer iObj
2551 Set Field_Value_Table of (Field_Attributes(self)) iField ;
2552 to iObj
2553 End_Procedure
2554
2555 //************************************************************************//
2556 // File_Field_Fill_List //
2557 // Field_Fill_List //
2558 // This provides a callback to the calling object (iObj) by passing this //
2559 // object the message iMsg for each item in the table. Note this works for//
2560 // all extended validation types (range, check, etc.) //
2561 //************************************************************************//
2562
2563 { Visibility=Private }
2564 Procedure Field_Fill_List integer iField integer iObj integer iMsg
2565 Send Field_Fill_list to (Field_Attributes(self)) ;
2566 iField iObj iMsg
2567 End_Procedure
2568
2569 { Visibility=Private }
2570 Procedure File_Field_Fill_List integer iFile integer iField ;
2571 integer iObj integer iMsg
2572 integer iDSO
2573 Get Data_set iFile to iDSO
2574 If iDSO ;
2575 Send Field_Fill_list to iDSO iField iObj iMsg
2576 End_Procedure
2577
2578 //************************************************************************//
2579 // Get Field_table_Object //
2580 // Get File_Field_table_object //
2581 // Returns the ID if any of the validation table for this object. //
2582 //************************************************************************//
2583
2584 { MethodType=Property }
2585 Function Field_Table_Object integer iField Returns integer
2586 integer iRval
2587 Get Field_Table_Object of (Field_Attributes(self)) iField to iRVal
2588 Function_Return iRVal
2589 End_Function
2590
2591 { MethodType=Property }
2592 Function File_Field_Table_Object integer iFile integer iField Returns integer
2593 integer iDSO
2594 Get Data_set iFile to iDSO
2595 If iDSO ;
2596 Function_Return (Field_Table_Object(iDSO,iField))
2597 End_Function
2598
2599 //************************************************************************//
2600 // Get Field_table_Descripton //
2601 // Returns code description value for the passed string for the //
2602 // passed validation table object. Normally use field_value_description //
2603 //************************************************************************//
2604
2605 { Visibility=Private }
2606 Function Validation_Table_Description integer iObj String sVal Returns string
2607 string sDesc
2608 If iObj get Find_Code_Description of iObj sVal to sDesc
2609 Function_Return sDesc
2610 End_Function
2611
2612 //************************************************************************//
2613 // Get Field_Current_description //
2614 // Get File_Field_Current_description //
2615 // Returns the description value for the field's code value. This only //
2616 // works if you have a validation table - else it returns the field value //
2617 //************************************************************************//
2618
2619 { MethodType=Property }
2620 Function Field_Current_Description integer iField Returns string
2621 string sDesc
2622 string sVal
2623 integer iObj
2624 Get Field_Current_Value iField to sVal
2625 Get Field_Table_Object iField to iObj
2626 If iObj Begin
2627 get Validation_Table_Description iObj sVal to sDesc
2628 if (sDesc="") Move sVal to sDesc // if desc is blank, use value
2629 End
2630 Else ;
2631 Move sVal to sDesc
2632 Function_Return sDesc
2633 End_Function
2634
2635 { MethodType=Property }
2636 Function File_Field_Current_Description integer iFile integer iField Returns string
2637 integer iDSO
2638 Get Data_set iFile to iDSO
2639 If iDSO ;
2640 Function_Return (Field_Current_Description(iDSO,iField))
2641 End_Function
2642
2643
2644 //************************************************************************//
2645 // Required Messaging to Support Checkbox items in DEOs //
2646 //************************************************************************//
2647
2648 //************************************************************************//
2649 // Procedure Set Field_Checkbox_Values //
2650 // Defines a field as a two item field and defines True and False values //
2651 //************************************************************************//
2652
2653 { MethodType=Property }
2654 Procedure Set Field_CheckBox_Values Integer iField String sTrue String sFalse
2655 Set Field_CheckBox_Values of (Field_Attributes(self)) iField ;
2656 to sTrue sFalse
2657 End_Procedure
2658
2659 //************************************************************************//
2660 // Function Field_Value_select_State //
2661 // Returns a field's select_State based on the pased value //
2662 // Function Field_select_State //
2663 // Returns a field's select_State based on the DD buffer contents //
2664 //************************************************************************//
2665
2666 { Visibility=Private MethodType=Property }
2667 Function Field_Value_Select_State Integer iField String sValue returns integer
2668 Function_Return (Field_Value_Select_State(Field_Attributes(self),iField,sValue))
2669 End_Function // File_Value_Field_Select_State
2670
2671 { MethodType=Property }
2672 Function Field_Select_State Integer iField returns integer
2673 String sValue
2674 Get Field_Current_Value iField to sValue
2675 Function_Return (Field_Value_Select_State(self,iField,sValue))
2676 End_Function // File_Field_Select_State
2677
2678 //************************************************************************//
2679 // Function File_Field_select_State //
2680 // Returns a file/field' select_State based on contents of DD buffer //
2681 // Function File_Field_Value_select_State //
2682 // Returns a file/field' select_State based on passed value //
2683 //************************************************************************//
2684
2685 { MethodType=Property }
2686 Function File_Field_Select_State Integer iFile integer iField returns integer
2687 integer iDSO
2688 Get Data_set iFile to iDSO
2689 If iDSO ;
2690 Function_Return (Field_Select_State(iDSO,iField))
2691 End_Function // File_Field_Select_State
2692
2693 { Visibility=Private MethodType=Property }
2694 Function File_Field_Value_Select_State Integer iFile integer iField ;
2695 String sValue returns integer
2696 integer iDSO
2697 Get Data_set iFile to iDSO
2698 If iDSO ;
2699 Function_Return (Field_Value_Select_State(iDSO,iField,sValue))
2700 End_Function // File_Field_Select_State
2701
2702 //************************************************************************//
2703 // Function Field_Checkbox_Value //
2704 // Function File_Field_Checkbox_Value //
2705 // get the actual database value that corresponds to the boolean value //
2706 // passed. //
2707 //************************************************************************//
2708
2709 { MethodType=Property }
2710 Function Field_CheckBox_Value Integer iField Integer iState returns String
2711 Function_Return (Field_Checkbox_Value(Field_Attributes(self),iField,iState))
2712 End_Function
2713
2714 { MethodType=Property }
2715 Function File_Field_CheckBox_Value Integer iFile Integer iField Integer iState returns String
2716 integer iDSO
2717 Get Data_set iFile to iDSO
2718 If iDSO ;
2719 Function_Return (Field_Checkbox_Value(iDSO,iField,iState))
2720 End_Function
2721
2722 //************************************************************************//
2723 // Procedure Set Field_select_State //
2724 // Set the buffer's value based on the state passed. This notifies DEOs //
2725 // if needed (set Field_Current_Value does this) //
2726 //************************************************************************//
2727
2728 { MethodType=Property }
2729 Procedure Set Field_Select_State integer iField integer iState
2730 string sValue
2731 Get Field_Checkbox_Value iField iState to sValue
2732 Set Field_Current_Value iField to sValue
2733 End_Procedure // Set Field_Select_State
2734
2735 //************************************************************************//
2736 // Procedure Set File_Field_select_State //
2737 // Set the buffer's value based on the state passed. This notifies DEOs //
2738 // if needed (set Field_Current_Value does this). First finds proper file //
2739 // DSO //
2740 //************************************************************************//
2741
2742 { MethodType=Property }
2743 Procedure Set File_Field_Select_State Integer iFile Integer iField Integer iState
2744 integer iDSO
2745 Get Data_set iFile to iDSO
2746 If iDSO ;
2747 Set Field_Select_State of iDSO iField to iState
2748 End_Procedure // Set File_Field_Select_State
2749
2750
2751 //************************************************************************//
2752 // Procedure Set Field_Value_Check //
2753 // Procedure to define a check string for a field. //
2754 //************************************************************************//
2755
2756 { MethodType=Property }
2757 Procedure Set Field_Value_Check Integer iField String sCheck
2758 Set Field_Value_Check of (Field_Attributes(self)) iField ;
2759 to sCheck
2760 End_Procedure
2761
2762
2763
2764 //************************************************************************//
2765 // Function Exec_Field_Message //
2766 // This function will be called indirectly by DEOs when an item is being //
2767 // entered, exited or needs validation. The first argument holds the //
2768 // fieldnumber for the field and the second holds the id of the message //
2769 // which can be send to retrieve the message which needs to be send for //
2770 // this Field/Event combination. The value of the second argument can be //
2771 // GET_Field_Entry_MSG, GET_Field_Exit_MSG or GET_Field_Validate_MSG. //
2772 //************************************************************************//
2773
2774 { Visibility=Private }
2775 Function Exec_Field_Message Integer iField Integer iMsg_ID returns integer
2776 Integer iMsg
2777 Integer iResult
2778 String sValue
2779 Get iMsg_ID iField to iMsg
2780 If iMsg Begin
2781 Get Field_Current_Value iField to sValue
2782 Get iMsg iField sValue to iResult
2783 End
2784 Function_Return iResult
2785 End_Function
2786
2787
2788
2789 //************************************************************************//
2790 // Function Exec_File_Field_Message //
2791 // This function will be called from within DEOs when an item is being //
2792 // entered, exited or needs validation. The first argument holds the //
2793 // file number, the second argument holds the field and the third //
2794 // holds the id of the message which can be send to retrieve the message //
2795 // which needs to be send for this File/Field/Event combination. //
2796 // The value of the second argument can be GET_Field_Entry_MSG, //
2797 // GET_Field_Exit_MSG or GET_Field_Validate_MSG. //
2798 // This will redirect to the proper data-set object. //
2799 //************************************************************************//
2800
2801 { Visibility=Private }
2802 Function Exec_File_Field_Message Integer iFile Integer iField Integer iMsg_ID returns integer
2803 Integer iDSO
2804 Integer iResult
2805 Get Data_set iFile to iDSO
2806 If iDSO ;
2807 Get Exec_Field_Message of iDSO iField iMsg_ID to iResult
2808 Function_Return iResult
2809 End_Function
2810
2811
2812
2813 //************************************************************************//
2814 // Function Data_Set //
2815 // Find the data-set whose main_file is the same as File#. The message //
2816 // Which_data_set includes updating parent files, we will throw those out.//
2817 // This has been augmented to search down the DDO tree if we do not find //
2818 // the DD with our quick C Which_Data_set search //
2819 //************************************************************************//
2820
2821 Function Data_Set Integer iFile Returns Integer
2822 Integer iTmp
2823 Integer iDSO
2824 Get Main_File to iTmp
2825 If iTmp EQ iFile ;
2826 Function_Return self
2827 Get Which_Data_Set iFile to iDSO
2828 If iDSO Begin
2829 // check that DS's main-file is the File (and not a parent file)
2830 Get Main_File of iDSO to iTmp
2831 If iTmp EQ iFile ;
2832 Function_Return iDSO
2833 End
2834
2835 // This really should have succeeded by now. If not we need to do a
2836 // downward sweep looking for DD. This will be a slower process since it
2837 // involves flex level DDO structure traversal. We should very rarely ever
2838 // get to this point. If we do, it takes longer!
2839
2840 // Unlike other traversals we will mark and check in a single
2841 // step.
2842 // This Mark_Id creates a sequence Id for this clear. This way
2843 // DSOs only get cleared one time during this process.
2844 If DD_Current_Mark_ID ge 65536 Move 0 to DD_Current_Mark_id
2845 Increment DD_Current_Mark_id
2846 Get Private.Data_set iFile to iDSO // this does the recursive downward search
2847 Function_Return iDSO
2848 End_Function
2849
2850 { Visibility=Private }
2851 Function Private.Data_Set integer iFile Returns Integer
2852 Integer iMax
2853 Integer iDSO hDD
2854 Integer iCount
2855
2856 If (iFile=Main_file(self)) Function_return self
2857
2858 // We are only looking at sequence ID.
2859 Set Last_Mark_Sequence_id to DD_Current_mark_id
2860
2861 // recurse Down first, since we already tried upward direction.
2862 Get Data_Set_Client_Count to iMax
2863 Decrement iMax
2864 For iCount from 0 to iMax
2865 Get Data_Set_Client iCount to iDSO
2866 // If already cleared during this sequence...do nothing
2867 If (Last_Mark_Sequence_id(iDSO)<>DD_Current_mark_id) Begin
2868 Get Private.Data_Set of iDSO iFile to hDD
2869 If hDD Function_return hDD // when found...get out
2870 End
2871 Loop
2872 // recurse up server list next. We do this 2nd because it is
2873 // the less likely path for success.
2874 Get Data_Set_Server_Count to iMax
2875 Decrement iMax
2876 For iCount from 0 to iMax
2877 Get Data_Set_Server iCount to iDSO
2878 // If already cleared during this sequence...do nothing
2879 If (Last_Mark_Sequence_id(iDSO)<>DD_Current_mark_id) Begin
2880 Get Private.Data_Set of iDSO iFile to hDD
2881 If hDD Function_return hDD // when found...get out
2882 End
2883 Loop
2884 Function_Return 0 // if here, our traversal has failed.
2885 End_Function // Private.Data_set
2886
2887 //************************************************************************//
2888 // Function File_Field_Property //
2889 // Procedure Set File_Field_Property //
2890 // These methods can be used to set/get a field property in a flexible //
2891 // way. The first two argument are the file- and fieldnumber followed by //
2892 // the ID of the message that should be send. The last argument should //
2893 // be the value to set or the variable to store the value in. //
2894 //************************************************************************//
2895
2896 { Visibility=Private MethodType=Procedure }
2897 Procedure Set File_Field_Property Integer iFile Integer iField Integer iMsg String sValue
2898 Integer iDSO
2899 Get Data_Set iFile to iDSO
2900 If iDSO Begin
2901 Set iMsg of iDSO iField to sValue
2902 Function_Return sValue
2903 End
2904 End_Procedure
2905
2906 { Visibility=Private MethodType=Function }
2907 Function File_Field_Property Integer iFile Integer iField Integer iMsg returns integer
2908 Integer iDSO
2909 String sValue
2910 Get Data_Set iFile to iDSO
2911 If iDSO Begin
2912 Get iMsg of iDSO iField to sValue
2913 Function_Return sValue
2914 End
2915 End_Function
2916
2917
2918
2919 //************************************************************************//
2920 // This procedure will return the number of fields in the object //
2921 //************************************************************************//
2922
2923 { MethodType=Property }
2924 Function Field_Count Returns Integer
2925 Function_Return (Item_Count(Record_Buffer(self)) - 1)
2926 End_Function // Field_Count
2927
2928 //************************************************************************//
2929 // This procedure will clear all flags in the visited_fields string so //
2930 // that all field will be validated on the next requests. //
2931 //************************************************************************//
2932
2933 { Visibility=Private }
2934 Procedure Clear_Visited_Fields
2935 // this clears field visitation marks
2936 Set Visited_Fields To (Repeat(" ", Field_Count(self)))
2937 End_Procedure // Clear_Viisted_Fields
2938
2939
2940 //************************************************************************//
2941 // Private.Initialize_Visited //
2942 // This procedure will be called when validations (and perhaps other //
2943 // events) is requested. It clears the visited marks and then proceeds //
2944 // to clear the marks up the server tree. //
2945 // This is passed two parameters: Up_and_down, If true upward and downward//
2946 // initialize. If Clear_Fields also clear the field string //
2947 //************************************************************************//
2948
2949 { Visibility=Private }
2950 Procedure Private.Initialize_Visited integer Up_and_Down integer Clear_Fields
2951 Integer iMax
2952 Integer iDSO
2953 Integer iCount
2954
2955 // recurse up server list first. Only recurse up
2956 Get Data_Set_Server_Count to iMax
2957 Decrement iMax
2958 For iCount from 0 to iMax
2959 Get Data_Set_Server iCount to iDSO
2960 // If already cleared during this sequence...do nothing
2961 If (Last_Mark_Sequence_id(iDSO)<>DD_Current_mark_id) ;
2962 Send Private.Initialize_Visited to iDSO FALSE Clear_Fields
2963 Loop
2964
2965 If Clear_Fields Send Clear_Visited_Fields // clear all markers in this object
2966 // this clears the visited mark for the entire object
2967 Set Visited_State to False
2968 Set Last_Mark_Sequence_id to DD_Current_mark_id
2969
2970 // If Up_and_Down recurse Down server list
2971 If Up_and_Down Begin
2972 Get Data_Set_Client_Count to iMax
2973 Decrement iMax // **EK** This line was missing
2974 For iCount from 0 to iMax
2975 Get Data_Set_Client iCount to iDSO
2976 // If already cleared during this sequence...do nothing
2977 If (Last_Mark_Sequence_id(iDSO)<>DD_Current_mark_id) ;
2978 Send Private.Initialize_Visited to iDSO TRUE Clear_Fields
2979 Loop
2980 End
2981 End_Procedure // Private.Initialize_Visited
2982
2983 //************************************************************************//
2984 // Initialize_Visted //
2985 // Clears Visited marks and (maybe) field visited marks in all required //
2986 // DSOs. If Up_and_Down is TRUE DSOs are marked up and Down (delete style)//
2987 // propagation. If False, DSOs are marked up (save style). This does not //
2988 // have a mode to mark ALL DSOs in a structure. (Not needed so far). //
2989 // If Clear_Fields is T the field string marker is also cleared. //
2990 // The method of using the global integer DD_Current_Mark_ID is an opt- //
2991 // imizer. This is private - do not tamper with it! //
2992 //************************************************************************//
2993
2994 { Visibility=Private }
2995 Procedure Initialize_Visited integer Up_and_Down integer Clear_Fields
2996 // This Mark_Id creates a sequence Id for this clear. This way
2997 // DSOs only get cleared one time during this process.
2998 If DD_Current_Mark_ID ge 65536 Move 0 to DD_Current_Mark_id
2999 Increment DD_Current_Mark_id
3000 Send Private.Initialize_Visited Up_and_Down Clear_Fields
3001 End_Procedure // Initialize_Visited
3002
3003
3004 //************************************************************************//
3005 // Private.Valid_Structure //
3006 // Internal recursive message to check file connections. Called from //
3007 // Valid_connections only. Private message //
3008 //************************************************************************//
3009
3010 { Visibility=Private }
3011 Function Private.Valid_Structure Integer Up_And_Down Returns Integer
3012 integer iRval
3013 integer iCount
3014 integer iMax
3015 integer iDSO
3016
3017 // Check Current Connections
3018 Get Valid_Servers to iRval // always check servers
3019 If (iRval=0 and Up_and_Down) ; // check Clients if required
3020 Get Valid_Clients to iRval
3021 Set Visited_State to TRUE
3022
3023 // Ask Server data-sets to check their server connections
3024 If Not iRval Begin // check up
3025 Get Data_Set_Server_Count to iMax
3026 Decrement iMax
3027 For iCount from 0 to iMax
3028 Get Data_Set_Server iCount to iDSO
3029 If Not (Visited_state(iDSO)) ;
3030 Get Private.Valid_Structure of iDSO False to iRVal
3031 Until iRval
3032 End
3033
3034 // If required, Ask Clients to check their server and client connections
3035 If (iRval=0 AND Up_and_Down) Begin // check down
3036 Get Data_Set_Client_Count to iMax
3037 Decrement iMax
3038 For iCount from 0 to iMax
3039 Get Data_Set_Client iCount to iDSO
3040 If Not (Visited_state(iDSO)) ;
3041 Get Private.Valid_Structure of iDSO True to iRVal
3042 Until iRval
3043 End
3044
3045 Function_return iRVal
3046
3047 End_Function
3048
3049
3050 //************************************************************************//
3051 // Valid_Structure //
3052 // Validate data-set updating connections against required connections //
3053 // Pass: Up_and_down=T if we should check Server and Client connections //
3054 // =F is we only check servers //
3055 // Ret: 0 if ok, Missing File# if not ok. //
3056 //************************************************************************//
3057
3058 { Visibility=Private }
3059 Function Valid_Structure Integer Up_And_Down Returns Integer
3060 Send Initialize_Visited Up_and_Down False // False=don't clear field marks
3061 Function_Return (Private.Valid_Structure(self,Up_and_Down))
3062 End_Function
3063
3064
3065
3066 //************************************************************************//
3067 // Validate_Fields //
3068 // This function will execute the validation message for each field within//
3069 // this object. If DoAllFG is true all items are validated. If false //
3070 // only unvisited items are checked. //
3071 // Added bNoStop, If true, all items are validated. It is up to you to //
3072 // do something with the possible cascade of errors //
3073 // if the err returns DFERR_ENTER_VALID_REC_ID we will not continue //
3074 // the validation (the other fields will be bad). This works best if the //
3075 // findreq appears as one of the first fields in the file (which is almost//
3076 // always the case //
3077 //************************************************************************//
3078
3079 { Visibility=Private }
3080 Function Validate_Fields integer DoAllFg integer bNoStop Returns Integer
3081 Integer iRetval
3082 Integer iMax
3083 Integer iCount
3084 Integer iFile
3085 integer iErr
3086 String sVS
3087 Get Visited_Fields To sVS
3088 Get Field_Count To iMax
3089 Get Main_File to iFile
3090 For iCount From 1 To iMax
3091 If (DoAllFG OR Mid(sVS, 1, iCount)=" ") Begin
3092 Get Validate_Field iCount to iErr
3093 If iErr Begin
3094 Move iErr to iRetVal
3095 // error occured. If not no-stop or the error is
3096 // a findreq error - we are done.
3097 If (not(bNoStop) OR iRetVal=DFERR_ENTER_VALID_REC_ID) ;
3098 Function_return iRetVal
3099 end
3100 end
3101 Loop
3102 Function_Return iRetval
3103 End_Function
3104
3105 //************************************************************************//
3106 // Function Validate_Required //
3107 //************************************************************************//
3108
3109 { Visibility=Private }
3110 Function Validate_Required Integer iField Returns Integer
3111 integer bErr
3112 Move (trim(Field_Current_Value(self,iField))='') to bErr
3113 If bErr ;
3114 Send Data_set_Error iField DFERR_ENTRY_REQUIRED ""
3115 Function_Return bErr
3116 End_Function
3117
3118 //************************************************************************//
3119 // Function Validate_FindReq //
3120 //************************************************************************//
3121
3122 { Visibility=Private }
3123 Function Validate_FindReq Integer iField Returns Integer
3124 integer bErr iOpts
3125 // if no current record, we have not found the required record.
3126 Move (not(HasRecord(self))) to bErr
3127 // We also need to check if the field is changed. If the field is changed and this
3128 // is an autofind field, this indicates that an autofind was attempted and failed. We
3129 // can't jut rely on current_record because a failed autofind restores the old current
3130 // record. For this to work, DEOs must set the DD field's changed_state to true on
3131 // no-put fields (dd_deomx.pkg was changed to do this).
3132 If (not(bErr) and field_changed_state(self,iField)) Begin
3133 Get Field_Options iField to iOpts
3134 Move ( ((iOpts IAND DD_AUTOFIND)=DD_AUTOFIND) OR ;
3135 ((iOpts IAND DD_AUTOFIND_GE)=DD_AUTOFIND_GE) ) ;
3136 to bErr
3137 end
3138 If bErr ;
3139 Send Data_set_Error iField DFERR_ENTER_VALID_REC_ID ""
3140 Function_Return bErr
3141 End_Function
3142
3143 //************************************************************************//
3144 // Function Validate_Field //
3145 // This function will be called to validate a field. //
3146 // mark field currently being validated //
3147 // Altered to Check DD options (required, findreq) //
3148 //************************************************************************//
3149
3150 { Visibility=Private }
3151 Function Validate_Field Integer iField Returns Integer
3152 Integer iResult
3153 Integer iMsg
3154 Integer iObj
3155 String sValue
3156 integer iFile
3157 integer iOpts
3158 Set Current_Validate_Field to iField
3159 Move (Record_Buffer(self)) to iObj
3160 Get Main_File to iFile
3161
3162 // Check for DD option failures: required, find_required
3163 // "File_field" gets regular and foreign fields as needed
3164 //Get File_Field_Options iFile iField to iOpts
3165 Get Field_Options iField to iOpts // get reg options
3166 // if this is not the DDO that started the validation, we will assume that
3167 // this is foreign. Operation_origin is set in Request_Validate
3168 // If foreign (as defined above) and we do not allow new saves when
3169 // foreign, we will consider this to be foreign and add foreign options
3170 If (Operation_Origin<>self AND ;
3171 Allow_Foreign_New_Save_State(self)=0) ;
3172 Move (iOpts IOR Foreign_Field_Options(self, iField)) to iOpts
3173
3174 // Check for FindReq first. If it fails, set iResult to DFERR_ENTER_VALID_REC_ID so
3175 // the calling function knows that a findreq failed. Always do this validation first
3176 If (iOpts IAND DD_FINDREQ) Get Validate_FindReq iField to iResult
3177 If iResult ;
3178 Move DFERR_ENTER_VALID_REC_ID to iResult
3179 Else ;
3180 If (iOpts IAND DD_REQUIRED) Get Validate_Required iField to iResult
3181
3182 If iResult eq 0 Begin
3183 // First execute the user defined validation message
3184 Get Item_Validate_MSG of iObj iField to iMsg
3185 If iMsg Begin
3186 Get Field_Current_Value iField to sValue
3187 Get iMsg iField sValue to iResult
3188 End
3189 End
3190
3191 // Check for keys
3192 If (iResult=0 AND Key_Field_State(self, iField)) ;
3193 Get Validate_Key_Field iField to iResult
3194
3195 // Do extended validations
3196 if iResult eq 0 ;
3197 Get Validate_Field of (Field_Attributes(self)) iField to iResult
3198
3199 Set Current_Validate_Field to 0
3200 // Mark this field being validated
3201 Get Visited_Fields to sValue
3202 Set Visited_Fields to (Overstrike("X", sValue, iField))
3203
3204 //If iResult ; // JJT why did I do this???
3205 Function_Return iResult
3206
3207 End_Function
3208
3209
3210
3211 //************************************************************************//
3212 // Function File_Field_Validate_Field //
3213 // This function will be called to validate a field. //
3214 //************************************************************************//
3215
3216 { Visibility=Private }
3217 Function File_Field_Validate_Field Integer iFile Integer iField Returns Integer
3218 Integer iDSO
3219 Integer iResult
3220 integer hOldOrigin
3221 Get Data_Set iFile to iDSO
3222 If Not iDSO ;
3223 Function_Return 0
3224
3225 // This function is only called by the DEOs.
3226 // It is possible for validate_item when called as part of
3227 // request_validate to get called more than once
3228 // when a field is foreign (it is attached to both its DDO and the
3229 // child-main ddo). This makes sure the validation is only called once.
3230 // (vdf7 change: previously we set OpMode to Mode_Saving and checked that, now we have
3231 // a mode just for request_validate).
3232 If (Operation_Mode=MODE_VALIDATING AND ; // if from request_validate
3233 Mid(Visited_Fields(iDSO), 1, iField)="X" ) ; // and already marked
3234 Function_return 0 // skip it
3235
3236 Move Operation_origin to hOldOrigin
3237 Move self to Operation_Origin
3238 Get Validate_Field of iDSO iField to iResult
3239 Move hOldOrigin to Operation_Origin
3240 Function_Return iResult
3241 End_Function
3242
3243
3244
3245 //************************************************************************//
3246 // Function Validate_Key_Field //
3247 // This function will be called to check if a key has been changed. //
3248 //************************************************************************//
3249
3250 { Visibility=Private }
3251 Function Validate_Key_Field Integer iField Returns Integer
3252 String sOld_Value
3253 String sNew_Value
3254 String sKeys
3255 Integer iState
3256 Boolean bMultiKeys
3257 Get Protect_Key_State to iState
3258 If iState Begin
3259 Get Key_Value to sNew_Value
3260 // Only check existing records.
3261 If (HasRecord(self)) begin
3262 Get Existing_Key_Value to sOld_Value
3263 If sNew_Value NE sOld_Value Begin
3264 // we have an error. If there is only one key field we know
3265 // where the field is and we can report that field. If we have
3266 // multiple key fields, we don't really know where the offending key change
3267 // is, so we will not report a field.
3268 Get Key_Fields to sKeys
3269 Move (Pos("X",sKeys)<>RightPos("X",sKeys)) to bMultiKeys
3270 Send Data_set_Error (If(bMultiKeys, -1, iField)) 0 DD_TEXT_NO_KEY_CHANGE_ALLOWED
3271 Function_Return 1
3272 End
3273 End
3274 End
3275 End_Function
3276
3277
3278
3279 //************************************************************************//
3280 // Validate_Data_Sets //
3281 // This function will execute the validation message for each field of the//
3282 // data set and all of its parents in parent first order. //
3283 // Pass: DoALLFg bNoStop //
3284 // Added bNoStop, If true, all items are validated. It is up to you to //
3285 // do something with the possible cascade of errors //
3286 //************************************************************************//
3287
3288 { Visibility=Private }
3289 Function Validate_Data_Sets integer DoAllFg integer bNoStop Returns Integer
3290 Integer iDSO
3291 Integer iRetval
3292 Integer iCount
3293 Integer iMax
3294 Integer bErr
3295 // ShowLn "Validate_Data_Sets in Data_Set in " (Name(self))
3296 // Validate if not foreign, or foreign new saves allowed, or
3297 // foreign validation is supported (it normally is)
3298 If (Operation_Origin=self OR ;
3299 Allow_Foreign_New_Save_State(self) OR ;
3300 Validate_Foreign_File_State(self)) Begin
3301 Get Data_Set_Server_Count to iMax
3302 Decrement iMax
3303 For iCount from 0 to iMax
3304 Get Data_Set_Server iCount to iDSO
3305 If Not (Visited_state(iDSO)) Begin
3306 Get Validate_Data_Sets of iDSO DoAllFg bNoStop to bErr
3307 If bErr Begin
3308 Move bErr to iRetVal
3309 If bNoStop Move 0 to bErr
3310 end
3311 End
3312 Until bErr
3313 If not bErr Begin
3314 Get Validate_Fields DoAllFg bNoStop To bErr
3315 If bErr Move bErr to iRetVal
3316 End
3317 End
3318 Set Visited_State to TRUE
3319 Function_Return iRetval
3320 End_Function // Validate_Data_Sets
3321
3322
3323
3324 //************************************************************************//
3325 // Entry_Update_Data_Sets //
3326 // This sends entry_update to all server data-sets and itself //
3327 //************************************************************************//
3328
3329 { Visibility=Private }
3330 Procedure Entry_Update_Data_Sets Integer iFile Integer iAll
3331 Integer iDSO
3332 integer iMax
3333 integer iCount
3334 // Send Show_Debug_Info ("Entry_Update_Data_sets in xDataSet. iFile=" + String(iFile) * "iAll=" + String(iAll) )
3335 Get Data_Set_Server_Count to iMax
3336 Decrement iMax
3337 For iCount from 0 to iMax
3338 Get Data_Set_Server iCount to iDSO
3339 If Not (Visited_state(iDSO)) ;
3340 Send Entry_Update_Data_Sets to iDSO iFile iAll
3341 Loop
3342 //Send Entry_Update to (Record_Buffer(self)) iFile iAll
3343 //Send Entry_Update to (Record_Buffer(self)) ;
3344 // (main_file(self)) (Current_Record(self)=0)
3345
3346 // We need to distinguish between updates for finds and saves. A find update
3347 // should update everything, a save should only update changed, non-noput values.
3348 // Passing 0 is save and will update if field is not dislayonly and not Noput AND (changed or forceput)
3349 // passing 1 is find and will update if field is not displayonly (noput AND noenter).
3350 Send Entry_Update to (Record_Buffer(self)) ;
3351 (main_file(self)) (Operation_Mode<>MODE_SAVING)
3352
3353#IFDEF SUPPORT$EXTENDED$FIELDS
3354 // also move data from extended dd fields to buffer
3355 Send ExtendedFieldsUpdate (Operation_Mode=MODE_SAVING)
3356#ENDIF
3357
3358 Set Visited_State to TRUE
3359 End_Procedure
3360
3361
3362 //************************************************************************//
3363 // Valid_Servers //
3364 // Check that Server data-sets exist for all required server file numbers //
3365 //************************************************************************//
3366
3367 { Visibility=Private }
3368 Function Valid_Servers returns integer
3369 integer iRval
3370 integer iCount
3371 integer iMax
3372 integer iDSO
3373 integer iPos
3374 integer iFile
3375 String sFiles
3376
3377 // First assemble a string of all server file#s in ','##',' format
3378 Move ',' to sFiles
3379 Get Data_Set_Server_Count to iMax
3380 Decrement iMax
3381 For iCount from 0 to iMax
3382 Get Data_Set_Server iCount to iDSO
3383 Move ( sFiles + string(Main_file(iDSO)) + ",") to sFiles
3384 Loop
3385
3386 // Make sure each required File exists
3387 Get Server_File_Count to iMax
3388 Decrement iMax
3389 For iCount from 0 to iMax
3390 Get Server_File iCount to iFile
3391 Pos (','+string(iFile)+',') in sFiles to iPos
3392 If iPos eq 0 Move iFile to iRVal
3393 Until iRval
3394 Function_Return iRVal
3395 End_Function
3396
3397
3398 //************************************************************************//
3399 // Valid_Clients //
3400 // Check that Client data-sets exist for all required Client file numbers //
3401 //************************************************************************//
3402
3403 { Visibility=Private }
3404 Function Valid_Clients returns integer
3405 integer iRval
3406 integer iCount
3407 integer iMax
3408 integer iDSO
3409 integer iPos
3410 integer iFile
3411 String sFiles
3412
3413 // First assemble a string of all Client file#s in ','##',' format
3414 Move ',' to sFiles
3415 Get Data_Set_Client_Count to iMax
3416 Decrement iMax
3417 For iCount from 0 to iMax
3418 Get Data_Set_Client iCount to iDSO
3419 Move ( sFiles + string(Main_file(iDSO))+",") to sFiles
3420 Loop
3421
3422 // Make sure each required File exists
3423 Get Client_File_Count to iMax
3424 Decrement iMax
3425 For iCount from 0 to iMax
3426 Get Client_File iCount to iFile
3427 Pos (','+string(iFile)+',') in sFiles to iPos
3428 If iPos eq 0 Move iFile to iRVal
3429 Until iRval
3430 Function_Return iRVal
3431 End_Function
3432
3433
3434 //************************************************************************//
3435 // Function Validate_Save_Structure //
3436 // Validates save updating connections. If error returns file# that is //
3437 // expected and missing. If no error Set Validated_Save_connectio_State //
3438 // indicating that the connection validation has occurred and is ok //
3439 //************************************************************************//
3440
3441 { Visibility=Private }
3442 Function Validate_Save_Structure Integer ForceFg returns Integer
3443 Integer iRval
3444 Integer iMode
3445 If Not ForceFg Begin
3446 Get Validate_Save_Structure_Mode to iMode
3447 Move ( iMode=DD_VALIDATE_STRUCTURE_ALWAYS OR ;
3448 (iMode=DD_VALIDATE_STRUCTURE_ONCE AND ;
3449 Save_Structure_Validated_state(self)=0 ) ) ;
3450 to ForceFg
3451 End
3452 If ForceFg Begin
3453 Get Valid_Structure False to iRval
3454 if iRVal eq 0 ;
3455 Set Save_Structure_Validated_State to TRUE
3456 End
3457 Function_Return iRVal
3458 End_Function
3459
3460
3461 //************************************************************************//
3462 // Function Validate_delete_Structure //
3463 // Validates Delete Structure. If cascade_state is true this must check //
3464 // up and down the tree. If no cascade_state just check up the tree. If //
3465 // Ok, set Validated_Delete_no_Cascade_Connection_State and and or //
3466 // Validated_Delete_Cascade_Connection_State //
3467 // Pass: ForceFg - if TRUE force the validation. //
3468 //************************************************************************//
3469
3470 { Visibility=Private }
3471 Function Validate_Delete_Structure Integer ForceFg Returns Integer
3472 Integer iCascade
3473 Integer iMode
3474 Integer iSt
3475 Integer iRval
3476 Get Cascade_delete_State to iCascade
3477 If Not ForceFg Begin
3478 Get Validate_Delete_Structure_Mode to iMode
3479 If (iMode=DD_VALIDATE_STRUCTURE_ONCE AND iCascade );
3480 Get Cascade_Delete_Structure_Validated_state to iSt
3481 Else ;
3482 Get No_Cascade_Delete_Structure_Validated_state to iSt
3483 Move ( iMode=DD_VALIDATE_STRUCTURE_ALWAYS OR ;
3484 (iMode=DD_VALIDATE_STRUCTURE_ONCE AND iSt=0) ) to ForceFg
3485 End
3486
3487 If ForceFg Begin
3488 Get Valid_Structure iCascade to iRval
3489 If iRval eq 0 Begin
3490 Set No_Cascade_Delete_Structure_Validated_State to TRUE
3491 If iCascade ;
3492 Set Cascade_Delete_Structure_Validated_State to TRUE
3493 End
3494 End
3495 Function_return iRval
3496 End_Function
3497
3498
3499 //************************************************************************//
3500 // Request_Entry_Update. //
3501 // This procedure will be called whenever the Data_Set wants its DEOs to //
3502 // write their values to the record buffer. The value of OPERATION_MODE //
3503 // determines if this is for finding an record or before saving a record. //
3504 // We use this event to tell our Record_Buffer to update the //
3505 // global record buffer. //
3506 // Modified to visit all server DSOs //
3507 // Note that this is only sent to the DSO starting the operation. //
3508 // We must manually send this to all server data-sets ourselves //
3509 // Note that during a DSO save this will get passed iFile=0 and iAll=3 //
3510 // Changed to Support EntryUpdateLocalState (private) //
3511 //************************************************************************//
3512
3513 { NoDoc=True }
3514 Procedure Request_Entry_Update Integer iFile Integer iAll
3515 If ((Operation_Mode=MODE_SAVING and iAll=3) or (EntryUpdateLocalState(Self)) ) Begin //3=dso save
3516 If (OPERATION_MODE=MODE_WAITING) Begin
3517 // we will only not be in an operation if we are doing a find with EntryUpdateLocalState
3518 // set to true. In such a case make this a finding. I am not this is actually needed
3519 Send Update_Focus_Field_For_Operation MODE_FINDING
3520 End
3521 Else Begin
3522 // if here we already have an operation_mode so there is no need to do anything special
3523 Send Update_Focus_Field // Make sure buffer has latest focus item changes
3524 End
3525 Send Initialize_Visited False False // Clear up, do not clear fields
3526 Send Entry_Update_Data_Sets iFile iAll
3527 End
3528 Forward Send Request_Entry_Update iFile iAll
3529 End_Procedure
3530
3531
3532
3533 //************************************************************************//
3534 // Update_Focus_Field //
3535 // Forces the focus field to get update its value with the data-set. //
3536 // This insures that the DSO and DEO contain the same values. //
3537 //************************************************************************//
3538
3539 { Visibility=Private }
3540 Procedure Update_Focus_Field
3541 Integer iFocObj
3542 Get Focus of desktop to iFocObj
3543 If (Extended_DEO_State(iFocObj)) ;
3544 Send Update_Focus_Field to iFocObj
3545 End_Procedure
3546
3547 { Visibility=Private }
3548 // very internal. Used to set Operation_mode and Operation_origin before the
3549 // update. A developer can use this in the DEO to know what state the update is in.
3550 // This was created because a DEO value change will trigger an OnChange event and you
3551 //can look at this and know that this is part of a DD operation.
3552 // This is *only* called by the DD operations in this class and the change is made for as
3553 // small of a period as possible.
3554 Procedure Update_Focus_Field_For_Operation Integer iOperationMode
3555 Integer iOldMode iOldOrigin
3556
3557 Move OPERATION_MODE to iOldMode
3558 Move OPERATION_ORIGIN to iOldOrigin
3559 Move iOperationMode to OPERATION_MODE
3560 Move Self to OPERATION_ORIGIN
3561 Send Update_Focus_Field
3562 Move iOldMode to OPERATION_MODE
3563 Move iOldOrigin to OPERATION_ORIGIN
3564 End_Procedure
3565
3566
3567 //************************************************************************//
3568 // Request_validate //
3569 // Augment to validate all field values that do not get //
3570 // validated as part of the item validation process. The advantage //
3571 // of item validation (over only field validation) is that an error //
3572 // returns you to the offending item. //
3573 //************************************************************************//
3574
3575 { NoDoc=True }
3576 Function Request_Validate Returns Integer
3577 Integer iRetval iOldOrigin iOldMode
3578 If (OPERATION_MODE=MODE_WAITING) Begin
3579 Send Update_Focus_Field_For_Operation MODE_VALIDATING // added 12.1/15.1
3580 End
3581 Move Operation_Origin to iOldOrigin
3582 Move self to Operation_Origin
3583 Move Operation_Mode to iOldMode
3584 // Prior to VDF7, we set this to Mode_Saving. We now have a special mode just for request_validate.
3585 // We do this because:
3586 // 1) because it is useful (more detail never hurts) and
3587 // 2) we will allow set_field_current_value to update when mode_validation is set
3588 Move MODE_VALIDATING to Operation_Mode
3589 // ShowLn "Request_Validate in Data_Set in " (Name(self))
3590 Send Initialize_Visited FALSE TRUE //false=up only, true=clear fields
3591 Forward Get Request_Validate To iRetval // normal deo validate
3592 // If DEO validation failed, do not validate other fields
3593 If ( iRetval=0 AND Validate_DEOs_Only_State(self)=0) ;
3594 Get Validate_Data_Sets FALSE (Validate_All_Fields_State(self)) To iRetval
3595 Move iOldMode to Operation_Mode
3596 Move iOldOrigin to Operation_Origin
3597 Function_Return iRetval
3598 End_Function // Request_Validate
3599
3600 Function Request_Validate_All Returns Integer
3601 Integer bOld iRetVal
3602 Get Validate_All_Fields_State to bOld
3603 Set Validate_All_Fields_State to True
3604 Get request_validate to iretVal
3605 Set Validate_All_Fields_State to bOld
3606 Function_Return iRetval
3607 End_Function // Request_Validate_All
3608
3609
3610
3611 //************************************************************************//
3612 // File_Field_Find //
3613 // Like Item_find except entry-update is forced through the DD, not DEO //
3614 //************************************************************************//
3615
3616 procedure File_Field_Find integer iFindMode integer iFile integer iField ;
3617 integer bEntUpdt integer bShowErr integer bDfrd
3618 Integer bOld
3619 Get EntryUpdateLocalState to bOld
3620 Set EntryUpdateLocalState to True
3621 Send Item_Find iFindMode iFile iField bEntUpdt bShowErr bDfrd
3622 Set EntryUpdateLocalState to bOld
3623 End_Procedure
3624
3625 //************************************************************************//
3626 // File_Field_AutoFind //
3627 // Autofind for requestd file, field and mode. //
3628 // If mode not passed, EQ is assummed //
3629 //************************************************************************//
3630
3631 Procedure File_Field_AutoFind integer iFile integer iField integer iFindMode
3632 integer eMode
3633 if iFile Begin
3634 // if no 3rd argument, default to autofind
3635 Move (If(Num_Arguments<3,EQ,iFindMode)) to eMode
3636 send File_Field_Find eMode iFile iField True False False
3637 end
3638 End_Procedure
3639
3640 //************************************************************************//
3641 // File_Field_Default_AutoFind //
3642 // Autofind in default mode (does not set changed states). Can be used //
3643 // within Clear and Clear_all to autofind parents. Parent values can be //
3644 // maintained using retainAll option //
3645 //************************************************************************//
3646
3647 Procedure File_Field_Default_AutoFind integer iFile integer iField
3648 integer iOldState
3649 Handle hoDD
3650 Get Data_set iFile to hoDD
3651 if hoDD Begin
3652 Get Change_disabled_State of hoDD to iOldState
3653 Set Change_disabled_State of hoDD to TRUE
3654 Send File_Field_AutoFind of hoDD iFile iField EQ
3655 Set Change_disabled_State of hoDD to iOldState
3656 set changed_state to false
3657 end
3658 End_Procedure
3659
3660 //************************************************************************//
3661 // File_Index_find //
3662 // Like item_find except you pass the index you want to find with and //
3663 // ent-update occurs through DDO buffers not deo buffers. //
3664 // This is currently private and is only used by web-applications //
3665 //************************************************************************//
3666 { Visibility=Private MethodType=Procedure }
3667 procedure File_Index_Find integer iFindMode integer iFile integer iIndex ;
3668 integer bEntUpdt integer bShowErr integer bDfrd
3669 Integer bOld
3670 rowId riRec
3671 integer wasChanged hDD iOldStat
3672 Boolean bOk
3673
3674 Get Data_Set iFile to hDD
3675 if (hDD=0) Begin
3676 error DFERR_PROGRAM C_$CannotFindDD
3677 Procedure_return
3678 end
3679
3680 Get EntryUpdateLocalState to bOld
3681 Set EntryUpdateLocalState to True
3682
3683 // 'hold' buffer to prepare for entry_update
3684 Move (getRowId(iFile)) to riRec
3685 Get_Attribute DF_FILE_STATUS of iFile to iOldStat
3686 Set_Attribute DF_FILE_STATUS of iFile to DF_FILE_INACTIVE
3687
3688 if bEntUpdt begin
3689 send Request_Entry_Update to hDD iFile 1 //entUpdt all DEOs as required
3690
3691 //
3692 // we really only need to know if any segment of the index changed
3693 // but since we don't have field-changed flags, we look at the
3694 // whole recbuf - this is consistent with 2.3b and 3.0 non-dataset
3695 // behavior.
3696 //
3697 move (iOldStat<>DF_FILE_INACTIVE) to wasChanged
3698 if not wasChanged ;
3699 Get_Attribute DF_FILE_CHANGED of iFile to wasChanged
3700 if not wasChanged ;
3701 constrained_clear iFindMode iFile by iIndex
3702
3703 //send Attach_Main_File to hDD // not needed, gets called by the find
3704 end
3705 indicate err false
3706 if bDfrd ;
3707 send Request_Read iFindMode iFile iIndex
3708 else ;
3709 send Request_Find iFindMode iFile iIndex
3710 If (not(found) and not(err)) begin
3711 // refind original record (or leave it cleared if not record)
3712 Move (FindByRowId(iFile,riRec)) to bOk
3713
3714 if bShowErr ;
3715 error (if(iFindMode<2, DFERR_FIND_PRIOR_BEG_OF_FILE, DFERR_FIND_PAST_END_OF_FILE))
3716 indicate Found False
3717 end
3718 Set EntryUpdateLocalState to bOld
3719 End_Procedure
3720
3721
3722 //************************************************************************//
3723 // Find_Records //
3724 // This does a refind of all records based on the contents of the //
3725 // refine_record_id property. //
3726 // This would be used after clearing the DDs and loading the local rencum //
3727 // buffer with recnums. This can be used by remote DEOs (BPOs). //
3728 // //
3729 // Find all existing records. This must be done in bottom-up, breadth //
3730 // first order. i.e., Start with the passed DD, find it and then find for //
3731 // parents. Only find if the record is non-zero and it is different than //
3732 // the current_record. //
3733 // This order will allow us to support changed parents. //
3734 // Don't use this if you do not understand what it does. //
3735 // Private.Find_Records is a helper. We will keep this private because //
3736 // it is rather specialized and only used by WebApp. //
3737 //************************************************************************//
3738
3739 { Visibility=Private }
3740 Procedure Find_Records
3741 Send Initialize_Visited False False // Clear up, do not clear fields
3742 Send Private.Find_Records // refind all records in upward sweep
3743 End_Procedure
3744
3745
3746 { Visibility=Private }
3747 Procedure Private.Find_Records
3748 Integer hPrnt
3749 integer iMax
3750 integer iCount
3751 RowId riRec
3752 Integer iRec iMain
3753 // works with both recId and rowId. Only one should ever be set.
3754 // find(clear) record, if needed
3755 Get Main_File to iMain
3756 // assume that either Find_rowId or Find_record_id has a value - never both
3757 // also assume Find_record_id only has values when you are using a recnum table
3758 Get Find_RowId to riRec
3759 If not (IsNullRowId(riRec)) begin
3760 If not (IsSameRowId(riRec, CurrentRowId(self) ) ) begin
3761 Send FindByRowId iMain riRec // find an Relate all parents
3762 end
3763 Set Find_rowid to (NullRowId()) // reset refind rec back to zero.
3764 end
3765 else begin
3766 // if this has a recnum, it better be a recnum table or an error will occur.
3767 // This is not being tested for a recnum table on purpose. If someone is setting Find_record_id
3768 // on a non-recnum table, they doing something wrong. An Error will be a good thing.
3769 Get Find_Record_Id to iRec
3770 If iRec begin
3771 If (iRec<>Current_record(self)) begin
3772 Send Find_By_Recnum iMain iRec // find an Relate all parents
3773 end
3774 Set Find_record_id to 0 // reset refind rec back to zero.
3775 end
3776 end
3777 Set Visited_State to True
3778
3779 // recurse and do the same to all parent files
3780 // in almost all cases, there will be no new finding here since the relate has
3781 // found the records. If the record is different than the relate, we have
3782 // a switched parent state (should_save will be set appropriately).
3783 Get Data_Set_Server_Count to iMax
3784 Decrement iMax
3785 For iCount from 0 to iMax
3786 Get Data_Set_Server iCount to hPrnt
3787 If Not (Visited_state(hPrnt)) ;
3788 Send Private.Find_Records to hPrnt
3789 Loop
3790 End_Procedure
3791
3792
3793 //************************************************************************//
3794 // Request_Save //
3795 // Augmented to test updating connections. //
3796 // If error report it. //
3797 //************************************************************************//
3798
3799 { NoDoc=True }
3800 Procedure Request_Save
3801 Integer iRval
3802 If (OPERATION_MODE=MODE_WAITING) Begin
3803 Send Update_Focus_Field_For_Operation MODE_SAVING // added in 12.1/15.1
3804 Get Validate_Save_Structure False to iRval
3805 If iRval Begin
3806 Send Data_Set_Error -1 0 DD_INVALID_SAVE_STRUCTURE iRval
3807 Procedure_Return
3808 End
3809 End
3810 Forward Send Request_Save
3811 End_Procedure // Request_Save
3812
3813 //************************************************************************//
3814 // Request_Delete //
3815 // Augmented to test updating connections. //
3816 // If error report it. //
3817 //************************************************************************//
3818
3819 { NoDoc=True }
3820 Procedure Request_Delete
3821 Integer iRval
3822 If (OPERATION_MODE=MODE_WAITING) Begin
3823 Send Update_Focus_Field_For_Operation MODE_DELETING // added to 12.1/15.1
3824 Get Validate_Delete_Structure False to iRval
3825 If iRval Begin
3826 Send data_Set_Error -1 0 DD_INVALID_DELETE_STRUCTURE iRval
3827 Procedure_Return
3828 End
3829 End
3830 Forward Send Request_Delete
3831 End_Procedure // Request_Delete
3832
3833 //************************************************************************//
3834 // Status Help Support //
3835 //************************************************************************//
3836
3837 //************************************************************************//
3838 // Set Status_Help //
3839 // Set status-line help for the passed field. This could have been named //
3840 // Set Field_Status_Help but this keeps this message interface consistent //
3841 // with the rest of DF for windows. //
3842 //************************************************************************//
3843
3844 { MethodType=Property }
3845 Procedure Set Status_Help Integer iField string sVal
3846 Set Value of (StatusHelp_Array(self)) iField to sVal
3847 End_procedure
3848
3849 //************************************************************************//
3850 // Get Status_Help //
3851 // Get status-line help for the passed field. This could have been named //
3852 // Get Field_Status_Help but this keeps this message interface consistent //
3853 // with the rest of DF for windows. //
3854 //************************************************************************//
3855
3856 { MethodType=Property }
3857 Function Status_Help integer iField returns string
3858 string sHelp
3859 Integer iObj
3860 Move (StatusHelp_Array(self)) to iObj
3861 if (Item_Count(iObj)>iField) Begin
3862 Get value of iObj iField to sHelp
3863 if sHelp eq '0' move '' to shelp
3864 end
3865 function_return shelp
3866 End_Function // StatusHelp_Value
3867
3868 //************************************************************************//
3869 // Get File_Field_status_Help //
3870 // Get status-line help for the passed file and field. This is called //
3871 // by DEOs (or any other object) that needs help for a particular file //
3872 // and field. //
3873 //************************************************************************//
3874
3875 { MethodType=Property }
3876 Function File_Field_Status_Help Integer iFile Integer iField returns string
3877 integer iDSO
3878 string sValue
3879 Get Data_set iFile to iDSO
3880 If iDSO ;
3881 Get Status_Help of iDSO iField to sValue
3882 Function_Return sValue
3883 End_Function
3884
3885 //************************************************************************//
3886 // Field Mask Support //
3887 //************************************************************************//
3888
3889 //************************************************************************//
3890 // Get/Set Field_Mask_Type //
3891 // Get File_Field_Mask_Type //
3892 // Allows user to set a mask type. Legal value is any of the current mask //
3893 // window types. 0 Means undefined. //
3894 //************************************************************************//
3895
3896 { MethodType=Property }
3897 Procedure Set Field_Mask_Type Integer iField integer iType
3898 Set Field_Mask_Type of (FieldMask_Array(Self)) iField to iType
3899 End_procedure
3900
3901 { MethodType=Property }
3902 Function Field_Mask_Type integer iField returns integer
3903 Function_Return (Field_Mask_Type(FieldMask_Array(self),iField))
3904 End_Function
3905
3906 { MethodType=Property }
3907 Function File_Field_Mask_Type Integer iFile Integer iField returns integer
3908 integer iDSO
3909 Get Data_set iFile to iDSO
3910 If iDSO ;
3911 Function_Return (Field_Mask_Type(iDSO,iField))
3912 End_Procedure
3913
3914 //************************************************************************//
3915 // Get/Set Field_Mask_Value_State //
3916 // Get File_Field_Mask_Value_state //
3917 // If TRUE the value returned by DEO will contain mask characters. //
3918 // Currently not supported. //
3919 //************************************************************************//
3920
3921 { Visibility=Private MethodType=Property }
3922 Procedure Set Field_Mask_Value_State Integer iField integer iState
3923 Set Field_Mask_Value_State of (FieldMask_Array(Self)) iField to iState
3924 End_procedure
3925
3926 { Visibility=Private MethodType=Property }
3927 Function Field_Mask_Value_State integer iField returns integer
3928 Function_Return (Field_Mask_Value_State(FieldMask_Array(self),iField))
3929 End_Function
3930
3931 { Visibility=Private MethodType=Property }
3932 Function File_Field_Mask_Value_State Integer iFile Integer iField returns integer
3933 integer iDSO
3934 Get Data_set iFile to iDSO
3935 If iDSO ;
3936 Function_Return (Field_Mask_Value_State(iDSO,iField))
3937 End_Procedure
3938
3939 //************************************************************************//
3940 // Get/Set Field_Mask //
3941 // Get File_Field_Mask //
3942 // Allows user to set a mask strinng. Legal value is any of the current //
3943 // masks. Note an empty string with a valid mask type implies that the //
3944 // system should figure it out by itself. //
3945 //************************************************************************//
3946
3947 { MethodType=Property }
3948 Procedure Set Field_Mask Integer iField string sMask
3949 Set Field_Mask of (FieldMask_Array(Self)) iField to sMask
3950 If (Data_Set_User_Interface_Count(self)) ;
3951 Send Field_Mask_Changed iField sMask
3952 End_procedure
3953
3954 { MethodType=Property }
3955 Function Field_Mask integer iField returns string
3956 Function_Return (Field_Mask(FieldMask_Array(self),iField))
3957 End_Function
3958
3959 { MethodType=Property }
3960 Function File_Field_Mask Integer iFile Integer iField returns string
3961 integer iDSO
3962 string sValue
3963 Get Data_set iFile to iDSO
3964 If iDSO ;
3965 Get Field_Mask of iDSO iField to sValue
3966 Function_Return sValue
3967 End_Function
3968
3969 //************************************************************************//
3970 // Get/Set Field_Label_Short //
3971 // Get File_Field_Label_Short //
3972 // Short for field. This is normally used by grid headers. //
3973 //************************************************************************//
3974
3975 { MethodType=Property }
3976 Procedure Set Field_Label_Short Integer iField string sName
3977 Set Field_Label_Short of (FieldMask_Array(Self)) iField to sName
3978 If (Data_Set_User_Interface_Count(self)) ;
3979 Send Field_Label_Changed iField 0 sName
3980 End_procedure
3981
3982 { MethodType=Property }
3983 Function Field_Label_Short integer iField returns string
3984 Function_Return (Field_Label_Short(FieldMask_Array(self),iField))
3985 End_Function
3986
3987 { MethodType=Property }
3988 Function File_Field_Label_Short Integer iFile Integer iField returns string
3989 integer iDSO
3990 string sValue
3991 Get Data_set iFile to iDSO
3992 If iDSO ;
3993 Get Field_Label_Short of iDSO iField to sValue
3994 Function_Return sValue
3995 End_Function
3996
3997 //************************************************************************//
3998 // Get/Set Field_Label_Long //
3999 // Get File_Field_Label_Long //
4000 // Full Name for field. This is normally used by form labels //
4001 //************************************************************************//
4002
4003 { MethodType=Property }
4004 Procedure Set Field_Label_Long Integer iField string sName
4005 Set Field_Label_Long of (FieldMask_Array(Self)) iField to sName
4006 If (Data_Set_User_Interface_Count(self)) ;
4007 Send Field_Label_Changed iField 1 sName
4008 End_procedure
4009
4010 { MethodType=Property }
4011 Function Field_Label_Long integer iField returns string
4012 Function_Return (Field_Label_Long(FieldMask_Array(self),iField))
4013 End_Function
4014
4015 { MethodType=Property }
4016 Function File_Field_Label_Long Integer iFile Integer iField returns string
4017 integer iDSO
4018 string sValue
4019 Get Data_set iFile to iDSO
4020 If iDSO ;
4021 Get Field_Label_Long of iDSO iField to sValue
4022 Function_Return sValue
4023 End_Function
4024
4025 //************************************************************************//
4026 // Get Field_Label_Tag //
4027 // This is not really a DD attribute (it is in the API) but it is //
4028 // appropriate to be accessed from the DD //
4029 //************************************************************************//
4030
4031 { Visibility=Private MethodType=Property }
4032 Function Field_Label_Tag integer iField returns string
4033 String sName
4034 Integer iFile
4035 Get Main_File to iFile
4036 If iFile ;
4037 Get_Attribute DF_FIELD_NAME of iFile iField to sName
4038 Function_Return sName
4039 End_Function
4040
4041 { Visibility=Private }
4042 function SmartCase string sName returns string
4043 integer iPos iNewPos
4044 string sRight
4045 Move (Replaces("_",lowercase(sName)," ")) to sName
4046 Trim (Replaces(".",sName," ")) to sName
4047 Move 1 to iPos
4048 Repeat
4049 Move (mid(sName,255,iPos+1)) to sRight
4050 Move (left(sName,iPos-1) + Uppercase(mid(sName,1,iPos)) + sRight) to sName
4051 Pos " " in sRight to iNewPos
4052 If iNewPos eq 0 break
4053 Add (iNewPos+1) to iPos
4054 Loop
4055 Function_Return sName
4056 end_function
4057
4058 Enumeration_List
4059 Define DD_LABEL_SHORT
4060 Define DD_LABEL_LONG
4061 Define DD_LABEL_TAG
4062 End_Enumeration_List
4063
4064 //************************************************************************//
4065 // Get Field_Label //
4066 // Get File_Field_Label //
4067 // Handy function to get the label for a field. Three "types" are //
4068 // supported: //
4069 // DD_LABEL_SHORT use short, if none use long, if none use smart tag //
4070 // DD_LABEL_LONG use long, if none use smart tag //
4071 // DD_LABEL_TAG use smart tag //
4072 // If you want an explicit field name use oneof the other messages. //
4073 //************************************************************************//
4074
4075 { MethodType=Property }
4076 Function Field_Label Integer iField Integer iType returns string
4077 Integer iServer
4078 string sValue
4079 If iType eq DD_LABEL_SHORT ; // 0 = Short
4080 Get Field_Label_Short iField to sValue
4081 If (iType eq DD_LABEL_LONG OR (iType=DD_LABEL_SHORT and sValue='')) ;
4082 Get Field_Label_Long iField to sValue
4083 If (iType eq DD_LABEL_TAG OR sValue="") Begin
4084 Get Field_Label_Tag iField to sValue
4085 Get SmartCase sValue to sValue
4086 End
4087 Function_Return sValue
4088 End_Function // Field_Label
4089
4090 { MethodType=Property }
4091 Function File_Field_Label Integer iFile Integer iField Integer iType returns string
4092 integer iDSO
4093 string sValue
4094 Get Data_set iFile to iDSO
4095 If iDSO ;
4096 Get Field_Label of iDSO iField iType to sValue
4097 Function_Return sValue
4098 End_Function // File_Field_Label
4099
4100
4101 //************************************************************************//
4102 // Get/Set Field_Class_Name //
4103 // Normally this will not be used by a running program. However, it //
4104 // could be possible to create classes dynamically at runtime, in which //
4105 // case these messages could be useful. No File_Field is provided. If the //
4106 // person knows enough to create dynamic classes they can find the DD. //
4107 //************************************************************************//
4108
4109 { MethodType=Property }
4110 Procedure Set Field_Class_Name Integer iField string sName
4111 Set Field_Class_Name of (FieldMask_Array(Self)) iField to sName
4112 End_procedure
4113
4114 { MethodType=Property }
4115 Function Field_Class_Name integer iField returns string
4116 Function_Return (Field_Class_Name(FieldMask_Array(self),iField))
4117 End_Function
4118
4119 //************************************************************************//
4120 // Field and General Data-Set Error Support //
4121 //************************************************************************//
4122
4123 //************************************************************************//
4124 // Set Field_Error //
4125 // This procedure should be used to set a specific error number and //
4126 // message for a particular field. This can be used with the Field_error //
4127 // message to generate this error during a validation. //
4128 //************************************************************************//
4129
4130 { MethodType=Property }
4131 Procedure Set Field_Error Integer iField Integer iErr String sMsg
4132 Set Field_Error of (Field_Attributes(self)) iField to iErr sMsg
4133 End_Procedure
4134
4135 //************************************************************************//
4136 // Get Field_error_Number //
4137 // Get Field_error_Message //
4138 // Used to retreive the error number and message for a particular field //
4139 //************************************************************************//
4140
4141 { MethodType=Property }
4142 Function Field_Error_Number Integer iField Returns Integer
4143 Function_Return (Field_Error_Number(Field_Attributes(self),iField))
4144 End_Function
4145
4146 { MethodType=Property }
4147 Function Field_Error_Message Integer iField Returns String
4148 Function_Return (Field_Error_Message(Field_Attributes(self),iField))
4149 End_Function
4150
4151 //************************************************************************//
4152 // Procedure Field_Error //
4153 // This procedure is used to declare an error on a standard field //
4154 // validation violation like Range or Check. //
4155 // Can pass 1 to 4 params: //
4156 // iField - Standard usage. Generates field as defined //
4157 // for this field. If field=-1, General error //
4158 // iField SDefault If no field error mess (or field=-1) use //
4159 // the default message //
4160 // iField sDefault sParam1 {sParam2} Replace occurances of @PARAM1 and //
4161 // @PARAM2 in text with these values //
4162 //************************************************************************//
4163
4164 { Visibility=Private }
4165 Procedure Field_Error Integer iField String sDefault ;
4166 String sParam1 String sParam2
4167 Integer iErr
4168 String sMess
4169 If iField ge 0 Begin
4170 Get Field_Error_Number iField to iErr
4171 Get Field_Error_Message iField to sMess
4172 End
4173 If (sMess="" And Num_Arguments>1) ;
4174 Move sDefault to sMess
4175 If Num_Arguments eq 4 ;
4176 Send Data_Set_Error iField iErr sMess sParam1 sParam2
4177 else If Num_Arguments eq 3 ;
4178 Send Data_Set_Error iField iErr sMess sParam1
4179 Else ;
4180 Send Data_Set_Error iField iErr sMess
4181 End_procedure
4182
4183
4184 //************************************************************************//
4185 // Procedure Data_Set_Error //
4186 // This procedure is used to declare a data-set error. Pass error number //
4187 // and optional error message text. //
4188 // If iErr is 0, use the default error number. //
4189 // sParam1 and sParam2 are optional. If passed they are used as text //
4190 // replacements for @PARAM1 and @PARAM2. //
4191 // We pass iField (even though we don't use it) so that augmentations //
4192 // could support error logging down to a field level. If a non-field error//
4193 // is required the developer should pass negative values (e.g., -1) //
4194 // This will redirect errors locally if not already redirected //
4195 // //
4196 // Altered to additionally support %1 %2 replacements as well as //
4197 // replacements for @PARAM1 and @PARAM2. (vdf8.2) //
4198 //************************************************************************//
4199
4200
4201 Procedure Data_set_error Integer iField Integer iErr String sMess ;
4202 String sParam1 String sParam2
4203 integer iOldField
4204 Get Current_validate_field to iOldField
4205 If iField ne 0 Set Current_Validate_field to iField
4206
4207 If iErr eq 0 ; // if no error is passes, used a default error
4208 Move DD_DEFAULT_ERROR_NUMBER to iErr
4209
4210 If sMess GT "" Begin
4211
4212 // Support message replacements.. Up to two values
4213 // altered to support @Param1/2 and %1 %2 messages
4214 If (Num_Arguments>3) begin
4215 Move (Replaces("@PARAM1", sMess, sParam1)) to sMess
4216 If (Num_Arguments>4) begin
4217 Move (Replaces("@PARAM2", sMess, sParam2)) to sMess
4218 Move (SFormat(sMess,sParam1,sParam2)) to sMess
4219 end
4220 else begin
4221 Move (SFormat(sMess,sParam1)) to sMess
4222 end
4223 end
4224 Move self to ghoErrorSource
4225 Error iErr sMess
4226 Move 0 to ghoErrorSource
4227 End
4228 Else ;
4229 Send Operation_Not_Allowed iErr
4230 Set Current_validate_field to iOldField
4231 Move True to Err // make sure Err is still set
4232 End_Procedure
4233
4234 //************************************************************************//
4235 // Procedure Operation_not_allowed //
4236 // Augment to support Error_Report_Mode. Allows errors without error mess //
4237 // This will redirect errors locally if not already redirected //
4238 //************************************************************************//
4239
4240 Procedure Operation_Not_Allowed integer iErr
4241 integer bOK
4242 Move self to ghoErrorSource
4243 Forward Send Operation_Not_Allowed iErr
4244 Move 0 to ghoErrorSource
4245 End_Procedure
4246
4247// ----------Start of Experimental code not yet ready for 8.3 ----------
4248// //Doc/ Visibility=Private
4249// Procedure Data_set_error Integer iField Integer iErr String sMess ;
4250// String sParam1 String sParam2
4251//
4252// If iErr eq 0 ; // if no error is passes, used a default error
4253// Move DD_DEFAULT_ERROR_NUMBER to iErr
4254//
4255// If sMess GT "" Begin
4256//
4257// // Support message replacements.. Up to two values
4258// // altered to support @Param1/2 and %1 %2 messages
4259// If (Num_Arguments>3) begin
4260// Move (Replaces("@PARAM1", sMess, sParam1)) to sMess
4261// If (Num_Arguments>4) begin
4262// Move (Replaces("@PARAM2", sMess, sParam2)) to sMess
4263// Move (SFormat(sMess,sParam1,sParam2)) to sMess
4264// end
4265// else begin
4266// Move (SFormat(sMess,sParam1)) to sMess
4267// end
4268// end
4269// End
4270// Send DDError iErr sMess iField
4271// End_Procedure
4272//
4273// //Doc/ Visibility=Public
4274// Procedure DDError integer iError string sError integer iErrorField
4275// integer iOldField iField
4276// Get Current_validate_field to iOldField
4277// If (Num_Arguments<3) Move 0 to iField
4278// else Move iErrorField to iField
4279// If (iField<>0) Set Current_Validate_field to iErrorField
4280// Move self to ghoErrorSource
4281// Send OnDDError iError sError iField
4282// Move 0 to ghoErrorSource
4283// Set Current_validate_field to iOldField
4284// End_Procedure
4285//
4286// //Doc/ MethodType=Event Visibility=Public
4287// Procedure OnDDError integer iError String sError integer iField
4288//// showln "OnDDError: " (object_label(self)) ' error=' iError ' field=' iField ' Message=' sError
4289// Error iError sError
4290// End_Procedure
4291//
4292// //************************************************************************//
4293// // Procedure Operation_not_allowed //
4294// // Augment to support Error_Report_Mode. Allows errors without error mess //
4295// // This will redirect errors locally if not already redirected //
4296// //************************************************************************//
4297//
4298// //Doc/ Visibility=Public Obsolete=True
4299// Procedure Operation_Not_Allowed integer iErr
4300// Send DDError iErr ""
4301// End_Procedure
4302// ----------End of Experimental code not yet ready for 8.3 ----------
4303
4304 //************************************************************************//
4305 // Procedure Error_report //
4306 // Local error handler. When errors are redirected to the DD this proce- //
4307 // dure handles the errors. If error_report_mode is NO-report it sets //
4308 // the err indicator and returns. Else it redirects the error to the //
4309 // main error handler first moving its ID to ghoErrorSource. This way the //
4310 // handler knows who sent this message and will get additional error info //
4311 // by calling Get Extended_error_message //
4312 //************************************************************************//
4313
4314 { MethodType=Event Visibility=Private }
4315 Procedure Error_Report integer iError integer iLine string ErrMsg
4316 integer hoErrId
4317 integer bRedirect
4318 If (Error_Processing_State(self)) ; // this prevents recursion
4319 Procedure_Return
4320 Set Error_Processing_State to True
4321
4322 // if no report mode, just set the err indicator to true.
4323 If (Error_Report_Mode(self)=DD_ERROR_NO_REPORT) ;
4324 Indicate Err True
4325 else begin
4326 get Old_error_object_id to hoErrId // the original error handler
4327 If hoErrId Begin
4328 Move (ghoErrorSource=0) to bRedirect
4329 if bRedirect move self to ghoErrorSource // error handler can use this
4330 move hoErrID to Error_object_id
4331 Send Error_Report to hoErrId iError iLine ErrMsg
4332 Move self to Error_object_id
4333 if bRedirect move 0 to ghoErrorSource
4334 end
4335 else send error_report of desktop iError iLine ErrMsg
4336 //else forward send error_report iError iLine ErrMsg
4337 end
4338 Set Error_Processing_State to False
4339 End_Procedure
4340
4341 //************************************************************************//
4342 // Function Extended_error_message //
4343 // This is called (by the system error handler) to get additional informa-//
4344 // tion about the error. Returns a multi line string with each line //
4345 // separated by a "\n". Return the file number, name, and if possible //
4346 // the field number and name. //
4347 //************************************************************************//
4348
4349 Function Extended_Error_Message returns string
4350 string sExtMess
4351 string sFile
4352 integer iFile iField
4353 Get main_file to iFile
4354 Get Current_Validate_Field to iField
4355 Get_Attribute DF_FILE_LOGICAL_NAME of iFile to sFile
4356 Move (DD_FILE_TEXT* string(iFile) * "-" * sFile) to sExtMess
4357 If iField GT 0;
4358 Append sExtMess "\n" ;
4359 (DD_FIELD_TEXT* string(iField) * "-" * Field_Label(self,iField,DD_LABEL_LONG))
4360 Set Current_Validate_Field to 0
4361 function_return sExtMess
4362 End_Function
4363
4364 Function Extended_Error_File Returns Integer
4365 Function_Return (Main_File(self))
4366 End_Function
4367
4368 Function Extended_Error_Field Returns Integer
4369 Function_Return (Current_Validate_Field(self))
4370 End_Function
4371
4372
4373 //************************************************************************//
4374 // The following messages are used to control smart file mode exception //
4375 // handling. The message "Send Add_system_File file# Fg" allows you to //
4376 // add system files (or any other files not known to the dso structure) //
4377 // within define_fields. This allows you to not have to augment the msg //
4378 // reset_filemodes_for_lock. The only truly public messages here are //
4379 // Add_system_file and Remove_system_File (which s/b rarely used). //
4380 //************************************************************************//
4381
4382 //************************************************************************//
4383 // Procedure Add_System_File //
4384 // Adds a system file for smart_file_mode handling. A second optional //
4385 // parameter may be passed to determine of the sys file should only be //
4386 // locked during a new save (and not during a delete or a save of an //
4387 // existing record). It is expected that this will be the only public //
4388 // message used to control smart filemode. All of the remaining sys file //
4389 // messages are considered advanced. //
4390 //************************************************************************//
4391
4392 Procedure Add_System_File integer iFile integer iLock_Mode
4393 integer iobj iCnt iMode
4394 If Num_arguments eq 1 Move DD_Lock_on_All to iMode
4395 Else Move iLock_Mode to iMode
4396 Move (system_file_obj(self)) to iObj
4397 Get Item_Count of iObj to iCnt
4398 Set Array_Value of iObj iCnt to iFile
4399 Increment iCnt
4400 Set Array_Value of iObj iCnt to iMode
4401 End_procedure
4402
4403 //************************************************************************//
4404 // Function System_File_Count //
4405 // Return number of system files //
4406 //************************************************************************//
4407
4408 { MethodType=Property }
4409 Function System_File_Count returns integer
4410 Function_Return (Item_Count(System_File_Obj(self))/2)
4411 End_Function // System_File_Count
4412
4413 //************************************************************************//
4414 // Function System_File_Number //
4415 // Returns system file number for passed item. //
4416 //************************************************************************//
4417
4418 { MethodType=Property }
4419 Function System_File_Number Integer iItem returns Integer
4420 Function_Return (Integer_Value(System_File_Obj(self),iItem*2))
4421 End_Function
4422
4423 //************************************************************************//
4424 // Function System_File_Lock_Mode //
4425 // Returns system flag to determine if file is only used during a new //
4426 // save (and not during an exiting save or a delete). //
4427 //************************************************************************//
4428
4429 { MethodType=Property }
4430 Function System_File_Lock_Mode integer iItem returns integer
4431 Function_Return (Integer_Value(System_File_Obj(self),iItem*2+1))
4432 End_Function
4433
4434 //************************************************************************//
4435 // Procedure Remove_System_File //
4436 // Removes a system_file for smart_file_Mode handling. This remvoes the //
4437 // first occurance of the file (S/b the only occurance). We assume that //
4438 // this will be rarely used. //
4439 //************************************************************************//
4440
4441 Procedure Remove_System_File integer iFile
4442 integer iobj iCnt iItmCnt
4443 Get System_file_Count to iItmCnt
4444 Decrement iItmCnt
4445 For iCnt from 0 to iItmCnt
4446 If (System_File_Number(self,iCnt)=iFile) Begin
4447 Move (system_file_obj(self)) to iObj
4448 Move (iCnt*2) to iCnt
4449 Send Delete_Item to iObj iCnt
4450 Send Delete_Item to iObj iCnt
4451 Procedure_Return
4452 End
4453 Loop
4454 End_Procedure
4455
4456 // These set messages, add_client_file, add_server_file and add_system_file
4457 // were added to more easily support visual DD class modeling. They do the
4458 // same thing the Send counterpart messages do
4459
4460 Procedure Set Add_Client_File Integer iFile
4461 Send Add_Client_File iFile
4462 End_Procedure
4463
4464 Procedure Set Add_Server_File Integer iFile
4465 Send Add_Server_File iFile
4466 End_Procedure
4467
4468 Procedure Set Add_System_File Integer iFile Integer iLock_Mode
4469 // allow no arguments because the old message allowed this
4470 If (Num_arguments=1) Begin
4471 Send Add_System_File iFile
4472 End
4473 Else Begin
4474 Send Add_System_File iFile iLock_Mode
4475 End
4476 End_Procedure
4477
4478 // The Set Field_Auto_Increment method replaces the need to use the Define_Auto_Incrmement
4479 // command. This models more easily and it supports multiple auto-increment fields
4480 { MethodType=Property }
4481 Procedure Set Field_Auto_Increment Integer iField Integer iSysFile Integer iSysField
4482 Integer[] AutoIncFields
4483 tDDFileField[] SysFileFields
4484 Integer iIndex
4485
4486 If (iField=0 or (iSysFile<>0 and iSysField=0)) Begin
4487 Error DFERR_PROGRAM "Auto-increment source or destination field is 0"
4488 Procedure_Return
4489 End
4490 // setting the sysfile to 0 is valid. It can be used to clear an existing sysfile
4491 If (iSysFile=0) Begin
4492 Move 0 to iSysField
4493 End
4494 Get pAutoIncrementFields to AutoIncFields
4495 Get pAutoIncrementSysFileFields to SysFileFields
4496 // the destination field array is a list of fields that have auto-incr info. There
4497 // can only be zero or one entry per field arranged in no defined order.
4498 // see if field is already defined. If not add this to the end.
4499 Move (SearchArray(iField,AutoIncFields)) to iIndex
4500 If (iIndex=-1) Begin
4501 Move (SizeOfArray(SysFileFields)) to iIndex
4502 End
4503 Move iField to AutoIncFields[iIndex]
4504 Move iSysFile to SysFileFields[iIndex].iFile
4505 Move iSysField to SysFileFields[iIndex].iField
4506 Set pAutoIncrementFields to AutoIncFields
4507 Set pAutoIncrementSysFileFields to SysFileFields
4508 End_Procedure
4509
4510 // Get auto-increment system file/field value for a field. There really should be no
4511 // reason to ever need this. Field is returned byref
4512 Function Field_Auto_Increment Integer iField Integer ByRef iSysField Returns Integer
4513 Integer iSysFile
4514 Integer[] AutoIncFields
4515 tDDFileField[] SysFileFields
4516 Integer iIndex
4517
4518 Get pAutoIncrementFields to AutoIncFields
4519 Move (SearchArray(iField,AutoIncFields)) to iIndex
4520 If (iIndex>-1) Begin
4521 Get pAutoIncrementSysFileFields to SysFileFields
4522 Move SysFileFields[iIndex].iFile to iSysFile
4523 Move SysFileFields[iIndex].iField to iSysField
4524 End
4525 Else Begin
4526 Move 0 to iSysFile
4527 Move 0 to iSysField
4528 End
4529 Function_Return iSysFile
4530 End_Procedure
4531
4532
4533
4534 //************************************************************************//
4535 // Procedure Reset_FileModes_for_Lock //
4536 // Augmented to set any system files defined via the Add_System_file //
4537 // message. This allows us to hide this procedure for the vast majority //
4538 // of cases. //
4539 //************************************************************************//
4540
4541 { Visibility=Private }
4542 Procedure Reset_Filemodes_For_Lock
4543 Boolean bNewRec
4544 integer iItmCnt iCnt iMode iFile
4545 Forward Send Reset_Filemodes_for_lock
4546 Get System_File_Count to iItmCnt
4547 If iItmCnt Begin
4548 Move (not(HasRecord(self))) to bNewRec
4549 Decrement iItmCnt
4550 For iCnt From 0 to iItmCnt
4551 Get System_File_Number iCnt to iFile
4552 Get System_File_Lock_Mode iCnt to iMode
4553 If ( (iMode=DD_Lock_on_All) OR ;
4554 (Operation_Mode=MODE_DELETING AND (iMode IAND DD_Lock_on_Delete) ) OR ;
4555 (Operation_Mode=MODE_SAVING AND ( (iMode IAND DD_Lock_on_Save) OR ;
4556 ( (iMode IAND DD_Lock_on_New_Save) AND bNewRec) ) ) ) Begin
4557 Set_Attribute DF_FILE_MODE of iFile to DF_FILEMODE_DEFAULT
4558 End
4559 Loop
4560 End
4561 End_Procedure
4562
4563 //************************************************************************//
4564 // Procedure Creating //
4565 // Augmented to handle auto-increment fields if defined. The value from //
4566 // the auto-incre sys file is incremented, saved and moved to the new //
4567 // record. //
4568 //************************************************************************//
4569
4570 { MethodType=Event NoDoc=True }
4571 Procedure Creating
4572 Integer iSrcFile iSrcField i iAutoFields
4573 integer iDestFile iDestField
4574 Number nNum
4575 Integer[] AutoIncFields
4576 tDDFileField[] AutoIncSysFileFields
4577
4578 Forward Send Creating
4579
4580 // this supports the older Define_Auto_Increment logic. Only one is supported
4581 // this is exists for backwards compatibility
4582 Get Auto_Increment_Source_File to iSrcFile
4583 If iSrcFile Begin // do we have auto increment?
4584 Get Auto_Increment_Source_Field to iSrcField
4585 Get Auto_Increment_Dest_Field to iDestField
4586 If (iSrcField AND iDestField) Begin // just in case of error
4587 Get Main_file to iDestFile
4588 Get_Field_Value iSrcFile iSrcField to nNum
4589 Move (nNum+1) to nNum
4590 Set_Field_Value iSrcFile iSrcField to nNum
4591 Set_Field_Value iDestFile iDestField to nNum
4592 SaveRecord iSrcFile
4593 End
4594 End
4595 // this supports the newer set syntax which support multiple fields. It is expected that you will
4596 // use one syntax of the other, not both. If you use the old syntax, you cannot use the new one
4597 Else Begin
4598 Get pAutoIncrementFields to AutoIncFields
4599 Move (SizeOfArray(AutoIncFields)) to iAutoFields
4600 If (iAutoFields>0) Begin
4601 Get pAutoIncrementSysFileFields to AutoIncSysFileFields
4602 Get Main_file to iDestFile
4603 For i from 0 to (iAutoFields-1)
4604 // it is legal to set the sysfile to 0, this means it has been cleared and is not used
4605 If (AutoIncSysFileFields[i].iFile>0) Begin
4606 // we assume both the fields are valid and that they've already been tested when added
4607 Get_Field_Value AutoIncSysFileFields[i].iFile AutoIncSysFileFields[i].iField to nNum
4608 Move (nNum+1) to nNum
4609 Set_Field_Value AutoIncSysFileFields[i].iFile AutoIncSysFileFields[i].iField to nNum
4610 Set_Field_Value iDestFile AutoIncFields[i] to nNum
4611 SaveRecord AutoIncSysFileFields[i].iFile
4612 End
4613 Loop
4614 End
4615 End
4616
4617 End_Procedure
4618
4619 //************************************************************************//
4620 // Procedure Save_main_File //
4621 // Augmented to fix a bug in the data-set C code. When a record is saved //
4622 // as part of a delete operation OnNewCurrentRecord is not called. It //
4623 // should be. We will do this in flex code for now. //
4624 //************************************************************************//
4625 { MethodType=Event NoDoc=True }
4626 Procedure Save_Main_File
4627 RowId riRec
4628 Integer iRec iMain
4629 Boolean bRecnumTable
4630 Forward Send Save_main_File
4631 If Operation_Mode eq MODE_DELETING Begin // during a delete the crnt
4632 Get CurrentRowId to riRec // rec of parents do not change
4633 Send OnNewCurrentRecord riRec riRec // so old and new are the same.
4634 // for backwards compatibility reasons, we also send new_current_record if appropriate
4635 Get Main_file to iMain
4636 Get_Attribute DF_FILE_RECNUM_TABLE of iMain to bRecnumTable
4637 If (bRecnumTable) begin
4638 Get_field_value iMain 0 to iRec
4639 Send New_Current_Record iRec iRec
4640 end
4641 end
4642 End_Procedure // Save_main_File
4643
4644
4645 //************************************************************************//
4646 // Procedure Clear_main_File //
4647 // Augmented to not clear if a system-file. The auto-latching of views //
4648 // may cause a sys file DD to get cleared. This corrects this. This really//
4649 // belongs in Data_set (C) but we will not risk this for now. //
4650 //************************************************************************//
4651
4652 { MethodType=Event NoDoc=True }
4653 Procedure Clear_Main_File
4654 Integer iFile iIsSys
4655 Get Main_File to iFile
4656 If iFile Begin
4657 Get_Attribute DF_FILE_IS_SYSTEM_FILE of iFile to iIsSys
4658 If iIsSys Procedure_Return
4659 End
4660 Forward Send Clear_main_file
4661 End_Procedure // Clear_main_file
4662
4663 //************************************************************************//
4664 // Procedure Find Mode Index //
4665 // Executes a request_find on the mainfile. This is easier that having to //
4666 // pass file number all the time. Useful for batch operations. //
4667 // If Index is 0, use find_by_recnum (it handles a recnum of 0 better) //
4668 //************************************************************************//
4669
4670 Procedure Find integer iMode integer iIndex
4671 integer iFile
4672 Integer iRec
4673 get Main_file to iFile
4674 if (iIndex<>0 OR iMode<>EQ) ;
4675 Send request_find iMode iFile iIndex
4676 else begin
4677 // this would never happen with row ID
4678 Get_Field_Value iFile 0 to iRec // get recnum value
4679 Send find_by_recnum iFile iRec
4680 end
4681 End_procedure
4682
4683 //************************************************************************//
4684 // Procedure Request_Clear //
4685 // Procedure Request_Clear_All //
4686 // So many people make the mistake of using requeset_clear and request_ //
4687 // clear_all that will support these are alteratives to clear and //
4688 // clear_all. The preferred messages remain Clear and Clear_all. //
4689 // This would not work if you nested DEOs within DSOs (no-one does). //
4690 //************************************************************************//
4691
4692 { Obsolete=True }
4693 Procedure Request_Clear
4694 Send Clear
4695 End_Procedure
4696
4697 { Obsolete=True }
4698 Procedure Request_Clear_All
4699 Send Clear_All
4700 End_Procedure
4701
4702 // *****************************************************//
4703 // we want changed_state to always go through the
4704 // Record_buffer object. From there it is sent to
4705 // here. So if state or RB does not match we must
4706 // send to the RB object...it will delegate to here
4707 // *****************************************************//
4708
4709 { MethodType=Property NoDoc=True }
4710 { PropertyType=Boolean }
4711 Procedure set Changed_State Integer bState
4712 integer hRB
4713 Move (record_buffer(self)) to hRB
4714 if (hRB AND changed_state(hRB)<>bState) ;
4715 set changed_state of hRB to bState
4716 else ;
4717 forward set changed_state to bState
4718 End_Procedure
4719
4720 // **********************************************//
4721 // this lets us use the new attach logic
4722 // **********************************************//
4723
4724 { MethodType=Event }
4725 Procedure Attach_Main_File
4726 If (pbDDAttach(self)) Send DDAttach // new improved attach logic
4727 Else Forward Send Attach_Main_File // old attach command.
4728 End_procedure
4729
4730 // This is a smarter attach than the normal attach command. It only attaches data from a parent
4731 // if 1) the DDO parent is connected to the structure and 2) if there is a record to attach. It will
4732 // not attach empty records into a child. This should make the finding (and saving) more sensible when
4733 // partial DD structures are used. For example, often a report does not all of the parent DDOs - however if
4734 // they are not provided, finding can get messed up because blank data is being moved into the child before a
4735 // find. This has been a problem since 3.0. This should just make it go away.
4736
4737 { Visibility=Private }
4738 Procedure DDAttach
4739 integer iNumFields iFile iField iRelFile iRelField iType
4740 integer iServerCount iServer bOk bChanged iStat
4741 number nValue
4742 string sValue
4743 Date dValue
4744 DateTime dtValue
4745
4746 Get data_set_server_count to iServerCount
4747 // short cut...no servers, no attach
4748 If (iServerCount=0) Procedure_return
4749
4750 Get Main_File to iFile
4751 Get_Attribute DF_FILE_NUMBER_FIELDS of iFile to iNumFields
4752 for iField from 1 to iNumFields
4753 Get_Attribute DF_FIELD_RELATED_FILE of iFile iField to iRelFile
4754 If (iRelFile>0) Begin
4755 // only attach if parent server exists
4756 Move 0 to iServer
4757 Repeat
4758 Move (Main_file(data_set_server(self,iServer))=iRelFile) to bOk
4759 increment iServer
4760 Until (bOk OR iServer=iServerCount)
4761 // before we attach check if Find mode and relfile is new and unchanged..if so skip.
4762 If (bOK AND Operation_mode=MODE_FINDING) Begin
4763 Get_Attribute DF_FILE_STATUS of iRelFile to iStat
4764 Get_Attribute DF_FILE_CHANGED of iRelFile to bChanged
4765 Move (iStat<>DF_FILE_INACTIVE OR bChanged) to bOk
4766 end
4767 If bOk Begin
4768 Get_Attribute DF_FIELD_RELATED_FIELD of iFile iField to iRelField
4769 Get_Attribute DF_FIELD_TYPE of iFile iField to iType
4770 Case Begin
4771 Case (iType=DF_BCD)
4772 Get_Field_Value iRelFile iRelField to nValue
4773 Set_Field_Value iFile iField to nValue
4774 Case Break
4775 Case (iType=DF_DATE)
4776 Get_Field_Value iRelFile iRelField to dValue
4777 Set_Field_Value iFile iField to dValue
4778 Case Break
4779 Case (iType=DF_DATETIME)
4780 Get_Field_Value iRelFile iRelField to dtValue
4781 Set_Field_Value iFile iField to dtValue
4782 Case Break
4783 Case Else
4784 Get_Field_Value iRelFile iRelField to sValue
4785 Set_Field_Value iFile iField to sValue
4786 Case End
4787 end
4788 end
4789 Loop
4790 End_procedure
4791
4792 //************************************************************************//
4793 // Procedure Field_Mask_Changed //
4794 // Notify all DEOs that a mask has changed. //
4795 // this message is sent by set Field_Mask //
4796 //************************************************************************//
4797
4798 { Visibility=Private }
4799 Procedure Field_Mask_Changed Integer iField string sMask
4800 Integer i iDEOs iDEO
4801 Integer iMain_File
4802 Get Main_File to iMain_File
4803 Get Data_Set_User_Interface_Count to iDEOs
4804 Decrement iDEOs
4805 For i from 0 to iDEOs
4806 Get Data_Set_User_Interface i to iDEO
4807 If (Extended_DEO_State(iDEO)) ;
4808 Send File_Field_Mask_Changed to iDEO ;
4809 iMain_File iField sMask
4810 Loop
4811 End_Procedure
4812
4813 //************************************************************************//
4814 // Procedure Field_Label_Changed //
4815 // Notify all DEOs that a label has changed. //
4816 // This message is sent by Set Field_Label_long & Field_Label_Short //
4817 //************************************************************************//
4818
4819 { Visibility=Private }
4820 Procedure Field_label_Changed Integer iField boolean bLong string sLabel
4821 Integer i iDEOs iDEO
4822 Integer iMain_File
4823 Get Main_File to iMain_File
4824 Get Data_Set_User_Interface_Count to iDEOs
4825 Decrement iDEOs
4826 For i from 0 to iDEOs
4827 Get Data_Set_User_Interface i to iDEO
4828 If (Extended_DEO_State(iDEO)) ;
4829 Send File_Field_Label_Changed to iDEO ;
4830 iMain_File iField bLong sLabel
4831 Loop
4832 End_Procedure
4833
4834 //************************************************************************//
4835 // Procedure Field_Options_Changed //
4836 // Notify all DEOs that a field option has changed. //
4837 // This message is sent by Set Field_Option //
4838 //************************************************************************//
4839
4840 { Visibility=Private }
4841 Procedure Field_Option_Changed Integer iField Integer iOptions Boolean bClear
4842 Integer i iDEOs iDEO
4843 Integer iMain_File
4844 Get Main_File to iMain_File
4845 Get Data_Set_User_Interface_Count to iDEOs
4846 Decrement iDEOs
4847 For i from 0 to iDEOs
4848 Get Data_Set_User_Interface i to iDEO
4849 If (Extended_DEO_State(iDEO)) ;
4850 Send File_Field_Option_Changed of iDEO ;
4851 iMain_File iField iOptions bClear
4852 Loop
4853 End_Procedure
4854
4855
4856 //************************************************************************//
4857 // Procedure Set Field_option and File_Field_Option //
4858 // Procedure Set Field_option_clear and File_Field_Option_Clear //
4859 // Procedure Set Field_option_toggle and File_Field_Option_toggle //
4860 // //
4861 // Set, clear or toggle a field option //
4862 // Multiple options can be passed as an expression //
4863 // (e.g. Set Field_option 2 (dd_Retain IOR dd_NoEnter). //
4864 // Unlike set Field_options this notifies DEOs of changes //
4865 //************************************************************************//
4866
4867 // supports setting and clearing. e.g.:
4868 // Set Field_Option Field Customer.Name DD_NoEnter to True
4869 // This new syntax is now the recommended syntax but the older syntax without
4870 // the last parameter is supported (where true is the default). The old syntax is
4871 // only supported for compatibility. This means that Field_Option_Clear should
4872 // also be replaced with Field_Option
4873 { MethodType=Property }
4874 Procedure Set Field_Option Integer iField Integer iOption Boolean bSet
4875 Boolean bSetTrue
4876 Move (If(num_arguments>2, bSet, True)) to bSetTrue // support for old deprecated syntax
4877 If bSetTrue Begin
4878 Set Field_options iField to iOption
4879 End
4880 Else Begin
4881 Set Field_options iField to DD_CLEAR_FIELD_OPTIONS iOption
4882 End
4883 If (Data_Set_User_Interface_Count(Self)) Begin
4884 Send Field_Option_Changed iField iOption (not(bSetTrue))
4885 End
4886 end_procedure
4887
4888 { MethodType=Property }
4889 Procedure Set File_Field_Option Integer iFile Integer iField Integer iOption Boolean bSet
4890 handle hoDD
4891 Boolean bSetTrue
4892 Move (If(num_arguments>3, bSet, True)) to bSetTrue // support for old deprecated syntax
4893 Get Data_set iFile to hoDD
4894 If hoDD Begin
4895 Set Field_Option of hoDD iField iOption to bSetTrue
4896 End
4897
4898 end_procedure
4899
4900 { Obsolete=True }
4901 Procedure Set Field_Option_Clear Integer iField Integer iOptions
4902 Set Field_Option iField iOptions to False
4903 //Set Field_options iField to DD_CLEAR_FIELD_OPTIONS iOptions
4904 //If (Data_Set_User_Interface_Count(self)) ;
4905 // Send Field_Option_Changed iField iOptions 1
4906 end_procedure
4907
4908 { Obsolete=True }
4909 Procedure Set File_Field_Option_Clear Integer iFile Integer iField Integer iOptions
4910 Set File_Field_Option iFile iField iOptions to False
4911 //handle hoDD
4912 //Get Data_set iFile to hoDD
4913 //If hoDD ;
4914 // Set Field_Option_Clear of hoDD iField to iOptions
4915 end_procedure
4916
4917 { Obsolete=True }
4918 Procedure Set Field_Option_Toggle integer iField Integer iOption
4919 Integer iOldOption
4920 Get Field_Options iField to iOldOption
4921 // if old and new have overlapping bits, we assume clear
4922 Set Field_Option iField iOption to ((iOldOption iand iOption)=0)
4923 //If (iOldOption IAND iOption) ; // if the old and new have overlapping bits, we assume we will clear
4924 // Set Field_Option_Clear iField to iOption // old and new are same, so we clear
4925 //else ;
4926 // Set Field_Option iField to iOption // old and new are not same, so we set
4927 end_procedure
4928
4929 { Obsolete=True }
4930 Procedure Set File_Field_Option_Toggle Integer iFile Integer iField Integer iOption
4931 handle hoDD
4932 Get Data_set iFile to hoDD
4933 If hoDD ;
4934 Set Field_Option_Toggle of hoDD iField to iOption
4935 end_procedure
4936
4937 // Field_Index
4938 // File_Field_Index
4939 //
4940 // This returns the main index for a field. This replaces the DSO message Field_Main_index which
4941 // should no longer be used by DDOs. The old message has the problem that the DDO or DSO using
4942 // this message may not be the owner of the field. So augmenting the owner DDO did not insure that
4943 // all requests for this index would go through it. Now you can augment Field_Index and always
4944 // be sure that any DDO requesting an index for a file (via file_field_index) will always go to
4945 // the owner object.
4946
4947 { MethodType=Property }
4948 function Field_Index integer iField returns integer
4949 integer iFile iIndex iOrder
4950 // ordering takes precendence
4951 get ordering to iOrder
4952 if (iOrder>=0);
4953 move iOrder to iIndex //ordering takes precedence over main index
4954 Else Begin
4955 Get Main_file to iFile
4956 get_attribute DF_FIELD_INDEX of iFile iField to iIndex // main index field
4957 if (iIndex=0 AND iField>0) ; // If field is not recnum and there is no index, the
4958 move -1 to iIndex // field has no main index
4959 end
4960 function_return iIndex
4961 end_function
4962
4963 // In all cases, this message should be sent instead of Field_Main_Index. If
4964 // augmentation was used in Field_Main_Index, use Field_Index to insure the owner object
4965 // is called.
4966
4967 { MethodType=Property Visibility=public }
4968 function File_Field_Index integer iFile integer iField returns integer
4969 integer iIndex
4970 handle hoDD
4971 Get Data_set iFile to hoDD
4972 If (hoDD) ;
4973 Get Field_Index of hoDD iField to iIndex
4974 else ;
4975 Move -1 to iIndex
4976 function_return iIndex
4977 End_Function
4978
4979 // 12/1 change: Make sure all of the major DD operations update the DD with the value in
4980 // the focus field. After the actual find, save, clar or delete, the DD buffer contains information that
4981 // is not yet reflected in the DEOs (before refresh is called) we want to make sure that we
4982 // don't try to get data from the DEO. Get Field_Current_Value now checks if operation_mode is
4983 // non-zero. If it is, it always gets from the DD buffer.
4984
4985 { NoDoc=True }
4986 Procedure Clear
4987 If (OPERATION_MODE=MODE_WAITING) Begin
4988 Send Update_Focus_Field_For_Operation MODE_CLEARING
4989 End
4990 Forward Send Clear
4991 End_Procedure
4992
4993 { NoDoc=True }
4994 Procedure Clear_All
4995 If (OPERATION_MODE=MODE_WAITING) Begin
4996 Send Update_Focus_Field_For_Operation MODE_CLEARINGALL
4997 End
4998 Forward Send clear_all
4999 End_Procedure
5000
5001 { NoDoc=True }
5002 Procedure Request_Assign Integer iFile
5003 If (OPERATION_MODE=MODE_WAITING) Begin
5004 Send Update_Focus_Field_For_Operation MODE_FINDING
5005 End
5006 If (num_arguments=0) Begin
5007 Forward Send Request_Assign
5008 End
5009 Else Begin
5010 Forward Send Request_Assign iFile
5011 End
5012End_Procedure
5013
5014
5015 { NoDoc=True }
5016 Procedure Find_By_Recnum Integer iFile Integer iRecord
5017 Send Update_Focus_Field_For_Operation MODE_FINDING
5018 Forward Send Find_By_Recnum iFile iRecord
5019 End_Procedure
5020
5021 { NoDoc=True }
5022 Procedure FindByRowId Integer iFile RowID riRowId
5023 Send Update_Focus_Field_For_Operation MODE_FINDING
5024 Forward Send FindByRowId iFile riRowId
5025 End_Procedure
5026
5027 { NoDoc=True }
5028 Procedure Request_Find Integer eFindMode Integer iFile Integer iIndex
5029 If (OPERATION_MODE=MODE_WAITING) Begin
5030 Send Update_Focus_Field_For_Operation MODE_FINDING
5031 End
5032 Forward Send Request_Find eFindMode iFile iIndex
5033 End_Procedure
5034
5035 { NoDoc=True }
5036 Procedure Request_Superfind Integer eFindMode Integer iFile Integer iField
5037 If (OPERATION_MODE=MODE_WAITING) Begin
5038 Send Update_Focus_Field_For_Operation MODE_FINDING
5039 End
5040 Forward Send Request_Superfind eFindMode iFile iField
5041 End_Procedure
5042
5043End_Class
5044
5045//************************************************************************//
5046// This message will be send as a notification message from an //
5047// Extended_Data_Set whenever a fieldvalue has been changed. //
5048// It has been defined FOR cUIObject or Desktop here so that attached //
5049// DEO which do not know anything about Extended_Data_Sets don't get //
5050// frustrated. //
5051// All focusable objects and DEOs must understand this. This should be //
5052// changed at some point in the future. //
5053//************************************************************************//
5054
5055{ MethodType=Property Visibility=Private }
5056Function Extended_DEO_State FOR cUIObject Returns integer
5057End_function
5058
5059
5060// this command is now obsolete. use Set Field_auto_increment
5061#COMMAND DEFINE_AUTO_INCREMENT R "TO" R
5062 #PUSH !h
5063 #SET H$ !1
5064 Set Auto_Increment_Source_File to |CI!h
5065 #SET H$ %!1
5066 Set Auto_Increment_Source_Field to |CI!h
5067 #SET H$ %!3
5068 Set Auto_Increment_Dest_Field to |CI!h
5069 #POP H$
5070#ENDCOMMAND
5071