home *** CD-ROM | disk | FTP | other *** search
/ Jason Aller Floppy Collection / 99.img / PDOX3-08.ZIP / TOOLKIT1 / RECURSW8.SC < prev    next >
Encoding:
Text File  |  1989-09-15  |  9.1 KB  |  197 lines
  1. ; Copyright (c) 1988, 1989 Borland International.  All Rights Reserved.
  2. ;
  3. ; General permission to re-distribute all or part of this script is granted,
  4. ; provided that this statement, including the above copyright notice, is not
  5. ; removed.  You may add your own copyright notice to secure copyright
  6. ; protection for new matter that you add to this script, but Borland
  7. ; International will not support, nor assume any legal responsibility for,
  8. ; material added or changes made to this script.
  9. ;
  10. ; Revs.:  DCY 12/15/88, DCY 6/12/89
  11. ; ****************************************************************************
  12. ; RecurseWait allows you to use DoWait on a single table regardless of the
  13. ; current form or image type.  Thus should you need to temporarily override
  14. ; an existing DPA set from within a DoWait session, you can issue a call to
  15. ; RecurseWait.  Furthermore, to use DoWait on a query image you MUST call
  16. ; RecurseWait.
  17. ;
  18. ; Use the SetUpDoWait subsystem of TKMenu to create a DoWait Procedure
  19. ; Assignment (DPA) set for the table of interest and specify the name of the
  20. ; DPA set in your call to RecurseWait.  As with DoWait, you must call InitWait
  21. ; before calling RecurseWait.  InitWait arguments for RecurseWait are
  22. ; identical to those for DoWait.
  23. ;
  24. ; IMPORTANT: RecurseWait will NOT automatically exit when a user successfully
  25. ;            leaves the current table image.  Thus you should assign any keys
  26. ;            which cause movement out of the table as "Exit" keys, or have
  27. ;            your Table Depart procedure (if you assign one) reassign them
  28. ;            as such.
  29. ;
  30. Proc RecurseWait(TKMessage,DPASet)
  31.    Private;TKMessage      ;Message to display upon entry into RecurseWait
  32.           ;DPASet,        ;Name of DoWait Procedure Assignment (DPA) set
  33.            TKAccept,      ;Specifies whether last key hit will be accepted
  34.            TKHoldCanvas,  ;Specifies whether PAL canvas will be removed
  35.            TKFieldNum,    ;Column position (in table view) of current field
  36.            TKFieldVal,    ;Value of current field upon entry into it
  37.            TKChanged,     ;Indicates field value has changed since arrival
  38.            TKRecMvmnt,    ;Specifies whether last key will cause rec movement
  39.            TKMvmntProc,   ;Procedure which initiates movement key events
  40.            TKChar,        ;ASCII value of last key pressed
  41.            TKKeyType,     ;Type of key (R, I, E, M, S, D)
  42.            TKKeyProc,     ;Procedure which monitors keyboard (in)activity
  43.            TKUserKey,     ;Value of key before user's procedure was executed
  44.            TKSeconds,     ;Number of seconds elapsed without a keypress
  45.            TKBuffer,      ;ASCII value of key in keyboard buffer
  46.            TKTime,        ;Time of last keypress
  47.            TKTable,       ;Name and path of active table image
  48.            TKPosKey,      ;ASCII (positive) key class assignments
  49.            TKNegKey,      ;IBM extended key class assignments
  50.            TKAction,      ;Array of field level procedure assignments
  51.            TKArrive,      ;Array of field arrival procedures
  52.            TKGoodDepart,  ;Array of field good departure procedures
  53.            TKBadDepart,   ;Array of field bad departure procedures
  54.            TKKeystroke,   ;Array of field keystroke procedures
  55.            TKSpclProc,    ;Special key procedure
  56.            TKInactiveProc,;Keyboard inactivity procedure
  57.            TKTblArrive,   ;Table arrival procedure
  58.            TKTblDepart,   ;Table departure procedure
  59.            TKRecArrive,   ;Record arrival procedure
  60.            TKRecDepart,   ;Record departure procedure
  61.            TKNegMv,       ;Record level movement key types
  62.            TKPosMv        ;Record level movement key types
  63.  
  64.    TKChar = BlankNum()    ;Initialize keystroke character
  65.    TKBuffer = BlankNum()  ;Initialize single-key type-ahead buffer
  66.    TKHoldCanvas = False   ;Unless specified otherwise in an arrival-level
  67.                           ; procedure, remove PAL canvas just before
  68.                           ; acceptance of first user keystroke
  69.  
  70.    ExecProc DPASet        ;Initialize DPA set
  71.    TKKeyProc = "GetInactive"     ;Select key procedure
  72.    If IsBlank(TKInactiveProc)
  73.       Then TKKeyProc = "GetKey"
  74.    Endif
  75.  
  76.    TKRecMvmnt = True
  77.    If TKMvmntProc = "StdMvmnt"   ;Select record movement procedure
  78.       Then TKRecMvmnt = False
  79.    Endif
  80.  
  81.    NewField()
  82.    If TKTblArrive <> ""   ;Call table arrival proc
  83.       Then ExecProc TKTblArrive
  84.            CheckHoldCanvas()
  85.    Endif
  86.  
  87.    SysRecArrive()         ;Inform DoWait we've arrived at a new record--
  88.                           ; Call record arrival procedure if assigned
  89.    SysArrive()         ;Inform DoWait we've arrived in a new field--
  90.                           ; Initialize field-dependent variables and call
  91.                           ; field arrival procedure if assigned
  92.    CheckMessage()         ; Check for a message to display
  93.    ExecProc TKKeyProc     ;Read a key from the keyboard
  94.    Echo Normal
  95.  
  96.    While True
  97.       If TKChar > 0         ;Determine class of key we are about to process
  98.          Then TKKeyType = Substr(TKPosKey,TKChar,1)   ;These statements are
  99.          Else TKKeyType = Substr(TKNegKey,1-TKChar,1) ; necessary because max
  100.       Endif                                           ; string length is 255
  101.       Switch
  102.          Case HelpMode() <> "None" or IsFieldView(): ;Do nothing special while
  103.             Keypress TKChar                          ; in field view or help
  104.          Case TKKeyType = "R":                       ;"Regular" key
  105.             If Search("K",TKAction[TKFieldNum]) <> 0 ;Call keystroke proc, if
  106.                Then CallProc(TKKeystroke[TKFieldNum]); assigned
  107.                     If TKKeyType = "X"             ;Immediate eXit from DoWait
  108.                        Then CheckMessage()
  109.                             Echo Off
  110.                             Return TKChar
  111.                     Endif
  112.                     If Not Retval
  113.                        Then Loop                   ;Key wasn't accepted, or
  114.                     Endif                          ; was reset to a new value
  115.             Endif
  116.             Keypress TKChar
  117.          Case TKKeyType = "I":                     ;"Illegal" key
  118.             Beep                                   ;Beep and ignore key
  119.          Otherwise:  ;Key must be of type "S","D","E", or "M"
  120.             If Search(TKKeyType,"SD") <> 0    ;"Special" or "DepartSpecial"
  121.                Then CallProc(TKSpclProc)      ;Call appropriate procedure
  122.                     If TKKeyType = "X"
  123.                        Then CheckMessage()
  124.                 Echo Off
  125.                 Return TKChar
  126.             Endif
  127.             If not Retval     ;Key wasn't accepted, or was
  128.                Then Loop      ; reset to a new value
  129.             Endif
  130.             If TKKeyType = "S"
  131.                Then Keypress TKChar
  132.                 CheckMessage()
  133.                 ExecProc TKKeyProc
  134.                 Echo Normal    
  135.                 Loop
  136.             Endif
  137.             Endif
  138.         If IsValid()
  139.            Then If Search("D",TKAction[TKFieldNum]) <> 0 ;Good Depart
  140.                        Then TKChanged = [] <> TKFieldVal ;Changed? Set T/F
  141.                             CallProc(TKGoodDepart[TKFieldNum])
  142.                 If TKKeyType = "X" ;Immediate Exit
  143.                    Then CheckMessage()
  144.                     Echo Off      
  145.                     Return TKChar
  146.                   Endif
  147.                 If not Retval ;Good Depart or Bad Depart rejected
  148.                    Then Loop  ; or reassigned TKChar.  Reprocess.
  149.                 Endif
  150.                     Endif
  151.                Else If Search("F",TKAction[TKFieldNum]) <> 0 ;Bad Depart
  152.                        Then CallProc(TKBadDepart[TKFieldNum])
  153.                 If TKKeyType = "X"
  154.                    Then CheckMessage()
  155.                     Echo Off
  156.                     Return TKChar
  157.                 Endif
  158.                 If not Retval ;Good Depart or Bad Depart rejected
  159.                    Then Loop  ; or reassigned TKChar.  Reprocess.
  160.                 Endif
  161.                     Endif
  162.             Endif
  163.             If IsValid()                  ;Field data is valid, pending key is
  164.            Then ExecProc TKMvmntProc  ; a movement key ("D" or "M")
  165.             If Search(TKKeyType,"EX") <> 0
  166.                Then CheckMessage() ;Movement-initiated proc or pending
  167.                 Echo Off       ; key requested exit from DoWait
  168.                 Return TKChar
  169.             Endif
  170.             If Not Retval         ;Movement-initiated proc rejected
  171.                Then Loop          ; pending key
  172.             Endif
  173.                Else ;Data is still invalid, can't move out of it
  174.             If (TKChar = -83 or TKChar = 21 or TKChar = 0) and
  175.                        TKKeyType <> "E"   ;If Del, Undo, or Cancel is an Exit
  176.                        Then BadDelUndo()  ; key, reject it -- data is invalid
  177.                 If Search(TKKeyType,"EX") <> 0
  178.                    Then CheckMessage()
  179.                     Echo Off
  180.                     Return TKChar
  181.                 Endif
  182.                 If not Retval
  183.                    Then Loop
  184.                 Endif
  185.                        Else If IsBlank(TKMessage) ;Display standard Paradox
  186.                                Then Keypress -72  ; message unless specified
  187.                             Endif                ; otherwise in user procedure
  188.                     Endif
  189.             Endif
  190.       Endswitch
  191.       CheckMessage()          ; Check for message to display
  192.       ExecProc TKKeyProc      ; Read next key
  193.       Echo Normal
  194.    Endwhile
  195.  
  196. Endproc
  197.