home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Jason Aller Floppy Collection
/
99.img
/
PDOX3-08.ZIP
/
TOOLKIT1
/
INVDEMO.SC
< prev
next >
Wrap
Text File
|
1989-09-15
|
31KB
|
679 lines
; Copyright (c) 1988, 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 2/29/88, DCY 12/18/88, DCY 4/20/89
; ****************************************************************************
; NAME: SetInvPrompt
; EVENT: Table Arrive
; TABLE: Invoice
; FORM: F
; NOTES: SetInvPrompt customizes the display prompt for the Invoice table.
; Because we've designated SetInvPrompt as a Table Arrive procedure,
; each time a user enters the Invoice table DoWait will activate it,
; displaying our customized prompt.
; ****************************************************************************
Proc SetInvPrompt()
Prompt "Entering invoice information into Invoice table.",
"Press [F1] for help, [F2] when done, [F10] for menu."
If IsBlank([Invoice No.]) ;If [Invoice No.] is blank, we must be
Then TKHoldCanvas = True ; initializing a new master invoice record.
Endif ; We want to hold the canvas up so a user won't
; see fill in of the Invoice No. and Date fields.
Endproc
Writelib DemoLib SetInvPrompt
Release Procs SetInvPrompt
; ****************************************************************************
; NAME: InitInvRec
; EVENT: Record Arrive
; TABLE: Invoice
; FORM: F
; NOTES: Called upon arrival into a record of the Invoice table, InitInvRec
; initializes information required for each invoice record. For
; example, it fills the Invoice No. with the next sequential invoice
; number and fills the Date field with the current date.
; InitInvRec also initializes the CustLink and NewCust variables.
; CustLink specifies whether a Cust record is currently linked on the
; Customer No. field. NewCust specifies whether a linked Cust record
; is a new or existing customer record.
; IMPORTANT: InitInvRec does minimal checking for conditions which can
; occur due to competition on a network. (We're assuming
; you won't be running this demo on a network).
; ****************************************************************************
Proc InitInvRec()
If IsBlank([Invoice No.]) ;If Invoice No. is blank, we're entering a new
Then Echo Off ; invoice record.
End ;Pick up the last invoice number
InvNo = 1
If not IsBlank([Invoice No.])
Then InvNo = [Invoice No.] + 1 ;Make new invoice number
CtrlPgDn
Endif
[Invoice No.] = InvNo
LockRecord
While not Retval
InvNo = [Invoice No.] + 1 ;Make new invoice number
CtrlPgDn
[Invoice No.] = InvNo ;Assign new number and attempt to post
LockRecord ; and lock record. If not successful,
Endwhile ; try, try again.
[Date] = Today() ;Secured a record, fill in the current date
[Subtotal] = 0 ;Zero summary info for the record
[Tax %] = 0
[Tax] = 0
[Discount] = 0
[Shipping] = 0
[Total] = 0
NOrderRec = 1 ;Initialize first order record key
NewCust = True ; Currently linked Cust record is a "new" record
DelCustLink = False ; Cannot delete linked Cust record
CustLink = False ; We don't yet have a customer record linked to
Endif ; this invoice
Endproc
Writelib DemoLib InitInvRec
Release Procs InitInvRec
; ****************************************************************************
; NAME: GetCustNo
; EVENT: Good Depart (field level)
; FIELD: Customer Id
; TABLE: Invoice
; FORM: F
; NOTES: GetCustNo perform several functions. First, it puts up
; an application-sensitive message about invalid customer data
; rather than allowing Paradox to put up its default message.
; Second, it provides a menu which prompts the user to view the
; current customer list or to interactively add information to the
; customer master file.
; ****************************************************************************
Proc GetCustNo()
Switch
Case TKChar = TKUndo or TKChar = TKDel or TKChar = TKCancel:
; (The record depart procedure handles these keys)
Case IsBlank([]):
TKAccept = False ;Ignore movement key pressed (remain in field)
If TKChar = TKDo_It!
Then TKChar = TKCancel
TKKeyType = "X"
Return
Endif
TKMessage = "Please enter a Customer number, or press [F1] for a list of customers"
If TKChanged ;New value-
Then ReSyncKey ; Attempt to link a customer to this Cust No.
RefreshCanvas() ;Update the canvas
[Discount %] = BlankNum() ;Zero the summary fields
[Discount] = 0
[Tax %] = 0
[Tax] = 0
CustLink = False ;Must re-check validity of this Cust No.
NewCust = True ;Determines whether linked Cust record
; can be edited. NewCust remains True
; until an existing Customer No. is linked.
Endif
Case TKChanged or not CustLink: ;Must re-link on Customer No. if user
RefreshCanvas() ; has changed Cust No.
If TKChanged
Then Message "Locating customer information..."
ReSyncKey
CustLink = IsRecLinked("Cust","Last Name") ;Cust linked?
If CustLink ;Customer is linked--update Invoice fields
Then [Discount %] = [Cust->Discount %]
[Tax %] = 0
If [Cust->State] = "CA" ;If CA resident, add
Then [Tax %] = TaxRate ; CA sales tax
Endif
NewCust = False ;Since customer already exists
; in master Cust table, don't
; allow user to edit info
Enter ;Skip over Discount % field since
Enter ;it's filled in above
ArriveField() ;Inform DoWait of explicit field
Return ; change. ArriveField will also set
Endif ; TKAccept False for us.
RefreshCanvas() ;Clear message window
Endif ;Since TKChanged is True, CustLink must be False,
; indicating that we no longer have a valid Cust No.
Message "Customer number ",[]," is not in the current customer list"
ShowMenu
"Reenter" : "Reenter the customer number.",
"NewCustomer" : "New customer, add to master customer list.",
"ShowCustomers" : "Show or search the current customer list."
To Choice
Switch
Case Choice = "ShowCustomers":
CustLookUp() ;Show lookup help
Case Choice = "NewCustomer":
Moveto "Cust" ;Add new customer info
Message "Preparing to add customer to master customer list..."
Echo Off
TKHoldCanvas = True
NewCust = True ;Specify linked Cust rec is "editable"
ArriveTable() ;Inform DoWait we've explicitly entered
; another table. Note that since we
; know we haven't assigned a Record Arrive
; or Field Arrive procedure for the Cust
; table, we won't call ArriveRecord or
; ArriveField. ArriveTable() will call
; NewField() for us.
Otherwise:
ArriveField()
;NOTE: We need to call NewField here because although we have not
; actually moved the cursor out of the current field, the
; contents of the field could have possibly changed. For
; example, if a user enters two non-existing Customer No.'s
; in a row but selects "Reenter" from the menu, the field value
; will have changed--we'll be in a "different" field.
Endswitch
Endswitch
Endproc
Writelib DemoLib GetCustNo
Release Procs GetCustNo
; ****************************************************************************
; NAME: IsRecLinked
; EVENT: N/A
; NOTES: IsRecLinked is a general-purpose procedure which determines whether
; there are any records in a given table image. It is especially
; useful for cases in which you want to know whether any records are
; linked to a field in a multi-table form.
; IsRecLinked requires the name of the table of interest and the name
; of a field within the table. It returns a value of True if there
; is at least one record within the table. Otherwise, it returns a
; value of False.
; ****************************************************************************
Proc IsRecLinked(LinkTbl,LinkFld)
Private;LinkTbl, ;Table with linked record in question
;LinkFld, ;Arbitrary field in LinkTbl
RecExists, ;Specifies link status of a record
ErrorProc ;Name of error-handling procedure
Proc NoRecExists() ;If there are no records in the specified
RecExists = False ; image, Paradox will invoke this errorproc.
Return 1 ; The errorproc then sets RecExists false.
Endproc ; Otherwise, RecExists will remain True.
ErrorProc = "NoRecExists"
RecExists = True
Execute "FldVal = ["+LinkTbl+"->"+LinkFld+"]"
Release Procs NoRecExists
If RecExists ;Errorproc set RecExists False, no records
Then Return True ; are in the specified image.
Endif
Return False
Endproc
Writelib DemoLib IsRecLinked
Release Procs IsRecLinked
; ****************************************************************************
; NAME: CustLookUp
; EVENT: N/A
; FIELD: Customer No.
; TABLE: Invoice
; NOTES: Ordinarily a procedure to invoke lookup-style help from within DoWait
; can actually issue a Help command and enter true Paradox lookup help.
; However, because in our demonstration we allow for dynamic additions
; to the Cust table through a multi-table form, we can't assign an
; actual Paradox lookup help table to the Customer No. field. Doing so
; would not allow us to move to the embedded Cust table and add a new
; Cust record. (We could not leave an invalid value in the Customer No.
; field.)
; To allow for lookup-style help, we place the Cust table on the
; workspace along with the Invoice table before beginning to edit. Then
; to view the existing customer list, we toggle out of the Invoice form
; and move to the Cust table. We use the Toolkit's LookupSelect
; procedure to determine the key a user presses to exit help.
; ****************************************************************************
Proc CustLookUp()
RefreshCanvas()
UnLockRecord ;Need to unlock record before toggling to table view
FormKey ;Move to "lookup" table
Moveto [Cust->Last Name]
Prompt "Viewing current master customer list.", ;Set customized prompt
"Press [F2] to select a customer or [Esc] to cancel."
LookupSelect() ;Begin "lookup" help interaction
ExitKey = Retval
CustNo = [Customer No.]
DownImage ;Return to Invoice table
FormKey
LockRecord
SetInvPrompt() ;Reset editing prompt
TKAccept = False ;Instruct DoWait to ignore key that invoked lookup help
If ExitKey = TKDo_It! ;User pressed Do-It!
Then [Customer No.] = CustNo ;Copy Customer No. into Invoice record
ReSyncKey ;Link the customer information
[Discount %] = [Cust->Discount %] ;Copy default discount value
[Tax %] = 0
If [Cust->State] = "CA" ;Only charge CA sales tax to CA residents
Then [Tax %] = TaxRate
Endif
CustLink = True ;We now have a valid customer linked
NewCust = False ;Customer already exists in master file
Enter ;Move user to Method of Payment field
Enter ; and inform DoWait we've arrived in a
ArriveField() ; new field.
Endif
Endproc
Writelib DemoLib CustLookUp
Release Procs CustLookUp
; ****************************************************************************
; NAME: ReCalcDisc
; EVENT: Good Depart (field level)
; FIELD: Discount %
; TABLE: Invoice
; FORM: F
; NOTES: ReCalcDisc examines TKChanged to determine if a user has changed the
; value of the field since entering it. If so, it calls the CalcTotals
; procedure which recalculates the totals for the invoice record.
; ****************************************************************************
Proc ReCalcDisc()
If IsBlank([])
Then [] = 0
Endif
If TKChanged
Then CalcTotals()
Endif
Endproc
Writelib DemoLib ReCalcDisc
Release Procs ReCalcDisc
; ****************************************************************************
; NAME: BadPayMethod
; EVENT: Bad Depart (field level)
; FIELD: Method of Payment
; TABLE: Invoice
; FORM: F
; NOTES: BadPayMethod diplays a customized message in lieu of a standard
; Paradox message when a user attempts to leave the Method of
; Payment field and the field data is not one of the valid choices.
; Note we did not set TKAccept to False. Accepting a movement key
; when a field is invalid will simply cause Paradox to put up its
; standard message. Since we have provided our own message, DoWait
; will suppress Paradox's message and display ours.
; ****************************************************************************
Proc BadPayMethod()
TKMessage = "Enter a valid payment method, or press [F1] for a list of payment options"
ArriveField() ;Reinitialize field value; we're now in a "new" field since
; the value must have changed
Endproc
Writelib DemoLib BadPayMethod
Release Procs BadPayMethod
; ****************************************************************************
; NAME: SkipCredInfo()
; EVENT: Arrive (field level)
; FIELD: Credit Card No.
; TABLE: Invoice
; FORM: F
; NOTES: If a user has not entered a credit card as the method of payment,
; SkipCredInfo will clear out the credit card information fields and
; move the user to the Orders table on the next page.
; ****************************************************************************
Proc SkipCredInfo()
If [Method of Payment] = "Check" or [Method of Payment] = "Money Order"
Then [Credit Card No.] = ""
[Expiration Date] = BlankDate()
RefreshCanvas()
Moveto "Orders" ; require credit card info.
ArriveTable() ; Skip to Orders table.
Endif
Endproc
Writelib DemoLib SkipCredInfo
Release Procs SkipCredInfo
; ****************************************************************************
; NAME: ControlMvmnt
; EVENT: Good Depart (field level)
; FIELD: Ship Via
; TABLE: Invoice
; FORM: F
; NOTES: ControlMvmnt zeroes the Shipping field of the Invoice table if a user
; does not enter a carrier service. It also redirects a user's move-
; ment such that any attempt to move upwards will take the user to the
; Orders table. Since it is the last field of the record, moving to
; the right (Enter) will initiate the record departure procedure for
; the Invoice table.
; Note that we need to zero the Shipping field since it plays a part in
; the calculation of the total amount of the current invoice record.
; The record depart procedure in this case will prevent a user from
; posting his changes without specifying a valid carrier.
; ****************************************************************************
Proc ControlMvmnt()
If IsBlank([])
Then [Shipping] = 0
Endif
If TKChanged
Then Echo Off
DownImage
Locate [Invoice->Ship Via]
UpImage
[Shipping] = [Carriers->Charge]
CalcTotals()
Endif
If TKChar = TKLeft or TKChar = TKReverseTab or TKChar = TKUp
Then UpImage ;Redirect movement to Orders table
ArriveTable() ;Note that resetting TKChar would instruct DoWait to
; process the TKUpImage key. This would in turn re-
; invoke this procedure, the record depart procedure,
; and a table depart (if there were one).
Endif
Endproc
Writelib DemoLib ControlMvmnt
Release Procs ControlMvmnt
; ****************************************************************************
; NAME: PayOptions
; EVENT: N/A
; FIELD: Method of Payment
; TABLE: Invoice
; FORM: F
; NOTES: PayOptions is called by the Invoice's Special key procedure when
; the special key pressed is [F1] (Help) and the field is in the Ship
; Via field. PayOptions calls the Toolkit's Popup procedure to display
; a popup-style menu. If the user makes a selection from the popup
; menu, PayOptions sets TKBuffer to [Enter] which will move the user to
; the next field. Note that the FillCarrier procedure, the Good Depart
; procedure for the Method of Payment field, will then redirect the
; user to either the Orders table or the credit card info fields as
; appropriate.
; ****************************************************************************
Proc PayOptions()
TKAccept = False
Popup(16,25,1,5)
If not IsBlank(Retval)
Then [] = Retval ;Fill the field with the value
If [] <> "Check" and [] <> "Money Order" ;Do we need credit card
Then [Credit Card No.] = "" ; info? If not, clear
[Expiration Date] = BlankDate() ; it out.
Endif
If IsBlank(TKFieldVal) ;If the field was empty on arrival, then
or ([] <> "Check" and [] <> "Money Order")
Then TKBuffer = TKEnter ; initiate controlled movement to next
Endif ; appropriate field (DoWait will act upon TKBuffer BEFORE
Endif ; TKChar, activating the ValidPay (Good Depart) procedure).
ArriveField()
Endproc
Writelib DemoLib PayOptions
Release Procs PayOptions
; ****************************************************************************
; NAME: ReqCredInfo
; EVENT: Good Depart (field level)
; FIELD: Credit Card No., Expiration Date
; TABLE: Invoice
; FORM: F
; NOTES: This procedure ensures that a user enters a credit card number and
; card expiration date before leaving the field. It also displays a
; customized message when the user attempts to leave the field empty.
; If a user presses Del, it clears the Credit Card No. and Expiration
; Date fields. It also moves the user out of the Expiration Date field
; (when the date is valid) and into the Orders table.
; ****************************************************************************
Proc ReqCredInfo()
If TKChar = TKDel ;User wants to select another payment method
Then [Credit Card No.] = "" ;Clear out credit card info
[Expiration Date] = BlankDate()
Moveto [Method of Payment] ;Return to Method of Payment field
Else If IsBlank([])
Then TKAccept = False
If TKFieldNum = 8 ;Is user in card no. or date field?
Then TKMessage = "Please enter the customer's credit card number"
Else TKMessage = "Please enter the expiration date for this customer's credit card"
Endif
Else If TKFieldNum = 8
Then Enter ;Move to date field
Else If [] >= Today()
Then PgDn ;Move to Orders table
UpImage
ArriveTable(); Inform DoWait
Else TKMessage = "This credit card has expired"
Endif
Endif
Endif
Endif
ArriveField() ;ArriveField sets TKAccept to False for us
Endproc
Writelib DemoLib ReqCredInfo
Release Procs ReqCredInfo
; ****************************************************************************
; NAME: LeaveFullDate
; EVENT: Keystroke (field level)
; FIELD: Expiration Date
; TABLE: Invoice
; FORM: F
; NOTES: LeaveFullDate examines the effect of each keystroke to determine
; whether a date is complete. When the date a user enters matches one
; of the valid date patterns, LeaveFullDate automatically moves the
; user to the Orders table on the next page of the form.
; ****************************************************************************
Proc LeaveFullDate()
Keypress TKChar ;Let Paradox press the character (it will reject bad keys)
If Match(FieldStr(),"../../@@") ;Is the field complete?
or Match(FieldStr(),"..-..-@@")
Then If IsValid() ;Pattern is complete, but is date valid?
Then If [] < Today() ;Credit card still valid?
Then TKMessage = "This credit card has expired"
ArriveField()
Else Enter ;Move to next page,
UpImage ; move to Orders table,
ArriveTable() ; and inform DoWait.
Endif
Else TKChar = TKRight ;Because we know the field contains
Endif ; invalid data, pressing a movement key will display the
; standard Paradox message
Else TKAccept = False ;Since we already keypressed the character, we
Endif ; want DoWait to ignore it
Endproc
Writelib DemoLib LeaveFullDate
Release Procs LeaveFullDate
; ****************************************************************************
; NAME: SelectCarrier
; EVENT: N/A
; FIELD: Ship Via
; TABLE: Invoice
; FORM: F
; NOTES: SelectCarrier facilitates lookup help for the Ship Via field. It
; applies the Toolkit's LookupSelect procedure to the embedded Carriers
; table, copying a selected value into the Ship Via and Shipping fields
; of the Invoice table.
; ****************************************************************************
Proc SelectCarrier()
If not IsValid() ;Can't leave the Ship Via field if it's contains
Then CtrlBackspace ; invalid data
Endif
DownImage ;Move to Carriers table and display customized editing prompt
Prompt "Use cursor movement keys to select a carrier service.",
"Press [F2] to select, or [Esc] to cancel."
LookupSelect()
UpImage
If Retval = TKDo_It!
Then [Ship Via] = [Carriers->]
[Shipping] = [Carriers->Charge]
CalcTotals()
Endif
ArriveTable() ;ArriveTable will call SetInvPrompt (which will reset the
; editing prompt) and set TKAccept to False
Endproc
Writelib DemoLib SelectCarrier
Release Procs SelectCarrier
; ****************************************************************************
; NAME: PostInvRec
; EVENT: Record Depart
; TABLE: Invoice
; FORM: F
; NOTES: PostInvRec illustrates several uses of a record depart procedure.
; When a user attempts to delete a master invoice record, PostInvRec
; will delete expendable detail records, keeping linked customer
; information.
; If a user attempts to post an invoice record, PostInvRec will
; require that the Ship Via field be filled in. We could have used a
; departure procedure to prevent a user from leaving the Ship Via field
; without entering a value. This just demonstrates the use of a record
; level procedure to enforce record-level validity checking.
; If a user has filled in all necessary information and attempts to
; leave the master invoice record, PostInvRec will ask for confirmation
; before actually posting the changes.
; ****************************************************************************
Proc PostInvRec()
Switch
Case TKChar = TKDel:
RefreshCanvas()
TKAccept = False
ShowMenu
"Cancel" : "Do not delete the current invoice record.",
"OK" : "Go ahead and delete the current invoice record."
To C
If C = "OK"
Then Message "Deleting invoice record..."
If TKFieldNum = 7 ;If we're in the required field, we'll
Then RequiredCheck Off ; need to be sure we can delete
Endif ; the record.
Moveto "Orders"
While NImageRecords() <> 1 ;Delete linked order records
Del
Endwhile
Del
Moveto [Invoice->Customer No.]
If RecNo() = 1 ;If there's only one record in the table
Then Del ; before we delete it, a new record will
Do_It! ; automatically be opened up for us.
CoEditKey
FormKey
Else Del ;Otherwise, we need to open up a record
Do_It! ; at the end of the table
End
CoEditKey
CtrlPgDn ;Open up new record
Endif
RequiredCheck On
TKHoldCanvas = True ;Hide canvas until record is re-filled
ArriveRecord() ;Initialize new master invoice record
Endif
Case IsBlank([Ship Via]): ;Don't allow user to post record if Ship Via
TKMessage = "Enter a carrier service or press [F1] for a list of possible carriers"
Moveto [Ship Via] ; field is blank.
ArriveField() ;Inform DoWait we're in a new field. ArriveField
; will set TKAccept False, rejecting the pending key
Otherwise: ;Assume that cursor movement attempting to move to the next
RefreshCanvas() ; invoice record is an attempt to post the record
TKAccept = False
C = "Post"
If TKChar <> TKDo_It! ;Otherwise, ask for confirmation...
Then ShowMenu
"Resume" : "Resume adding information to invoice.",
"Post" : "Post changes made to this invoice to the master file."
To C
Endif
If C = "Post"
Then Message "Posting invoice record..."
CtrlHome
CtrlPgDn ;Open up a new record
ArriveRecord() ;Initialize new master invoice record
Endif
Endswitch
Endproc
Writelib DemoLib PostInvRec
Release Procs PostInvRec
; ****************************************************************************
; NAME: InvSpclKey
; EVENT: Special key
; TABLE: Invoice
; NOTES: InvSpclKey is called whenever a Special key is pressed within the
; Invoice table. Because many special keys can be classified as
; Special keys, InvSpclKey must first determine which key the user
; pressed.
; ****************************************************************************
;
Proc InvSpclKey()
RefreshCanvas()
Switch
Case TKChar = TKHelp : ;The special key was Help
Switch
Case TKFieldNum = 4 : ;Help was pressed from Cust No. field
CustLookUp() ;Show Cust lookup help
Case TKFieldNum = 7 : ;Help for Method of Payment field
PayOptions() ;Show popup help of payment options
Case TKFieldNum = 10 : ;Help for Ship Via field
SelectCarrier() ;Show Carrier help
Endswitch
Case (TKChar = TKDownImage or TKChar = TKUpImage) and IsValid():
If PageNo() = 1
Then If CustLink ;Only allow movement into Cust table if
Then UpImage ; a customer record is linked
ArriveTable() ;Moved to a new table, inform DoWait
Else TKMessage = "Cannot move to Cust table without a valid Customer No."
Endif
Else UpImage ;On second page, can only move to Orders
ArriveTable() ;Moved to a new table, inform DoWait
Endif
Case TKChar = TKMenu : ;The special key was [F10] Menu
EditMenu() ;Show the Toolkit's simple edit menu
If TKChar = TKCancel ;User selected Cancel,
Then TKHoldCanvas = True ; Keep the canvas up until final exit
TKKeyType = "X" ; Want immediate exit from DoWait,
Endif ; skipping departure procedures
Case TKChar = TKUndo:
Undo
If IsBlank([Date]) ;Date will be empty if Undo undoes first
Then TKHoldCanvas = True ; change to record
RequiredCheck Off
Del
Message "Deleting invoice record..."
CtrlHome
CtrlPgDn ;Open up a new record
ArriveRecord() ;Initialize new master invoice record
RequiredCheck On
Endif
ArriveField()
Case TKChar = -46: ;[Alt][C] should toggle commentary mode
ToggleCommentary() ;Toggles commentary mode
Endswitch
Endproc
Writelib DemoLib InvSpclKey
Release Procs InvSpclKey