Module entitem.pkg
1//************************************************************************
2//
3// Confidential Trade Secret.
4// Copyright 1987-1992 Data Access Corporation, Miami FL, USA
5// All Rights reserved
6// DataFlex is a registered trademark of Data Access Corporation.
7//
8//
9// $Source: k:\RCS\.\pkg\entitem.pkg,v $
10// $Revision: 1 $
11// $State: Exp $
12// $Author: james $
13// $Date: Apr 01 16:08:48 1997 $
14// $Locker: $
15//
16//
17// $Log: entitem.pkg,v $
18//Revision 2.1 1993/08/25 17:47:39 james
19//Adding new main branch
20//
21//Revision 1.2 1993/04/28 00:20:34 james
22//Initializing 3.04 source code.
23//
24//Revision 1.1 1992/09/08 14:43:04 james
25//Initial revision
26//
27//Revision 1.4 92/06/17 23:57:36 lee
28//added object_item_entry_exit property to disable item entry/exit messages
29//during scroll.
30//
31//Revision 1.3 92/05/14 16:45:57 SWM
32//Updated Copyright slug.
33//
34//Revision 1.2 92/03/09 19:01:29 james
35//Added #CHKSUB directive to insure source
36//only compiled with correct revision of
37//compiler.
38//
39//Revision 1.1 91/10/23 10:20:28 elsa
40//Initial revision
41//
42//************************************************************************/
43// Augmentations:
44// Entry
45//
46// 12/20/94 JJT - merged autoprompt support
47// 03/17/95 - Findreq_Auto_prompt fixed to check for itm and not the
48// current_item for data-file. Also, improved
49// status checking logic.
50// 08/29/95 JJT - Procedure Auto_prompt now only sets auto_prompt_check
51// if the current mode is not auto_prompt_on. Otherwise
52// ivalidates which turn these on get lost.
53//
54// 08/30/95 JJT - Prompt only resets auto_prompt_mode if we are returning
55// to the same current_item (which is the normal case).
56// 08/30/95 JJT - Fixed auto-prompt after image move with a messy fix
57// creates a duplicate move_client_location here that
58// adjusts prompt_entry_mode. This must mix in after entitem.
59// 08/30/95 JJT - New public message Entry_Value. Returns numbers stripped
60// of uneeded 0 decimals and decimal point.
61//************************************************************************/
62// 2/26/2002 JJT - 8.2 clean up (indirect_file, local, self, etc.)
63
64//************************************************************************
65// File Name: EntItem.Inc
66// Creation Date: January 1, 1991
67// Modified Date: May 23, 1991
68// Author(s): Steven A. Lowe
69//
70// This module defines the routines and properties required to support
71// the use of entry-items, collected in the abstract class Entry_Item_Mixin.
72//
73// This file should be USEd prior to and IMPORTed within the scope of the
74// class definition by any user-interface (esp. data-entry) class which
75// must support entry-items.
76//
77// This file is used by ENTRYFRM.PKG and WIDELIST.PKG.
78//************************************************************************/
79
80#CHKSUB 1 1 // Verify the UI subsystem.
81
82use VDFBase.pkg
83
84enum_list
85 define Auto_Prompt_Ready // ready for auto-prompt. (idle)
86 define Auto_Prompt_Check // Auto-prompt next item if it is blank.
87 define Auto_Prompt_On // Next entry WILL be auto-prompt
88 define Auto_Prompt_Off // Next entry WILL NOT be auto-prompt
89end_enum_list
90
91Register_function Validate_all_items_state returns integer
92
93class Entry_Item_Mixin is a mixin
94
95 //
96 // Description
97 //
98 // This procedure defines kPrompt and kZoom accelerator keys for this
99 // object.
100 //
101 // Assumptions/Preconditions
102 //
103 // This procedure should only be invoked from the Construct_Object
104 // procedure of a class definition.
105 //
106 // Exceptions
107 //
108 // None.
109 //
110 // Notes
111 //
112 // None.
113 //
114 { MethodType=Event Visibility=Private }
115 procedure define_entry_item
116 on_key kPrompt SEND Prompt PRIVATE
117 on_key kZoom SEND Zoom PRIVATE
118 { Visibility=Private }
119 property integer object_item_entry_exit TRUE
120
121 // (JJT) Added for auto-prompt support (from autoprmpt.pkg)
122 // Auto_Prompt_State: If true, autoprompt if iPrompt message exists
123 // and field is blank. If False Auto_prompt must
124 // be asked for (Msg_Auto_prompt).
125 { Visibility=Private }
126 property integer Auto_prompt_State False
127
128 // Prompt_Entry_Mode
129 // AUTO_PROMPT_READY = Allow autoPrompt. (idle position)
130 // AUTO_PROMPT_CHECK = AutoPrompt if blank field
131 // AUTO_PROMPT_ON = Do AutoPrompt on the next entry
132 // AUTO_PROMPT_OFF = Do NOT AutoPrompt the next enxtry. (internal)
133 //
134 { Visibility=Private }
135 Property Integer Prompt_Entry_Mode AUTO_PROMPT_READY
136
137 end_procedure
138
139
140 //
141 // Description
142 //
143 // This procedure activates the zoom-objct, if any, for the current
144 // entry-item.
145 //
146 // Assumptions/Preconditions
147 //
148 // This object (or one of its ancestor classes) implements a
149 // zoom_object function to return a valid object id (for a
150 // user-interface object understanding the PopUp message), or 0.
151 //
152 // Exceptions
153 //
154 // If the zoom-object is 0, no action is taken.
155 //
156 // Notes
157 //
158 // None.
159 //
160 procedure Zoom
161 integer obj#
162 get zoom_object item CURRENT to obj#
163 if obj# ne 0 send POPUP to obj#
164 end_procedure
165
166
167 //
168 // Description
169 //
170 // This procedure activates the prompt-objct, if any, for the current
171 // entry-item.
172 //
173 // Assumptions/Preconditions
174 //
175 // This object (or one of its ancestor classes) implements a
176 // prompt_object function to return a valid object id (for a
177 // user-interface object understanding the PopUp message), or 0.
178 //
179 // Exceptions
180 //
181 // If the prompt-object is 0, no action is taken.
182 //
183 // Notes
184 //
185 // None.
186 //
187 procedure Prompt
188 integer obj# Itm
189 Get Current_Item to Itm
190 get prompt_object item Itm to obj#
191 if obj# ne 0 send POPUP to obj#
192 // After a popup we don't want an autoprompt. However if the popup
193 // changes the current item then an autoprompt on the new item would be
194 // ok and we would want an autoprompt when we return to this item.
195 If (Current_Item(self)=itm) ; // only set if cycling back.
196 Set Prompt_Entry_Mode to AUTO_PROMPT_OFF // been there, done that
197 end_procedure
198
199
200 //
201 // Description
202 //
203 // This function invokes the message given by msg#, passing the
204 // specified item# as the only argument to the message. The value
205 // returned by execution of the message is returned; non-zero means
206 // that entry to the specified item# should be denied.
207 //
208 // Assumptions/Preconditions
209 //
210 // The msg# argument must be either a valid message id or 0. The item#
211 // argument must be a valid entry-item index (between 0 and Item_Count-1).
212 //
213 // Exceptions
214 //
215 // If the specified msg# is 0, no action is taken.
216 //
217 // Notes
218 //
219 // This function is invoked by the Item_Change procedure, among others.
220 //
221 { MethodType=Event Visibility=Private }
222 function Item_Entry integer msg# integer item# returns integer
223 integer retVal
224 if not (object_item_entry_exit(self)) function_return 0
225 move 0 to retval
226 if msg# ne 0 get msg# item item# to retVal
227 function_return retVal
228 end_function
229
230
231 //
232 // Description
233 //
234 // This function invokes the message given by msg#, passing the
235 // specified item# as the only argument to the message. The value
236 // returned by execution of the message is returned; non-zero means
237 // that exit from the specified item# should be denied.
238 //
239 // Assumptions/Preconditions
240 //
241 // The msg# argument must be either a valid message id or 0. The item#
242 // argument must be a valid entry-item index (between 0 and Item_Count-1).
243 //
244 // Exceptions
245 //
246 // If the specified msg# is 0, no action is taken.
247 //
248 // Notes
249 //
250 // This function is invoked by the Item_Change procedure, among others.
251 //
252 { MethodType=Event Visibility=Private }
253 function Item_Exit integer msg# integer item# returns integer
254 integer retVal
255 if not (object_item_entry_exit(self)) function_return 0
256 move 0 to retval
257 if msg# ne 0 get msg# item item# to retVal
258 function_return retVal
259 end_function
260
261
262 //
263 // Description
264 //
265 // This function invokes the message given by msg#, passing the
266 // specified item# as the only argument to the message. The value
267 // returned by execution of the message is returned; non-zero means
268 // that the data entered in the specified item# is invalid, and that
269 // the cursor should stay on the specified item#.
270 //
271 // Assumptions/Preconditions
272 //
273 // The msg# argument must be either a valid message id or 0. The item#
274 // argument must be a valid entry-item index (between 0 and Item_Count-1).
275 //
276 // Exceptions
277 //
278 // If the specified msg# is 0, no action is taken.
279 //
280 // Notes
281 //
282 // This function is invoked by the Item_Change procedure, among others.
283 //
284 { MethodType=Event Visibility=Private }
285 function Item_Validate integer msg# integer item# returns integer
286 integer retVal
287 move 0 to retval
288 if msg# ne 0 get msg# item item# to retVal
289 function_return retVal
290 end_function
291
292
293 //
294 // Description
295 //
296 // This function invokes the entry-message for the specified item#, and
297 // returns the result; non-zero means that entry to the specified item#
298 // should be denied.
299 //
300 // Assumptions/Preconditions
301 //
302 // The item# argument must be a valid entry-item index (between 0 and
303 // Item_Count-1), or the sentinel value CURRENT.
304 //
305 // Exceptions
306 //
307 // None.
308 //
309 // Notes
310 //
311 // This function is used to force execution of an item's entry-msg.
312 //
313 Function Exec_Entry Integer item# Returns Integer
314 integer retval curItem entMsg
315 if item# eq CURRENT get current_item to curItem
316 else move item# to curItem
317 get item_entry_msg item curItem to entMsg
318 get item_entry entMsg curItem to retval
319 function_return retval
320 end_function
321
322
323 //
324 // Description
325 //
326 // This function invokes the exit-message for the specified item#, and
327 // returns the result; non-zero means that exit from the specified item#
328 // should be denied.
329 //
330 // Assumptions/Preconditions
331 //
332 // The item# argument must be a valid entry-item index (between 0 and
333 // Item_Count-1), or the sentinel value CURRENT.
334 //
335 // Exceptions
336 //
337 // None.
338 //
339 // Notes
340 //
341 // This function is used to force execution of an item's exit-msg.
342 //
343 Function Exec_Exit Integer item# Returns Integer
344 integer retval curItem exitMsg
345 if item# eq CURRENT get current_item to curItem
346 else move item# to curItem
347 get item_exit_msg item curItem to exitMsg
348 get item_exit exitMsg curItem to retval
349 function_return retval
350 end_function
351
352
353 //
354 // Description
355 //
356 // This function invokes the validate-message for the specified item#,
357 // and returns the result; non-zero means that the data entered in the
358 // specified item# is invalid, and that the cursor should stay on the
359 // specified item#.
360 //
361 // Assumptions/Preconditions
362 //
363 // The item# argument must be a valid entry-item index (between 0 and
364 // Item_Count-1), or the sentinel value CURRENT.
365 //
366 // Exceptions
367 //
368 // If the specified item# uses the AUTOFIND option, an entry_autofind
369 // is performed.
370 //
371 // Notes
372 //
373 // This function is used to force execution of an item's validate-msg.
374 //
375 function Exec_Validate integer item# returns integer
376 integer retval curItem valMsg chgd autoFlag autoGEFlag
377 if item# eq CURRENT get current_item to curItem
378 else move item# to curItem
379 //
380 // check for AUTOFIND, AUTOFIND_GE
381 //
382 #IFSUB 'AUTOFIND_BIT'
383 #ELSE
384 #REPLACE AUTOFIND_BIT 0
385 #ENDIF
386 #IFSUB 'AUTOFIND_GE_BIT'
387 #ELSE
388 #REPLACE AUTOFIND_GE_BIT 8
389 #ENDIF
390 get item_changed_State item curItem to chgd
391 if chgd ne 0 begin
392 get item_option item curItem AUTOFIND_BIT to retval
393 if retval begin
394 get item_option item curItem AUTOFIND_GE_BIT to retval
395 if retval send entry_autofind GE curItem
396 else send entry_autofind EQ curItem
397 end
398 end
399 //
400 // validate item
401 //
402 get Valid_Item item curItem to retval
403 function_return retval
404 end_function
405
406 // *********************JJT
407 // The following was added for auto_prompt support. In addition,
408 // some properties in the define_entry_item and Prompt was changed.
409 //
410
411 // This tells the next entry statement to execute an auto-prompt.
412 //
413 // Right now there is a bug in the iEntry mechanism that causes the
414 // the iEntry to not always get called. When this happens we lose the
415 // auto_prompt (this often happens if your auto-prompt is in the first
416 // item). The work-around for now is that the ENTRY function makes an
417 // check. If the iEntry message is MSG_AUTO_PROMPT it will do the auto-
418 // prompt for you. This means that the one line here is not really required.
419 // However, when iEntry is fixed - it WILL be needed. This also shows how you
420 // can use this statement in other iEntry messages
421 { Visibility=Private }
422 Procedure Auto_Prompt Integer Itm#
423 // only change to check if it is not already set to do a prompt.
424 if ( prompt_entry_mode(self)<>AUTO_PROMPT_ON ) ;
425 Set Prompt_entry_mode to AUTO_PROMPT_CHECK
426 End_Procedure
427
428 // Function: Test_for_Auto_Prompt
429 //
430 // Test if an auto-prompt should be executed. This is only called
431 // by the entry function. It should Return TRUE if an autoprompt is
432 // required. This checks to see if the item is blank.
433 // This was designed for augmentation.
434 { Visibility=Private }
435 Function Test_for_Auto_prompt Integer Itm# Returns Integer
436 // if blank we will auto-prompt
437 If (Value(self,Itm#)='') Function_Return 1
438 End_function
439
440
441 { Visibility=Private Obsolete=True }
442 Function Entry Returns Integer
443 Integer Retval Pmode Itm# Auto_state
444 Get Current_Item to Itm#
445 Get Prompt_Entry_Mode to PMode
446
447 // if auto-mode always check for auto-prompting
448 If (pMode=AUTO_PROMPT_READY AND Auto_Prompt_State(self)) ;
449 Move AUTO_PROMPT_CHECK to pMode
450
451 // This is our fix code until iEntry is always called and only called
452 // at the right time. In the mean time this'll do.
453 If ( pMode=AUTO_PROMPT_READY AND ;
454 Item_Entry_MSG(self,Itm#)=MSG_Auto_Prompt) ;
455 Move AUTO_PROMPT_CHECK to pMode
456
457 If (PMode=AUTO_PROMPT_CHECK AND ;
458 Test_for_Auto_Prompt(self,Itm#) ) ;
459 Move AUTO_PROMPT_ON to PMode
460
461 If PMode eq AUTO_PROMPT_ON move kPrompt to retVal
462 Else Forward get Entry to RetVal
463 // Always reset mode after an entry (PROMPT might change it).
464 Set Prompt_Entry_Mode to AUTO_PROMPT_READY
465 function_return retval
466 End_function
467
468 // useful validate function. If you set iValidate to this message
469 // you'll get an error when you attempt save and a prompt when
470 // you attempt to move.
471 //
472 { Visibility=Private }
473 Function required_Auto_Prompt Integer Itm# Returns Integer
474 // in this sample a blank indicates a problem
475 If (Value(self,Itm#)='') Begin
476 // if part of a save...just report the error
477 If (Validate_all_items_State(self)) ;
478 Error DFERR_BAD_ENTRY
479 Else ;
480 Set Prompt_Entry_Mode to AUTO_PROMPT_ON // else...force an autoprompt
481 Function_return 1
482 End
483 End_Function // Required_Auto_Prompt
484
485 // 03/17/95 - Fixed bug where datafile was not for Itm#.
486 // Fixed logic to better handle autofind (where a record exists
487 // but it was not auto-found.
488 { Visibility=Private }
489 Function Findreq_Auto_Prompt Integer Itm# Returns Integer
490 // in this sample a blank indicates a problem
491 integer server# Err# File# Field# Typ Dummy
492 integer iStat
493 string Itm_val FileVal
494 Get Server to Server#
495 If Server# Send Refind_records to Server#
496 // Get data_file to filenumber // oops - no itm#
497 Get data_file item itm# to file#
498 Get data_field item itm# to Field#
499// Move File# to Filenumber
500// Move Field# to FieldIndex
501// if not status Indirect_file Move 1 to Err# // no record, error
502 get_attribute df_file_status of file# to iStat
503 if (iStat=DF_FILE_INACTIVE) ;
504 Move 1 to Err# // no record, error
505 Else Begin // if we have a current record, make sure it is right
506// Move Indirect_File.Recnum to FileVal
507// Get Value Item Itm# to Itm_Val // the value on the screen
508// Field_Def File# Field# to Typ Dummy
509// If Typ eq 1 Move (Number(Itm_Val)<>Number(FileVal)) to err#
510// Else Move (Itm_Val<>FileVal) to err#
511 Get_field_value file# field# to FileVal
512 Get Value Item Itm# to Itm_Val // the value on the screen
513 get_attribute df_field_type of file# field# to Typ
514 // if field type is Numeric (1) check for numeric equality
515 // we need to do numeric checks because the internal value
516 // of a number is sometimes "1" and sometimes "1.0000"
517 If (Typ=DF_BCD) ;
518 Move (Number(Itm_Val)<>Number(FileVal)) to err#
519 Else ;
520 Move (Itm_Val<>FileVal) to err#
521 End
522 //
523 If Err# Begin
524 // if part of a save...just report the error
525 If (Validate_all_items_State(self)) ;
526 Error DFERR_ENTER_VALID_REC_ID
527 Else ;
528 Set Prompt_Entry_Mode to AUTO_PROMPT_ON // else...force an autoprompt
529 Function_return 1
530 End
531 End_Function // Required_Auto_Prompt
532
533 // This is lifted from clmovemx.pkg. It shuts off auto_prompting. If this is
534 // not done you get an auto-prompt after move. This is only required because
535 // the entry function handles msg_auto_prompt directly because the ientry
536 // hook is not always reliable. When that is fixed, we could also remove
537 // this code. For this to work the entitem package MUST be mixed in after
538 // the clmove mixin package. Used in entry_form and wide_list
539 //
540// procedure Move_Client_Location integer yoff integer xoff
541//
542// // new line of code
543// Set Prompt_Entry_Mode to AUTO_PROMPT_OFF // been there, done that
544//
545// //.....direct from clmovemx
546// // if allowed do the move....else delegate
547// if (Allow_Move_State(self)) ;
548// send Move_Location yoff xoff
549// Else Delegate Send Move_Client_Location yoff xoff
550//
551// end_procedure
552
553 // Public Message
554 //
555 // Just like Value except this will strip .0000 from numeric
556 // items which allows for comparison with data fields. Only works if
557 // item is associated with a file.field
558 { Visibility=Private }
559 Function Entry_Value integer Itm# returns string
560 Integer File# Field# Type# Dummy#
561 String Val
562 Get Value Item Itm# to Val // the value on the screen
563 Get Data_File Item Itm# to File#
564 If File# Begin
565 Get Data_Field Item Itm# to Field#
566// Field_Def File# Field# to Type# Dummy#
567// If Type# eq 1 ; // numeric
568 get_attribute df_field_type of file# field# to Type#
569 If (Type#=DF_BCD) ;
570 Move (Number(Val)) to Val
571 End
572 Function_Return Val
573 end_function
574
575
576end_class
577