Liren Large Software Subsidy 5

home *** CD-ROM | disk | FTP | other *** search

/ Liren Large Software Subsidy 5 / 05.iso / a / a114 / 2.img / TOOLKIT / TOOLKIT.ZIP / KERNEL.SC < prev next >

Wrap

Text File | 1990-08-25 | 28.1 KB | 625 lines

; Copyright (c) 1987-1989 Borland International. All Rights Reserved. ; ; General permission to re-distribute all or part of this script is granted, ; provided that this statement, including the above copyright notice, is not ; removed. You may add your own copyright notice to secure copyright ; protection for new matter that you add to this script, but Borland ; International will not support, nor assume any legal responsibility for, ; material added or changes made to this script. ; ; Revs.: MJP 3/8/88, DCY 12/15/88 ; **************************************************************************** ; ; InitWait initializes variables needed by DoWait and loads all of its ; required supplemental procedures. You must call it before invoking DoWait. ; ; You MUST call InitWait to load DoWait and its supplemental procedures. ; The Toolkit, like the rest of Paradox, is subject to upgrade. When such ; upgrades occur, it is possible that the Toolkit may require more procedures, ; or that undocumented procedure names may change. Calling InitWait rather ; that loading all of the necessary procedures manually will assure ; compatibility between Toolkit versions. ; ; InitWait examines the variable TKLibName. If TKLibName is defined, ; then its value is used as the name of the library that contains the Toolkit ; procedures. TKLibName can, of course, contain a full directory name. If ; you do not assign TKLibName a value, it will default to "Toolkit". ; ; Note that InitWait does not load DPA procs for tables you use with DoWait. ; It is YOUR repsonsibility to load them (you do not need to execute them). ; Proc InitWait(MaxImgNo,ImgNumLst,TblNamLst) Private;MaxImgNo, ;Max. image number of table(s) to use with DoWait ;ImgNumLst, ;Comma separated list of table image numbers ;TblNamLst, ;Comma separated list of table names (corresponds ; to ImgNumLst) ImgNo, ;Parsed image number TNam ;Parsed table name ; Global TKDPASet ;Array of workspace table image configuration If Not IsAssigned(TKLibName) ;Set DoWait procedure library name to Then TKLibName = SDir()+"Toolkit" ; default if not specified otherwise Endif If IsFile(TKLibName+".LIB") Then Readlib TKLibName DoWait,CheckHoldCanvas,CheckMessage,CallProc, RecMvmnt,ArriveMvmnt,StdMvmnt,CheckRecMove, WaitZoom,GetInactive,GetKey,BadDelUndo,NewField, ArriveField,SysArrive,ArriveRecord, SysRecArrive,NewTable,ArriveTable,SysTblArrive If Version() < 3 Then Quit "Release 3.0 of the Data Entry Toolkit requires Paradox version 3.0 or higher." Endif Array TKDPASet[MaxImgNo] ImgNumLst = ImgNumLst + "," TblNamLst = TblNamLst + "," While Match(ImgNumLst,"..,..",ImgNo,ImgNumLst) and Match(TblNamLst,"..,..",TNam,TblNamLst) TKDPASet[Numval(ImgNo)] = "TK"+TNam+"_" Endwhile Else Quit "DoWait procedures not loaded: Could not find " + TKLibName + " library." Endif Endproc ; Here is the heart and soul of the toolkit: DoWait, an event-driven wait. ; ; Like the PAL WAIT TABLE command, DoWait allows a user to move around a ; table image (and make changes if in edit mode) until the user presses any ; one of a set of pre-designated "exit" keys, upon which control is returned ; back to the calling program. ; ; DoWait differs from a WAIT command in that after you invoke DoWait, you ; do not lose control over what a user can do while editing. Instead, DoWait ; calls procedures which you've previously specified (using TKMenu's ; SetUpDoWait subsystem) DURING the wait condition upon the occurence of ; certain keystroke, field, record, and table-level events. By creating ; appropriate procedures for DoWait to call upon specific events, you can ; have nearly total control over what a user does and can do during an editing ; session. ; ; Specifically, DoWait examines variables (defined in DPA procedures created ; by SetUpDoWait) to know both the names of procedures to call and the events ; upon which to activate them. These variables also instruct DoWait on how ; to treat each key a user presses. ; Proc DoWait(TKMessage) Private;TKMessage, ;Message to be displayed (provided by user) TKAccept, ;Specifies whether last key hit will be accepted TKHoldCanvas, ;Specifies whether PAL canvas will be removed TKFieldNum, ;Column position (in table view) of current field TKFieldVal, ;Value of current field upon entry into it TKChanged, ;Indicates field value has changed since arrival TKRecMvmnt, ;Specifies whether last key will cause rec movement TKMvmntProc, ;Procedure which initiates movement key events TKChar, ;ASCII value of last key pressed TKKeyType, ;Type of key (R, I, E, M, S, D) TKKeyProc, ;Procedure which monitors keyboard (in)activity TKUserKey, ;Value of key before user's procedure was executed TKSeconds, ;Number of seconds elapsed without a keypress TKBuffer, ;ASCII value of key in keyboard buffer TKTime, ;Time of last keypress TKImgNo, ;Image number of active table image TKPosKey, ;ASCII (positive) key class assignments TKNegKey, ;IBM extended key class assignments TKAction, ;Array of field level procedure assignments TKArrive, ;Array of field arrival procedures TKGoodDepart, ;Array of field good departure procedures TKBadDepart, ;Array of field bad departure procedures TKKeystroke, ;Array of field keystroke procedures TKSpclProc, ;Special key procedure TKInactiveProc,;Keyboard inactivity procedure TKTblArrive, ;Table arrival procedure TKTblDepart, ;Table departure procedure TKRecArrive, ;Record arrival procedure TKRecDepart, ;Record departure procedure TKNegMv, ;Record departure (ASCII) key assignments TKPosMv ;Record departure (IBM Extended) key assignments TKChar = BlankNum() ;Initialize keystroke character TKBuffer = BlankNum() ;Initialize single-key type-ahead buffer TKHoldCanvas = False ;Unless specified otherwise in an arrival-level ; procedure, remove PAL canvas just before ; acceptance of first user keystroke SysTblArrive() ;Inform DoWait we've entered a new table-- ; Initialize DPA set and call table arrival proc SysRecArrive() ;Inform DoWait we've arrived at a new record-- ; Call record arrival procedure if assigned SysArrive() ;Inform DoWait we've arrived in a new field-- ; Initialize field-dependent variables and call ; field arrival procedure if assigned CheckHoldCanvas() ;Unless specified otherwise in an arrival procedure, ; set echo to normal on entry CheckMessage() ; Check for a message to display ExecProc TKKeyProc ;Read a key from the keyboard Echo Normal While True If TKChar > 0 ;Determine class of key we are about to process Then TKKeyType = Substr(TKPosKey,TKChar,1) ;These statements are Else TKKeyType = Substr(TKNegKey,1-TKChar,1) ; necessary because max Endif ; string length is 255 Switch Case HelpMode() <> "None" or IsFieldView(): ;Do nothing special while Keypress TKChar ; in field view or help Case TKKeyType = "R": ;"Regular" key If Search("K",TKAction[TKFieldNum]) <> 0 ;Call keystroke proc if Then CallProc(TKKeystroke[TKFieldNum]); assigned If TKKeyType = "X" ;Check for request to Then CheckMessage() ; immediately exit DoWait Echo Off Return TKChar Endif If Not Retval Then Loop ;Key wasn't accepted or Endif ; was reset to a new Endif ; value--reprocess it. Keypress TKChar Case TKKeyType = "I": ;"Illegal" key Beep ;Beep and ignore key Otherwise: ;Key must be of type "S","D","E", or "M" If Search(TKKeyType,"SD") <> 0 ;"Special" or "DepartSpecial" Then CallProc(TKSpclProc) ;Call appropriate procedure If TKKeyType <> "X" Then If Not Retval ;Key wasn't accepted, or was Then Loop ; reset to a new value Endif Endif Endif Retval = True Switch Case Search(TKKeyType,"XS") <> 0 : ;Processed next Switch stmnt Case IsValid() : ;Good Depart If Search("D",TKAction[TKFieldNum]) <> 0 Then TKChanged = [] <> TKFieldVal ;Changed? Set T/F CallProc(TKGoodDepart[TKFieldNum]) Endif Otherwise: ;Bad Depart If Search("F",TKAction[TKFieldNum]) <> 0 Then CallProc(TKBadDepart[TKFieldNum]) Endif Endswitch Switch Case TKKeyType = "X" : ;TKeyType set to "X" by Special key, CheckMessage() ; Good Depart, or Bad Depart proc Echo Off ;Exit immediately Return TKChar Case Not Retval : ;Good Depart or Bad Depart rejected Loop ; or reassigned TKChar. Reprocess it. Case TKKeyType = "S" : Keypress TKChar Case IsValid() : ;Field data is valid, pending key is ExecProc TKMvmntProc ; a movement key ("S" or "M") If Search(TKKeyType,"EX") <> 0 Then CheckMessage() ;Movement-initiated proc or pending Echo Off ; key requested exit from DoWait Return TKChar Endif If Not Retval ;Movement-initiated proc rejected Then Loop ; pending key Endif Otherwise : ;Data is still invalid, can't move out of it If (TKChar = -83 or TKChar = 21 or TKChar = 0) and TKKeyType <> "E" ;If Del, Undo, or Cancel is an Exit key Then BadDelUndo() ; reject it since data is invalid If Search(TKKeyType,"EX") <> 0 Then CheckMessage() Echo Off Return TKChar Endif If not Retval Then Loop Endif Else If IsBlank(TKMessage) ;Display standard Paradox Then Keypress -72 ; message unless specified Endif ; otherwise in user procedure Endif Endswitch Endswitch CheckMessage() ; Check for message to display ExecProc TKKeyProc ; Read next key Echo Normal Endwhile Endproc ; This procedure is called by DoWait before a key is read from the keyboard. ; The procedure checks the variable TKMessage, and sends that message to the ; screen if it is non-blank. ; Proc CheckMessage() If TKMessage <> "" ;Has the user specified a message? Then Echo Off Message TKMessage SyncCursor TKMessage = "" ;Re-initialize to show no pending message Endif TKAccept = True Endproc ; This procedure examines the user-defined variable TKHoldCanvas, and turns ; echo to normal if the programmer hasn't prohibited it. DoWait calls ; CheckHoldCanvas to update the current echo status. ; Proc CheckHoldCanvas() If TKHoldCanvas Then TKHoldCanvas = False ;Re-initialize to allow removal of PAL canvas Else Echo Normal Endif Endproc ; This procedure calls a user-specified procedure, checks to see whether to ; turn echo back to normal upon return from the procedure, and determines ; whether the key that was pressed in order to invoke the procedure was ; accepted "as is" by that procedure. ; ; The procedure takes one argument, which is the name of the procedure to ; call. It returns False if the procedure does not accept the character which ; was passed to it (resets TKChar or sets TKAccept to False), or True ; otherwise. ; Proc CallProc(ProcName) ; Private ProcName ;Name of procedure to be called TKUserKey = TKChar ;Remember the key that was passed to the proc ExecProc ProcName CheckHoldCanvas() ;Turn echo back to normal if appropriate If TKKeyType = "X" ;Exit immediately from DoWait? Then Return Endif If TKAccept ;Was TKChar accepted and unchanged? Then If TKUserKey = TKChar Then Return True Endif Else CheckMessage() ;Get new character ExecProc TKKeyProc Echo Normal Endif Return False Endproc ; This procedure keypresses a cursor movement key and then calls the ; ArriveMvmnt procedure to initialize any necessary table, record, or field ; level events. DoWait calls RecMvmnt only after the appropriate good or bad ; depart procedure is executed. ; ; Note that since there is no way of knowing whether Undo will cause movement ; out of the current table, RecMvmnt will NOT call a Table Depart even if ; Undo does move the cursor to another table. See also ArriveMvmnt below. ; ; In addition to this function, the RecMvmnt procedure checks to see ; whether the movement key that was pressed was [Zoom]. This is necessary ; because [Zoom] doesn't actually cause movement into a new field until after ; a value has been entered at the zoom prompt and [Enter] has been pressed. ; Thus we must pause and wait for this to occur before actually arriving into ; a new field. ; Proc RecMvmnt() If TKChar = 26 ;Zoom key? Then WaitZoom() ;Special Zoom handling procedure If not Retval ;User cancelled Zoom Then Return False Endif TKRecMvmnt = True ;Zoom always initiates rec-level depart Else CheckRecMove() ;Record departure key? Endif If TKRecMvmnt and TKRecDepart <> "" ;Call rec-level depart if necessary Then CallProc(TKRecDepart) If TKKeyType = "X" ;Check for request to immediate exit Then Return Endif If Not Retval ;Key rejected or reassigned Then Return False Endif Endif Retval = True If (TKChar = -61 or TKChar = -62) and TKTblDepart <> "" Then CallProc(TKTblDepart) ;Call table-level depart if necessary Endif If Search(TKKeyType,"EX") <> 0 ;Check for normal or immediate exit Then Return Endif If Not Retval ;Key rejected or reassigned Then Return False Endif ArriveMvmnt() ;Initiate table->record->field arrival sequence Return True Endproc ; This procedure initiates the event arrival sequence for a movement key ; and the special invalid-field Undo, Del, Cancel case. RecMvmnt calls this ; procedure to "press" a movement key. ArriveMvmnt, in turn, will call the ; appropriate arrival procedures. ; ; If the Undo key causes movement to another table, ArriveMvmnt will properly ; call the table and record arrival events for the new table (your procedures ; consider this possibility). ; Proc ArriveMvmnt() Keypress TKChar If ImageNo() <> TKImgNo ;Did we move to a new table? Then TKRecMvmnt = True ;Will be arriving in a new record SysTblArrive() ;Call Table Arrive if assigned Endif If TKRecMvmnt ;Need to call record arrival procedure? Then SysRecArrive() ; (Did we just leave a record?) Endif SysArrive() ;Call field arrival procedure Endproc ; This procedure initiates a movement-arrival sequence for tables which ; do not have record-level events assigned to them. See RecMvmnt above ; for more information. ; Proc StdMvmnt() If TKChar = 26 ;Zoom key? Then WaitZoom() ;Call special Zoom handling procedure If not Retval ;Zoom not initiated Then Return False Endif Enter ;Zoom! SysArrive() ;Arriving in new field, call field arrival Return True ; event Endif Retval = True If (TKChar = -61 or TKChar = -62) and TKTblDepart <> "" Then CallProc(TKTblDepart) ;Call table depart, if assigned Endif If Search(TKKeyType,"EX") <> 0 ;Check for normal or immediate exit Then Return Endif If Not Retval Then Return False Endif Keypress TKChar If TKChar = -61 or TKChar = -62 ;If key caused normal movement to another Then SysTblArrive() ; table, invoke table arrival procedure Endif SysArrive() ;Reset field-dependent variables-- Return True ; we are in a new field Endproc ; This procedure determines whether a pending movement key should initiate a ; record-level event. It requires key movement codes defined by SetUpDoWait ; and additional image-specific information. ; Proc CheckRecMove() If TKChar > 0 ;Determine type of key we are about to process Then TKMvTyp = Substr(TKPosMv,TKChar,1) ;These statements are Else TKMvTyp = Substr(TKNegMv,1-TKChar,1) ; necessary because max Endif ; string length is 255 TKRecMvmnt = False ;Assume no record-level event will be generated If IsFormView() ;Form view case Then Switch Case NPages() = 1 : ; Only one page, PgUp/PgDn cause rec-event If Search(TKMvTyp,TKAction[TKFieldNum]+"") <> 0 Then TKRecMvmnt = True Endif Case PageNo() = 1 : ; First page, PgUp causes rec-event If Search(TKMvTyp,TKAction[TKFieldNum]+"") <> 0 Then TKRecMvmnt = True Endif Case PageNo() = NPages() : ; Last page, PgDn causes rec-event If Search(TKMvTyp,TKAction[TKFieldNum]+"") <> 0 Then TKRecMvmnt = True Endif Endswitch Else If Search(TKMvTyp,TKAction[TKFieldNum]+"") <> 0 Then TKRecMvmnt = True Endif Endif Endproc ; This procedure handles the special case in which a user invokes the Zoom ; command. It only allows a user to exit from Zoom by pressing either [Enter] ; or [Esc] (same as [Cancel]). Note that while a user is at the Zoom prompt, ; DoWait performs no special processing. An attempt to initiate a Zoom will ; invoke a record-level event. ; Proc WaitZoom() Zoom ;Display Zoom prompt While True TKChar = GetChar() ;Read key Switch Case TKChar = 13 : ;Zoom should be acted upon Return True Case TKChar = 27 or TKChar = 0 : ;Zoom not acted upon Esc ExecProc TKKeyProc ;Process next key Return False Case TKChar > 31 ;Press only keys valid at Zoom prompt or TKChar = 6 or TKChar = -108 or TKChar = 8 or (TKChar < -70 and TKChar > -84) or (TKChar < -114 and TKChar > -120) : Keypress TKChar Otherwise : ;Reject illegal keys Beep Endswitch Endwhile Endproc ; This procedure reads a character from the keyboard buffer. It ; facilitates the keyboard inactivity event and maintains the single-key ; type-ahead buffer. It is called by DoWait, CallProc, and WaitZoom when a ; new key is to be processed. ; ; A keyboard inactivity procedure, if assigned, is called once a second. The ; variable TKSeconds, available to the procedure, specifies the number of ; seconds elapsed without a keypress (equal to the number of times the ; inactivity procedure has been called in a row). ; ; DoWait will act upon TKBuffer, if set equal to an ASCII or IBM Extended ; code, as if a user had actually pressed the key. The keycode in TKBuffer ; take precedence over any keys already in the acutal keyboard buffer. ; Proc GetInactive() TKSeconds = 0 ;Reset TKSeconds after last keypress While True If IsBlank(TKBuffer) ;Check for a key in TKBuffer Then TKTime = Time() ;Wait (a second) for a character While Not CharWaiting() and TKTime = Time() Endwhile If CharWaiting() ;Key pressed, read keycode Then TKChar = GetChar() Quitloop Else TKSeconds = TKSeconds + 1 ;No key pressed, call TKHoldCanvas = True ; inactivity procedure ExecProc TKInactiveProc CheckHoldCanvas() ;Check canvas status CheckMessage() ;Check for message to display Endif Else TKChar = TKBuffer ;TKBuffer has a keycode. Process it ahead TKBuffer = BlankNum() ; of the keycode in acutal buffer, and Quitloop ; reset TKBuffer Endif Endwhile Endproc ; This procedure reads a character from the keyboard buffer. It is called ; instead of GetInactive() if a keyboard inactivity procedure has not been ; defined. GetKey() executes much faster than GetInactive(). Note that ; applications which do not use an inactivity procedure can still make use ; of TKBuffer. ; Proc GetKey() If IsBlank(TKBuffer) Then TKChar = GetChar() Else TKChar = TKBuffer TKBuffer = BlankNum() Endif Endproc ; This procedure is called by DoWait when Undo, Del, or Cancel (Ctrl-Break) ; is pressed and accepted while the information in the current field is ; invalid. Special handling is needed in these cases, as we do not want to ; allow exit from the WAIT while information in a field is invalid. At the ; same time, we recognize that pressing Undo, Del, or Cancel will ; automatically cause the field to be valid (by simply removing or changing ; the entire record). ; ; The problem that must be dealt with is that if Undo, Del, or Cancel is ; defined as an exit character, we must give control back to the program ; BEFORE either of these keys is pressed (acted upon). Thus we do not know ; whether the key will be pressed at all. This is not a problem if these ; keys are defined as move characters, as the keys will be pressed ; automatically (assuring the validity of the field). ; Proc BadDelUndo() TKMessage = "" ;Any user-defined message was most likely put ; up in error, as field will now become valid If TKRecMvmnt and TKRecDepart <> "" ;Del, Undo, or Cancel will cause Then CallProc(TKRecDepart) ; a record-level event If TKKeyType = "X" ;Check for immediate exit request Then Return Endif If Not Retval ;Key rejected by rec-depart proc Then Return False Endif Endif ArriveMvmnt() ;Initiate event arrival sequence Return True Endproc ; NewField is called by DoWait whenever a new field is entered. It is ; responsible for setting all field-dependent variables. You may call this ; procedure instead of ArriveField if one of your procedures causes explicit ; movement into a new field and you wish to inhibit invocation of the arrival ; procedure for the new field. ; Proc NewField() TKFieldVal = [] ;Get field entry value and index TKFieldNum = ColNo() ; into arrays for current field Endproc ; ArriveField alerts DoWait that one of your procedures has just explicitly ; moved into a new field and that DoWait should call the arrival procedure ; for the new field. Your procedures MUST call this procedure (or NewField) ; if they cause explicit movement into another field (using MOVETO or Right, ; for example). ; Proc ArriveField() CheckHoldCanvas() ;Update canvas status SysArrive() ;Initiate field arrival Endproc ; SysArrive initiates all actions associated with entering a field, including ; calling the appropriate arrival procedure if assigned. ; Proc SysArrive() NewField() If Search("A",TKAction[TKFieldNum]) <> 0 ;Is an arrival procedure assigned? Then ExecProc TKArrive[TKFieldNum] CheckHoldCanvas() Endif TKAccept = False ;If a keystroke is pending (which could happen if this Endproc ; proc were called from a user's proc), then ignore it ; ArriveRecord initiates all actions associated with arriving into a new ; record. Your procedures can call ArriveRecord to invoke a record-level ; arrival procedure for a table. ; Proc ArriveRecord() CheckHoldCanvas() ;Check canvas status SysRecArrive() Endproc ; SysRecArrive initializes field dependent variables and executes a record- ; level procedure for a table, if assigned. ; Proc SysRecArrive() NewField() ;Initialize field variables If TKRecArrive <> "" ;Call record arrival proc if assigned Then ExecProc TKRecArrive CheckHoldCanvas() Endif TKAccept = False ;If a key is pending (which could happen if this Endproc ; proc were called from a user's proc), ignore it ; This procedure initializes the DoWait procedure assignment variables ; when entering a new table image, but does not call a table arrival ; procedure if one is assigned. ; Proc NewTable() ExecProc TKDPASet[ImageNo()]+Form() TKKeyProc = "GetInactive" If IsBlank(TKInactiveProc) ;Select which keyboard procedure to use Then TKKeyProc = "GetKey" Endif TKRecMvmnt = True If TKMvmntProc = "StdMvmnt" ;Select which movement procedure to use Then TKRecMvmnt = False Endif TKImgNo = ImageNo() ;Determine current image number NewField() ;Initialize field dependent variables Endproc ; This procedure is called upon entry into a new table image by NewImage, and ; subsequently calls a table arrival procedure for the new table if one is ; assigned. ; Proc ArriveTable() CheckHoldCanvas() ;Update canvas status SysTblArrive() Endproc ; This procedure initializes DoWait procedure assignment information and ; calls a table arrival procedure for the new table if assigned. Proc SysTblArrive() NewTable() ;Define DPA set variables If TKTblArrive <> "" Then ExecProc TKTblArrive CheckHoldCanvas() Endif TKAccept = False ;If a keystroke is pending (which could happen if this Endproc ; proc were called from a user's proc), then ignore it