Module Dfenrad.pkg
1// 07/23/96 JJT - New Class names
2// 03/28/97 JJT - Added Top_of_Panel, Bottom_of_Panel Support
3// (else if radio first DEO it crashes)
4// 05/01/97 JJT - Force Add_radio_item to always use a third param.
5// Without this non-DD radios did not work. If no
6// third param, use a zero for the value
7// 11/07/97 JJT - add Item_count function (ret=1) to mixin. Db class
8// is expected to understand this.
9// 2/26/2002 JJT - 8.2 clean up (indirect_file, local, self, etc.)
10Use LanguageText.pkg
11use windows.pkg
12Use Nesting.pkg
13Use Navigate.pkg
14Use Server.pkg
15use Verify.pkg //include Verification support module
16use findedit.pkg //include Finding/Editing support module
17use refmodes.pkg // refresh mode constants
18
19#IFDEF CD_Code_Display_Code
20#ELSE
21Enum_List
22 Define CD_Code_Display_Code
23 Define CD_Code_Display_Description
24 Define CD_Code_Display_Both
25End_Enum_List
26#ENDIF
27
28Class DFEntry_Radio_Group_Mixin is a Mixin
29
30 IMPORT_CLASS_PROTOCOL Nesting_Mixin
31 IMPORT_CLASS_PROTOCOL Navigate_Mixin
32 IMPORT_CLASS_PROTOCOL Server_Mixin
33 IMPORT_CLASS_PROTOCOL Verify_Mixin
34 IMPORT_CLASS_PROTOCOL Find_Edit_Mixin
35
36 { Visibility=Private }
37 procedure Define_DFEntry_Radio_Group_Mixin
38 send define_nesting //invoke DEO nesting standard support constructor
39 send define_navigation //invoke DEO navigation standard support constructor
40 send define_server //invoke Server support constructor
41 send define_verify //invoke Verification support constructor
42 send define_find_edit //invoke finding/editing support constructor
43
44 { EnumList="CD_Code_Display_Code, CD_Code_Display_Description, CD_Code_Display_Both" }
45 { Category=Behavior }
46 Property Integer Code_Display_Mode CD_Code_Display_Description
47
48 { Visibility=Private }
49 Property integer Private.Data_File 0
50
51 { Visibility=Private }
52 Property integer Private.Data_Field 0
53
54 { Visibility=Private }
55 Property integer Private.Zoom_Object 0
56
57 { Visibility=Private }
58 Property integer Private.Prompt_Object 0
59
60 { Visibility=Private }
61 Property integer Retain_State FALSE // just like items
62
63 { Visibility=Private }
64 Property integer NoPut_State FALSE // just like items
65
66 { Category=Data }
67 Property String Default_Value '' // when cleared..find it
68
69 { Visibility=Private }
70 Property Integer Entry_Values 0
71
72 // following 6 messages added to 8.2 to properly support item entry,exit and validate
73 { Visibility=Private }
74 Property integer Private.item_entry_msg 0 // created to support item_entry_msg
75
76 { Visibility=Private }
77 Property integer Private.item_Validate_msg 0 // created to support item_exit_msg
78
79 { Visibility=Private }
80 Property integer Private.item_exit_msg 0 // created to support item_validate_msg
81
82 { Category=Behavior }
83 property integer Object_Item_Entry_Exit True // if false, entry and exit messages are not used
84 { Category=Behavior }
85 property integer Object_Validation True // if false, object validation is skipped
86 { Category=Behavior }
87 { PropertyType=Boolean }
88 property Integer Validate_All_Items_State False // when true validation is part of validate_items (aka a save)
89
90 #PUSH !Zb // save current definition state
91 #SET ZB$ -1 // Object will append to parent
92 DEFINE C_NUM$EV$COLS for 1 // number of cols in the ev array (used to be 2, now is 1)
93 Object EV is an Array // keeps values of database
94 End_Object // items for each radio selection
95 #POP ZB$ //restore obj_flag
96 Set entry_values to (Ev(self))
97
98 // These will get used by child radio buttons and will delegate to
99 // here.
100 on_key kPrompt Send Prompt
101 on_key kZoom Send Zoom
102 on_key kBegin_of_Data Send Beginning_of_Data
103 on_key kClear Send Request_Clear
104 on_key kClear_All Send Request_Clear_All
105 on_key kDelete_Record Send Request_Delete
106 on_key kEnd_of_Data Send End_of_Data
107 on_key kFind Send Find_GE
108 on_key kFind_Next Send Find_Next
109 on_key kFind_Previous Send Find_Previous
110 on_key kSave_Record Send Request_Save
111 on_key kSuper_Find Send SuperFind
112 on_key kSuper_Find_Next Send SuperFind_Next
113 on_key kSuper_Find_Previous Send SuperFind_Previous
114 on_key kBegin_of_Panel Send Beginning_of_Panel
115 on_key kCancel Send Request_Cancel
116 on_key kEnd_of_Panel Send End_of_Panel
117 on_key kExit_Function Send Exit_Function
118 on_key kSwitch_Panel Send Switch_Next_Group
119 on_key kSwitch_Panel_Back Send Switch_Prior_Group
120
121 end_procedure
122
123 { MethodType=Property Visibility=Private }
124 Function Filled_Count returns integer
125 integer iCnt
126 Get Item_count of (Entry_Values(self)/C_NUM$EV$COLS) to iCnt
127 Function_return (iCnt)
128 End_Function
129
130 { MethodType=Event }
131 Procedure Fill_List
132 End_procedure
133
134 procedure Zoom
135 integer obj#
136 get Zoom_object to obj#
137 if obj# send POPUP to obj#
138 end_procedure
139
140 procedure Prompt
141 integer obj#
142 get Prompt_object to obj#
143 if obj# send POPUP to obj#
144 end_procedure
145
146 { MethodType=Property }
147 { InitialValue=0 }
148 { ItemParameter=1 }
149 { Category=Appearance }
150 Procedure Set Prompt_Object Integer item# Integer Obj#
151 set Private.Prompt_Object to Obj#
152 End_Procedure
153
154 { MethodType=Property }
155 Function Prompt_Object Integer Item# Returns Integer
156 Function_Return (Private.Prompt_Object(self))
157 End_Function // Prompt_object
158
159 { MethodType=Property }
160 { InitialValue=0 }
161 { ItemParameter=1 }
162 { Category=Appearance }
163 Procedure Set Zoom_Object Integer iItem Handle hoPrompt
164 set Private.Zoom_Object to hoPrompt
165 End_Procedure
166
167 { MethodType=Property }
168 Function Zoom_object Integer iItem Returns Handle
169 Function_Return (Private.Zoom_Object(self))
170 End_Function // Prompt_object
171
172 { MethodType=Property }
173 Function Data_File Integer Itm# returns Integer
174 function_return (Private.Data_File(self))
175 End_Function
176
177 { MethodType=Property }
178 Procedure Set Data_File integer item# integer File#
179 Set Private.Data_File to File#
180 End_procedure
181
182 { MethodType=Property }
183 Function Data_Field Integer Itm# returns Integer
184 function_return (Private.Data_Field(self))
185 End_Function
186
187 { MethodType=Property }
188 Procedure Set Data_Field integer item# integer Field#
189 Set Private.Data_Field to Field#
190 End_procedure
191
192
193 //
194 // Clear radio object. All items select state to false
195 // and set current item to default.
196 // Pass: Dflt - value to set
197 // RetainIt - if TRUE retain the current value
198 //
199 { Visibility=Private }
200 procedure Clear_Radio String Dflt Integer RetainIt
201 integer Srvr file# oldSt
202 // if we don't check for retains or it we have a retain we do clear
203 If (Filled_count(self)=0) procedure_Return
204 If Not RetainIt Begin
205 If Dflt ne '' ;
206 Send Display_Description Dflt // if we have a default value...set it
207 Else ;
208 Set Current_Radio to 0 // set new current
209 End
210 // even if retain is true we will set changed_state to false.
211 // Entry_update has been made ever so much more clever so it
212 // will know how to move this value in.
213 Set Changed_State to FALSE // always default to no change
214 //
215 // only do entry-defaults if a dso is used and the
216 // dso's main-file was cleared.
217 Get Server to srvr
218 if srvr begin
219 get main_file of srvr to file#
220 is_file_included file# 0
221 [found] begin
222 Get Change_Disabled_State to OldSt
223 Set Change_Disabled_State to TRUE // for Entry_defaults
224 Send Entry_Defaults
225 Set Change_Disabled_State to OldSt
226 end
227 end
228 end_procedure
229
230 { MethodType=Event }
231 Procedure Entry_Defaults
232 End_procedure
233
234 //
235 // created for EntItem simulation: file# <> 0 means use Cleared-array
236 //
237 { Visibility=Private }
238 procedure Entry_Clear integer file#
239 Indicate Found as File# eq 0
240 [Not Found] Is_file_included (Data_File(self,0)) 0 //0=clear arry
241 [Found] Send Clear_Radio (Default_Value(self)) ;
242 (Retain_State(self))
243 end_procedure
244
245 //
246 // created for EntItem simulation:
247 //
248 { Visibility=Private }
249 procedure Entry_Clear_All integer file#
250 Send Entry_Clear File#
251 end_procedure
252
253 { MethodType=Property Visibility=Private }
254 Procedure SET Entry_Value Integer Itm String Val
255 If Itm eq CURRENT Get Current_Item to Itm
256 Set Value of (Entry_Values(self)) (Itm*C_NUM$EV$COLS) to Val
257// because we are not using get/set Record_value we don't need *2
258// Set Value of (Entry_Values(self)) Item (Itm*2) to Val
259 End_Procedure
260
261 { MethodType=Property Visibility=Private }
262 Function Entry_Value Integer Itm Returns String
263 If Itm eq CURRENT Get Current_Item to Itm
264 Function_Return (Value(Entry_Values(self),Itm*C_NUM$EV$COLS))
265// because we are not using get/set Record_value we don't need *2
266// Function_Return (Value(Entry_Values(self),Itm*2))
267 End_Function
268
269// This has never been used internally and it is private. It should be safe to remove it.
270// //Doc/ MethodType=Property Visibility=Private
271// Procedure SET Record_Value Integer Itm Integer iRec
272// If Itm eq CURRENT Get Current_Item to Itm
273// Set Value of (Entry_Values(self)) Item (Itm*2+1) to iRec
274// End_Procedure
275
276// //Doc/ MethodType=Property Visibility=Private
277// Function Record_Value Integer Itm Returns Integer
278// If Itm eq CURRENT Get Current_Item to Itm
279// Function_Return (Value(Entry_Values(self),Itm*2+1))
280// End_Function
281
282
283 //
284 // created for EntItem simulation and Server support:
285 // if file# = 0, display only if Target_File is in Done-array
286 // else display only if file# = Target_File
287 //
288 { Visibility=Private }
289 procedure Entry_Display integer file# integer flag
290 integer dFile dField
291 String sVal
292 get Data_File to dFile
293 get Data_Field to dField
294 //
295 // We will display this if the following conditions exist:
296 // passed file is 0 and the target file is in the done array <or>
297 // passed file= target File or flag = true)
298 if file# eq 0 is_file_included dFile 1 // set found if in done array
299 else indicate found as (file# = dFile OR flag = TRUE)
300 [Found] begin
301 Get_Field_Value dFile dField to sVal
302 Send Display_Description sVal // finds radio item and sets it
303 Set Changed_State to False
304 End
305 End_procedure
306
307 //
308 // Set the radio item to the value passed. If not found, leave item where
309 // it is with nothing selected.
310 //
311 { Visibility=Private }
312 Procedure Display_Description String DataVal
313 integer Itm
314 // get position of passed data value in the radio list
315 Get Data_to_description_Item DataVal to Itm
316 If Itm GE 0 Begin
317 Set Current_Radio to Itm // this sets the current item
318 End
319 End_Procedure // Display_Description
320
321 // Pass data value and return the position in the radio. -1 if not found
322 // If list is sorted, the entry_value items and the list items will not
323 // be in the same order. Each radio item's aux_value contains the position
324 // in entry_value list (the ev list does not change).
325 //
326 { Visibility=Private }
327 Function Data_to_Description_item String sValue returns integer
328 integer Itms Itm RadioItem SrchItm
329 Move -1 to RadioItem
330 Get Filled_count to Itms
331 Decrement Itms
332 // first find a match for this value.
333 For Itm from 0 to Itms
334 If (Entry_Value(self,Itm)=sValue) ;
335 Move Itm to RadioItem
336 Until RadioItem ne -1
337 //// if found and the list is sorted we must find the actual position
338 //// in the radiolist. Aux-value has the back pointer
339 //If (RadioItem>=0 AND Sort_State(self)) Begin
340 // Move RadioItem to SrchItm
341 // Move -1 to RadioItem
342 // For Itm from 0 to Itms
343 // If (Aux_Value(self,Itm)=SrchItm) ;
344 // Move Itm to RadioItem
345 // Until RadioItem ne -1
346 //End
347 Function_Return RadioItem
348 End_Function // Data_to_Description_Item
349
350 // Find the data value of the passed list item
351 //
352 { MethodType=Property Visibility=Private }
353 Function Item_Data_Value integer iItem returns String
354 //Get Aux_Value item iItem to iItem // pointer to the data list
355 Function_Return (Entry_Value(self,iItem))
356 End_Function
357
358
359 // Find the data value of the current selected radio item
360 //
361 { MethodType=Property Visibility=Private }
362 Function Current_Item_Data_Value returns String
363 integer iItem
364 // we support single, auto and no select. Logically no and auto
365 // are the same ...always the current item. Single can have an
366 // item or no item at all...in which case return ''
367 Get Current_Radio to iItem
368 Function_Return (Item_Data_Value(self,iItem))
369 End_Function
370
371 //
372 // created for EntItem simulation and Server support
373 //
374 // Normally entry_update gets called during saves and finds. When
375 // Save: file# = 0 flag = 3
376 // Find: file# <> 0 flag = 1
377 //
378 // Allow Update Rules:
379 // if Save update (file#=0, flag=3)
380 // Allow Update if not noput and Target_File is in Done-array
381 // and (new record or changed_state).
382 // else if Find_Update (file#=Target_File, Flag=1) or misc (file#=0)
383 // Allow Update
384 //
385 // Modified so that an unchanged item is moved to the field if
386 // the main file is a new record.
387 //
388 { Visibility=Private }
389 procedure Entry_Update integer file# integer flag
390 integer dFile dField C_Item Srvr# ok
391 integer iStat
392 String sValue
393 Get Server to Srvr#
394 Get Data_File to dFile
395 Get Data_Field to dField
396 if (file# = 0 AND flag = 3) Begin
397 // this should be a save a record update.check for no put
398 If (noput_state(self)) Indicate Found False
399 Else is_file_included dFile 1
400 End
401 else indicate FOUND as (file# = dFile OR file# = 0) // new change
402 // **JJT**(2) I think this was wrong. Flag is used to figure if
403 // item_changed_state should be ignored. I don't think it is meant
404 // to override the file param.
405 //else indicate FOUND as (file# = dFile OR flag = TRUE OR file# = 0)
406 Move (found) to OK
407 If Ok Begin
408 // If flag<>do it always and no change we normally do not update.
409 // However, if this is a new record we will move it
410 if ( Flag<>1 and changed_State(self)=0) Begin
411 Get_Attribute DF_FILE_STATUS of dfile to iStat
412 If (iStat<>DF_FILE_INACTIVE) Move 0 to Ok // old record...not ok
413 End
414 if Ok Begin
415 Get Current_Item_Data_Value to sValue
416 Set_Field_Value dFile dField to sValue
417 end
418 End
419 end_procedure
420
421 { MethodType=Event Visibility=Private }
422 procedure Refresh integer notifyMode
423 if notifymode eq MODE_CLEAR_ALL send Entry_Clear_All 1
424 else Begin
425 send Entry_Clear 1
426 send Entry_Display 0 0
427 end
428 end_procedure
429
430 // Augment to send Initialize_list (for dynamic lists)
431 //
432 { MethodType=Event NoDoc=True }
433 Procedure Activating
434 Integer rVal
435 Forward Get MSG_Activating to RVal
436 If not rVal Send Initialize_list
437 Procedure_Return RVal
438 End_Procedure // End_construct_Object
439
440 // Augment to delete the entry_value data as well.
441 //
442 { NoDoc=True }
443 Procedure Delete_Data
444 integer obj#
445 move (Entry_Values(self)) to obj#
446 // we do this to get around program close down problems. Delete_data
447 // gets called by destroy-object.
448 if obj# ne 0 send delete_Data to obj#
449 End_Procedure // Delete_Data
450
451 // If there are no items send fill_list.
452 // Also check to see of a scroll bar is needed. Display scroll bar if it
453 // is.
454 //
455 // Note If you want to rebuild an item list you should:
456 // Send Delete_Data
457 // Send Initialize_List
458 //
459 // Do not Send Fill_List directly (it won't handle scroll bar right)
460 //
461 { MethodType=Event Visibility=Private }
462 procedure Initialize_List
463 integer Lmt Itm
464 if (Filled_count(self)<1) Begin
465 send fill_list
466 end
467 end_procedure
468
469 // Get/Set item_chagned_state. These messages should not affect our radio
470 // list. They should redirect to changed_state
471 //
472 { MethodType=Property }
473 Procedure Set Item_Changed_State Integer iItem Integer iState
474 if iState Set Changed_State to iState
475 End_Procedure
476
477 { MethodType=Property }
478 Function Item_Changed_State Integer iItem returns Integer
479 Function_Return (Changed_State(self))
480 End_Function
481
482 //
483 // Augment to support various description/data Display formats.
484 //
485 { Visibility=Private }
486 Function Code_Description_Value String DescVal String DataVal returns string
487 Integer Mode
488 Get Code_Display_Mode to mode
489 If mode eq CD_CODE_DISPLAY_CODE ;
490 Move DataVal to DescVal
491 Else If mode eq CD_CODE_DISPLAY_BOTH ;
492 Move (DataVal * "-" * DescVal) to DescVal
493 Function_Return DescVal
494 End_Function // Code_Description_Value
495
496
497 // Message to add radio Items to a list. Similar to Add_Item except
498 // it handles an optional second and third parameter. If no 2nd param the
499 // first is used in its place. If no third param, the record value is
500 // not stored.
501 //
502 // This also keeps track of the readio item's original order in aux_value.
503 // If the radio list is then sorted this provides a pointer from the list
504 // back to the entry_value array (which is not sorted).
505 //
506 // Send Add_Radio_Item Item_Value {Data_Value} {Rec_Value}
507 //
508 Procedure Add_Radio_Item String Descr_value String Data_Value // Integer iRec
509 String dVal
510 Integer itm
511 Get Filled_count to itm // get this before we add the item.
512
513 If (itm=Radio_Count(self)) Begin
514 Error DFERR_PROGRAM C_$TooManyRadioObjects
515 procedure_Return
516 End
517
518 // If one param passed use it for both display and database values
519 If num_arguments le 1 Move Descr_Value to dVal
520 Else Move data_Value to dVal
521 If (Code_Display_Mode(self)=CD_CODE_DISPLAY_CODE) ;
522 Move dVal to Descr_Value
523 Else ;
524 Get Code_Description_Value Descr_Value dVal to Descr_Value
525
526 Set Radio_Value item itm to Descr_Value
527 Set Entry_Value Item itm to dVal
528// remove support for this.. it does not seem to be used
529// if Num_Arguments gt 2 ;
530// Set Record_Value Item itm to iRec
531// Else ; // if no 3rd param, use 0
532// Set Record_Value Item itm to 0
533 End_Procedure
534
535 // FindEdit support behavior
536 //
537 procedure Request_Find integer mode integer entUpdtFlag
538 integer dataFile ser# dfrdState
539 get Data_File to dataFile
540 get Server to ser#
541 get Deferred_State to dfrdState
542
543 //
544 // server augmentation & deferred-state use
545 //
546 if (ser# <> 0 AND dataFile > 0) begin
547 send Item_Find to ser# mode dataFile ;
548 (Data_Field(self,CURRENT)) entUpdtFlag TRUE dfrdState
549 [found] if dfrdState send entry_display 0 0
550 end
551 end_procedure
552
553 //
554 // FindEdit support behavior
555 //
556
557 procedure Request_Superfind integer mode
558 integer obj# datafile
559 get Server to obj#
560 get data_file to datafile
561 //
562 // modification for Server
563 //
564 if datafile gt 0 begin
565 if obj# ne 0 begin
566 indicate err false
567 send Request_SuperFind to obj# mode datafile ;
568 (data_field(self,CURRENT))
569 [not found not err] begin
570 if mode lt 2 error DFERR_FIND_PRIOR_BEG_OF_FILE
571 else error DFERR_FIND_PAST_END_OF_FILE
572 end
573 end
574 end
575 end_procedure
576
577 // Fill_List at end of construct object
578 Procedure End_Construct_Object
579 Forward Send End_Construct_Object
580 Send Initialize_List
581 End_Procedure // End_Construct_Object
582
583 { MethodType=Property}
584 { Visibility=Private }
585 Procedure Set Select_State integer iItem integer iState
586 //
587 End_Procedure // Set Select_State
588
589 { MethodType=Property }
590 Function Select_State integer iItem returns integer
591 Function_Return (Current_Radio(self)=iItem)
592 End_Function // Select_State
593
594 { Visibility=Private }
595 Procedure Bind_Data integer File# Integer Field#
596 Set Data_File to File#
597 Set Data_Field to Field#
598 End_Procedure // Bind_Data
599
600 //
601 // created for Navigation support NoDoc=True
602 //
603 { NoDoc=True }
604 procedure Top_of_Panel
605 if (focus(desktop) <> self) send activate
606 end_procedure
607
608 //
609 // created for Navigation support
610 //
611 { NoDoc=True }
612 procedure Bottom_of_Panel
613 if (focus(desktop) <> self) send activate
614 end_procedure
615
616 // when the DEO attaches to the server it expects item_count to
617 // exist. Return 1, Radios always map to a single data field
618 //
619 { MethodType=Property NoDoc=True }
620 Function Item_Count Returns integer
621 Function_Return 1
622 End_Function
623
624 // added for DEO support. It is always 0
625 { MethodType=Property Visibility=Private }
626 Function Item_Limit Returns Integer
627 Function_Return 0
628 End_Function
629
630 // added for DEO / prototype object support. It is always self
631 { MethodType=Property Visibility=Private }
632 Function ProtoType_Object Returns Integer
633 Function_Return Self
634 End_Function
635
636
637
638
639 // added for 8.2 support. This now allows DD and non DD based radio objects to support
640 // validation, entry and exit messages. This allows support of:
641 //
642 // get/set item_entry_msg
643 // get/set item_exit_msg
644 // get/set item_validate_msg
645 // with DDs these are rarely used.
646
647 { MethodType=Property }
648 Procedure Set Item_Entry_msg Integer iItem Integer hMsg
649 set private.Item_entry_msg to hMsg
650 end_procedure
651
652 { MethodType=Property }
653 Function Item_Entry_msg Integer iItem Returns Integer
654 function_return (private.Item_entry_msg(self))
655 end_procedure
656
657 { MethodType=Property }
658 Procedure Set Item_Exit_msg Integer iItem Integer hMsg
659 set private.Item_exit_msg to hMsg
660 end_procedure
661
662 { MethodType=Property }
663 Function Item_Exit_msg Integer iItem Returns Integer
664 function_return (private.Item_exit_msg(self))
665 end_procedure
666
667 { MethodType=Property }
668 Procedure Set Item_Validate_msg Integer iItem Integer hMsg
669 set private.Item_validate_msg to hMsg
670 end_procedure
671
672 { MethodType=Property }
673 Function Item_Validate_msg Integer iItem Returns Integer
674 function_return (private.Item_validate_msg(self))
675 end_procedure
676
677 // Item_entry/exit/validate are the non DD versions and are probably never called. Lifted from entitem.pkg
678 // Normally, the dd versions of these will get called
679 //
680 { MethodType=Event Visibility=Private }
681 function Item_Entry integer msg# integer item# returns integer
682 integer retVal
683 if not (object_item_entry_exit(self)) function_return 0
684 move 0 to retval
685 if msg# ne 0 get msg# item item# to retVal
686 function_return retVal
687 end_function
688
689 { MethodType=Event Visibility=Private }
690 function Item_Exit integer msg# integer item# returns integer
691 integer retVal
692 if not (object_item_entry_exit(self)) function_return 0
693 move 0 to retval
694 if msg# ne 0 get msg# item item# to retVal
695 function_return retVal
696 end_function
697
698 { MethodType=Event Visibility=Private }
699 function Item_Validate integer msg# integer item# returns integer
700 integer retVal
701 move 0 to retval
702 if msg# ne 0 get msg# item item# to retVal
703 function_return retVal
704 end_function
705
706 Function Exec_Entry Returns Integer
707 integer iFail hMsg
708 get item_entry_msg to hMsg
709 get item_entry hMsg 0 to iFail
710 function_return iFail
711 end_function
712
713 Function Exec_Exit Returns Integer
714 integer iFail hMsg
715 get item_exit_msg to hMsg
716 get item_exit hMsg 0 to iFail
717 function_return iFail
718 end_function
719
720 function Exec_Validate returns integer
721 integer iFail hMsg
722 // object_validation is use to stop an item validate. It is rarely
723 // used but is provided for consistency. Other objects check this property in the runtime
724 If (object_validation(self)) begin
725 get item_Validate_msg to hMsg
726 get item_Validate hMsg 0 to iFail
727 end
728 function_return iFail
729 end_function
730
731 // this is mostly lifted from val_mx.pkg. It's simpler because there is only one item
732 // to validate.
733 //
734 { Visibility=Private }
735 Function Validate_Items integer fg returns integer
736 integer iFail iOldVAI
737 Get Validate_all_Items_State to iOldVAI
738 Set Validate_all_Items_State to true // this indicates that validate is part of save
739 get exec_validate 0 to iFail // simulate a validate item...there is only 1 item
740 Set Validate_all_Items_State to iOldVAI
741 // if validate failed make sure that this object now has the focus.
742 if (iFail AND containsFocus(self)=0) ; // this is a group, see if a child button has the focus
743 send activate_area true //take focus w/out changing current_item
744 function_return iFail
745 End_Function // Validate_items
746
747 // these two functions are called by radio objects when an entering or exting
748 // event for the entire radio group. These trigger exiting and entering messages
749 //
750 { MethodType=Event }
751 Function OnRadioGroupEntering returns integer
752 integer iFail
753 get exec_entry to iFail
754 Function_return iFail
755 end_function
756
757 { MethodType=Event }
758 Function OnRadioGroupExiting returns integer
759 integer iFail
760 get exec_exit to iFail
761 Function_return iFail
762 end_function
763End_Class
764
765
766{ ClassType=Abstract }
767{ HelpTopic=dbRadioGroupDS }
768{ DataBindable=True }
769Class dbRadioGroupDS is a RadioGroup STARTMAC R_EStart
770 // the startmac is used to catch old obsolete code at compiletime
771 procedure Construct_Object
772 forward send construct_object
773 send define_DFEntry_radio_Group_Mixin
774 end_procedure
775
776 IMPORT_CLASS_PROTOCOL DFEntry_Radio_Group_Mixin
777
778End_Class
779
780// This only gets used if you are NOT using DDO support, which is now
781// considered to be obsolete.
782{ ClassType=Abstract Visibility=Private Obsolete=True }
783{ HelpTopic=dbRadioContainerDS }
784Class dbRadioContainerDS is a dbRadioGroupDS
785 Import_Class_Protocol NonVisual_Container_Mixin
786End_Class
787
788
789Use DD_Deomx.pkg // mixin support for dd classes
790use DD_Radmx.pkg // mixin support for exported descriptions
791 // It is important that dd_radmx gets mixed in at the same
792 // level as dd_deommx.
793
794{ DataAware=True }
795{ DesignerClass=cDTRadioGroup }
796{ HelpTopic=dbRadioGroup }
797Class dbRadioGroup is a dbRadioGroupDS
798 Procedure Construct_Object
799 Forward Send Construct_Object
800
801 { Visibility=Private }
802 Property String psToolTip_private ""
803 End_Procedure
804
805 Import_Class_Protocol Extended_DEO_Mixin
806 Import_Class_Protocol Extended_DEO_Status_Help_Mixin
807 Import_Class_Protocol Extended_DEO_Radio_mixin
808 Import_Class_Protocol Extended_DEO_Status_Help_Tooltip_Mixin
809
810
811 // This is only used by the Extended_DEO_Status_Help_Tooltip_Mixin to
812 // set the child radio object's status help.
813 { MethodType=Property }
814 { Category=Appearance }
815 { InitialValue="" }
816 { Visibility=Private }
817 Procedure Set psToolTip String sText
818 // Augmented to set the tooltip of each child radio button
819 String sOldText
820 Handle hToolWnd
821
822 Get psToolTip_private to sOldText
823
824 If (sOldText <> sText) Begin
825 Set psToolTip_private to sText
826 Broadcast Send SetChildToolTip sText
827 End
828 End_Procedure
829
830 { MethodType=Property }
831 Function psToolTip Returns String
832 String sValue
833 Get psToolTip_private to sValue
834 Function_Return sValue
835 End_Function // psToolTip
836End_Class
837
838{ DataAware=True }
839{ HelpTopic=dbRadioContainer }
840Class dbRadioContainer is a dbRadioGroup
841 Import_Class_Protocol NonVisual_Container_Mixin
842End_Class
843
844// used only to catch obsolete object startmac syntax
845#COMMAND R_EStart R
846 FORWARD_BEGIN_CONSTRUCT !1 !2
847 bind_using !2 !3 !4 !5 !6 !7 !8 !9
848#ENDCOMMAND
849