home *** CD-ROM | disk | FTP | other *** search
/ Liren Large Software Subsidy 5 / 05.iso / a / a114 / 2.img / TOOLKIT / TOOLKIT.ZIP / RECURSW8.SC < prev    next >
Encoding:
Text File  |  1990-08-25  |  9.4 KB  |  184 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
  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:
  120.             If Search(TKKeyType,"SD") <> 0    ;"Special" or "DepartSpecial"
  121.                Then CallProc(TKSpclProc)      ;Call appropriate procedure
  122.                     If TKKeyType <> "X"
  123.                        Then If Not Retval     ;Key wasn't accepted, or was
  124.                                Then Loop      ; reset to a new value
  125.                             Endif
  126.                     Endif
  127.             Endif
  128.             Retval = True
  129.             Switch
  130.                Case Search(TKKeyType,"XS") <> 0 : ;Processed next Switch stmnt
  131.                Case IsValid() :                   ;Good Depart
  132.                   If Search("D",TKAction[TKFieldNum]) <> 0
  133.                      Then TKChanged = [] <> TKFieldVal ;Changed? Set T/F
  134.                           CallProc(TKGoodDepart[TKFieldNum])
  135.                   Endif
  136.                Otherwise:                         ;Bad Depart
  137.                   If Search("F",TKAction[TKFieldNum]) <> 0
  138.                      Then CallProc(TKBadDepart[TKFieldNum])
  139.                   Endif
  140.             Endswitch
  141.             Switch
  142.                Case TKKeyType = "X" :   ;TKKeyType set to "X" by Special key,
  143.                   CheckMessage()        ; Good Depart, or Bad Depart proc
  144.                   Echo Off              ;Exit immediately
  145.                   Return TKChar
  146.                Case Not Retval :        ;Good Depart or Bad Depart rejected
  147.                   Loop                  ; or reassigned TKChar.  Reprocess it.
  148.                Case TKKeyType = "S" :
  149.                   Keypress TKChar
  150.                Case IsValid() :         ;Field data is valid, pending key is
  151.                   ExecProc TKMvmntProc  ; a movement key ("S" or "M")
  152.                   If Search(TKKeyType,"EX") <> 0
  153.                      Then CheckMessage()  ;Movement-initated proc or pending
  154.                           Echo Off        ; key requested exit from DoWait
  155.                           Return TKChar
  156.                   Endif
  157.                   If Not Retval         ;Movement-initiated proc rejected
  158.                      Then Loop          ; pending key
  159.                   Endif
  160.                Otherwise :     ;Data is still invalid, can't move out of it
  161.                  If (TKChar = -83 or TKChar = 21 or TKChar = 0) and
  162.                     TKKeyType <> "E"   ;If Del, Undo, or Cancel is an Exit key
  163.                     Then BadDelUndo()  ; reject it since data is invalid
  164.                          If Search(TKKeyType,"EX") <> 0
  165.                             Then CheckMessage()
  166.                                  Echo Off
  167.                                  Return TKChar
  168.                          Endif
  169.                          If not Retval
  170.                             Then Loop
  171.                          Endif
  172.                     Else If IsBlank(TKMessage)  ;Display standard Paradox
  173.                             Then Keypress -72   ; message unless specified
  174.                          Endif                  ; otherwise in user procedure
  175.                  Endif
  176.             Endswitch
  177.       Endswitch
  178.       CheckMessage()          ; Check for message to display
  179.       ExecProc TKKeyProc      ; Read next key
  180.       Echo Normal
  181.    Endwhile
  182.  
  183. Endproc
  184.