High Voltage Shareware

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

/ High Voltage Shareware / high1.zip / high1 / DIR36 / C7101.ZIP / FORM.TPX < prev next >

Wrap

Text File | 1994-02-01 | 22KB | 464 lines

#!┌───────────────────────────┤Template Segment├───────────┬─────────────────┐ #!│ Form.TPX │Version: 3007.101│ #!├───────────────────────────────┤Contents├───────────────┴─────────────────┤ #!│Structure Type Description │ #!│──────────────────── ───────── ─────────────────────────────────────────│ #!│ PROCEDURE Update a browse or lookup with a form │ #!├───────────────────────────────┤Comments├─────────────────────────────────┤ #!│Version Comments │ #!│──────── ────────────────────────────────────────────────────────────────│ #!│3007.000 Release of CDD3 version 3007 templates │ #!│3007.100 Repaired Form Procedure │ #!│3007.101 Added #PROMPT to Form Procedure │ #!└──────────────────────────────────────────────────────────────────────────┘ #! #PROCEDURE(Form,'Update a browse or lookup with a form'),SCREEN,PULLDOWN #! #!┌──────────────────────────┤Procedure Template├──────────┬─────────────────┐ #!│ Form │Version: 3007.101│ #!├──────────────────────────────┤Description├─────────────┴─────────────────┤ #!│The Form Template generates a file update procedure. A procedure │ #!│generated with this template assumes that: │ #!│ 1. Keycode will be Enter, Insert or Delete upon procedure initialization│ #!│ 2. If Keycode is Enter or Delete, the record buffer contains a valid │ #!│ record, and that record reflects the current active record of Primary│ #!│ 3. If Keycode is Insert, the record buffer contains a cleared record, │ #!│ with any necessary key fields primed. │ #!│Upon completion of Editing or deleting a record, the Form procedure will │ #!│process any files referenced to Primary in a 1:Many constrained │ #!│relationship. │ #!├───────────────────────────────┤Comments├─────────────────────────────────┤ #!│Version Comments │ #!│──────── ────────────────────────────────────────────────────────────────│ #!│3007.000 Release of CDD3 version 3007 templates │ #!│3007.100 Repaired CANCEL code (on single entry forms, called as deletes, │ #!│ the CANCEL field code should not perform a GET(file,0). This │ #!│ repair fixes a problem with cancelled deletes affecting totals │ #!│ on the calling browse procedure. │ #!│3007.101 Added "Disable RI Logout" Prompt. This prompt is added to allow│ #!│ the disabling of the LOGOUT function during RI Updates and │ #!│ Deletes. This is necessary if RI Code is generated to handle │ #!│ multiple relations between files. │ #!└──────────────────────────────────────────────────────────────────────────┘ #! #PROTOTYPE('') #PROMPT('Insert message',@S30),%InsertMsg #PROMPT('Chan&ge message',@S30),%ChangeMsg #PROMPT('De&lete message',@S30),%DeleteMsg #PROMPT('Action after ADD',OPTION),%AddAction #PROMPT('Return to caller ',RADIO) #PROMPT('Retain Record ',RADIO) #PROMPT('Clear Record ',RADIO) #PROMPT('Copy field hot&key:',KEYCODE),%CopyKey #PROMPT('Next &Procedure ',PROCEDURE),%NextProcedure #PROMPT('Disable RI Logout',CHECK),%NoLogoutSupport #INSERT(%StandardHeader) #INSERT(%InitFormSymbols) #INSERT(%PrimaryDriverCheck) #IF(%Primary = %NULL) #SET(%ErrorMessage,(' WARNING during Code Generation in Procedure: '& %Procedure )) #ERROR(%ErrorMessage) #SET(%ErrorMessage,( ' No File Defined In File Schematic For FORM Template ')) #ERROR(%ErrorMessage) #ENDIF %Procedure PROCEDURE %LocalData NoMoreFields BYTE(0) !No more fields flag NonStopSelect BYTE(0) #IF(UPPER(CLIP(%AddAction)) = 'RETAIN RECORD') #IF(%CopyKey) SCREEN %ScreenAttributes,ALRT(%CopyKey) %ScreenPaintDeclarations %ScreenStringDeclarations %ScreenFieldDeclarations . #IF(%SharedFiles = %NULL) #IF(%PrimaryDriver <> 'Btrieve') SAV:SaveRecord LIKE(%FilePre:Record),PRE(SAV) #ENDIF #ENDIF #ELSE %ScreenStructure #IF(%SharedFiles = %NULL) #IF(%PrimaryDriver <> 'Btrieve') SAV:SaveRecord LIKE(%FilePre:Record),PRE(SAV) #ENDIF #ENDIF #ENDIF #ELSE %ScreenStructure #ENDIF %PullDownStructure #IF(%SharedFiles OR %PrimaryDriver = 'Btrieve') RecordQueue QUEUE,PRE(SAV) !Queue for concurrency checking SaveRecord LIKE(%FilePre:Record),PRE(SAV) #<!size of primary file record #FOR(%FileMemo) #FIX(%Field,%FileMemo) SAV:%FieldID STRING(SIZE(%FileMemo)) #ENDFOR . #<!End Queue structure #ENDIF #INSERT(%FileControl) #!Declare Flags for file access AbortTransaction byte #IF(%RelatedChildList) #SET(%ProcessingFile,%Primary) #INSERT(%RelationalAccessFlds) #<!Declare link fields RI:RestrictUpdate byte RI:RestrictDelete byte #IF(%PrimaryDriver = 'Paradox3') #FIX(%File,%Primary) UpdRelation STRING(SIZE(%FilePre:Record)) #<!Position of last related record #ELSE UpdRelation STRING(10) #<!Position of last related record #ENDIF #IF(%PrimaryDriver='Btrieve') SAV:Position string(255) #ENDIF #ENDIF #IF(%PrimaryDriver = 'Paradox3') #FIX(%File,%Primary) SavePointer STRING(SIZE(%FilePre:Record)) !Position of current record AutoAddPtr STRING(SIZE(%FilePre:Record)) !Position of Autoinc record #ELSE SavePointer STRING(10) !Position of current record AutoAddPtr STRING(10) !Position of Autoinc record #ENDIF AutoIncAdd BYTE(0) !On for Autoincrement add #IF(UPPER(CLIP(%AddAction)) <> 'RETURN TO CALLER') LastPosition STRING(10) !Position of last ADD #ENDIF #IF(UPPER(CLIP(%AddAction)) = 'RETAIN RECORD') #IF(%CopyKey) #INSERT(%FieldDups) #ENDIF #ENDIF #IF(%PrimeKeysExist) #INSERT(%SavePrimedFields) #ENDIF #EMBED('Data Section') CODE #EMBED('Setup Procedure') #INSERT(%FileControl) #!Open files #INSERT(%SavePrimaryLinks) NonStopSelect = FALSE CASE KEYCODE() !What Key was pressed? OF InsKey !Insert a new record Action = AddRecord !Set action code 1 (ADD) #INSERT(%InsertMessage) #<!Message for ADD RECORD #IF(%AutoInc) DO AutoNumber !Set autonumber key field(s) #ENDIF #EMBED('On Add After Record Buffer Is Cleared') #IF(%InitRoutine) #<!Field(s) initial value DO InitializeFields !Initial values from dictionary #ENDIF OF EnterKey !Process a CHANGE request OROF MouseLeft2 !on EnterKey or double mouse Action = ChangeRecord !Set action code 2 (CHANGE) #INSERT(%ChangeMessage) #<!Message for CHANGE RECORD #IF(%SharedFiles) #INSERT(%SetupConcurrency) #<!Setup multi-user Concurrency #ENDIF OF DelKey !Process a DELETE request Action = DeleteRecord !Set action code 3 (DELETE) #INSERT(%DeleteMessage) #<!Message for DELETE RECORD SavePointer = POSITION(%Primary) #<!Position in PRIMARY file END !End CASE Keycode #FOR(%Formula) #IF(UPPER(%FormulaClass) = 'SETUP') #INSERT(%GenerateFormula) #ENDIF #ENDFOR #IF(%SecondaryExist) #<!IF schema has a Secondary DO SecondaryLookups !Read any lookup fields #ENDIF #IF(%PullDownStructure) OPEN(%PullDown) #ENDIF OPEN(%Screen) !Open the FORM screen IF Action = DeleteRecord !IF request for DELETE DISABLE(1,FIELDS()) !Disable all screen fields ENABLE(?OK) !Enable the OK and the ENABLE(?Cancel) !Cancel buttons END !End IF request for delete #EMBED('Setup Screen') #SET(%ProcessingFile,%Primary) DISPLAY !Display screen fields LOOP !Begin Main process loop #EMBED('Beginning of Accept Loop') #IF(%SecondaryExist) #<!IF File schema has Secondary #INSERT(%SecondaryChanged) #ENDIF #IF(%LoopFormulasExist = 'Y') #<!Are there Formula fields? #SET(%GenerateFormulasOn,'Y') DO FormulaFields !Calculate Formula fields #ENDIF CASE SELECTED() !Process selected Field #INSERT(%ScreenSetupRoutines) OF NoMoreFields !User pressed Enter or OK #EMBED('Before File I/O') CASE Action !Process requested Action OF AddRecord !Action = 1 (ADD) ADD(%Primary) #<!Add Record to Primary file OF ChangeRecord !Action = 2 (Change) #IF(%SharedFiles) #!If making a network app #IF(%AutoInc) IF AutoIncAdd #<!Was this an Autonumber? #IF(UPPER(CLIP(%AddAction)) <> 'RETURN TO CALLER') LastPosition = POSITION(%Primary) #<!Save last record position #ENDIF PUT(%Primary) #<!Write the Record ELSE #<!not AutoincAdd #ENDIF DO ConcurrentWrite !Concurrent update ROUTINE IF AbortTransaction !AbortWrite is on SELECT(?Cancel) CYCLE !Let user choose response END !End AbortWrite# #ELSE #IF(UPPER(CLIP(%AddAction)) <> 'RETURN TO CALLER') LastPosition = POSITION(%Primary) #<!Save last record position #ENDIF #ENDIF #IF(%UpdateChildList) DO ConstrainedUpdate #<!Write the Record IF AbortTransaction SELECT(?Cancel) CYCLE END #ELSE PUT(%Primary) #ENDIF #IF((%SharedFiles AND %AutoInc)) END #<!IF AutoIncAdd #ENDIF OF DeleteRecord !Action = 3 (Delete) #IF(%SharedFiles) DO ConcurrentDelete IF AbortTransaction SELECT(?Cancel) CYCLE END #ENDIF #IF(%DeleteChildList) DO ConstrainedDelete #<!Write the Record IF AbortTransaction SELECT(?Cancel) CYCLE END #ELSE DELETE(%Primary) #ENDIF ELSE DO ProcedureReturn END !End CASE Action IF ERRORCODE() !Error check on File I/O #IF(%DupKeyCheck) #INSERT(%DupKeyCode) #ENDIF CASE Action !Error message based on Action OF AddRecord GLO:Message1 = 'Error attempting to ADD Record' OF ChangeRecord GLO:Message1 = 'Error attempting to CHANGE Record' OF DeleteRecord GLO:Message1 = 'Error attempting to DELETE Record' END !End CASE Action GLO:Message2 = 'The file: %Primary could not be updated' GLO:Message3 = 'Code:'&Errorcode()&': '&Error() ShowWarning !Notify the user #IF(%SharedFiles) RELEASE(%Primary) #<!Release the held record FREE(RecordQueue) !FREE the memory Queue #ENDIF DISABLE(1,FIELDS()) !Disable all the fields ENABLE(?Cancel) !Enable Cancel button SELECT(?Cancel) !and place cursor on Cancel DISPLAY !Re-display the screen CYCLE !Re-start main LOOP ELSE !Else no errorcode() #IF(%SharedFiles) FREE(RecordQueue) !Free memory from Queue #ENDIF #IF(%NextProcedure) #EMBED('Setup Next Procedure') %NextProcedure #<!Call the Next Procedure #EMBED('Return from Next Procedure') #ENDIF #IF(UPPER(CLIP(%AddAction)) <> 'RETURN TO CALLER') IF Action = AddRecord #<!If Action is AddRecord LastPosition = POSITION(%Primary) #<!Save position of last ADD END #<!End IF Action = AddRecord #ENDIF #IF(UPPER(CLIP(%AddAction)) = 'CLEAR RECORD') IF (Action = AddRecord) OR (Action = ChangeRecord AND AutoIncAdd) #INSERT(%InsertMessage) #<!Message for ADD RECORD #FIX(%File,%Primary) #INSERT(%ClearValues) DISPLAY !Update screen display #IF(%AutoInc) DO AutoNumber !Increment autonumber key #IF(%InitRoutine) DO InitializeFields !Initial value from DataDictionary #ENDIF DISPLAY !Display screen field #ENDIF SELECT(1) !Place cursor on 1st field #EMBED('After ADD on Retain and Clear record') CYCLE !Re-start main LOOP END !End IF (Action = ....) #ELSIF(UPPER(CLIP(%AddAction)) = 'RETAIN RECORD') IF (Action = AddRecord) OR (Action = ChangeRecord AND AutoIncAdd) #IF(%CopyKey <> %NULL) DO SaveScrFlds #<!Save the Screen fields #INSERT(%InsertMessage) #<!Message for ADD RECORD DISPLAY !Update screen display #FIX(%File,%Primary) CLEAR(%FilePre:Record) #<!Clear the record buffer #ELSE #IF(%AutoInc) SAV:SaveRecord = %FilePre:Record #<!Save the record buffer #ENDIF #ENDIF DISPLAY #IF(%AutoInc) DO AutoNumber !Increment autonumber key %FilePre:Record = SAV:SaveRecord #<!Restore saved record #INSERT(%RestoreAuto) #<!Restore AutoNumber(s) DISPLAY !Display screen fields #ENDIF SELECT(1) !Place cursor on 1st field #EMBED('After ADD on Retain and Clear record') CYCLE !Re-start main LOOP END !End IF (Action = ....) #ENDIF #!End %AddAction code BREAK !Break from main Loop END !End IF Errorcode() END !End CASE Selected() ACCEPT !Enable screen entry IF NonStopSelect IF KEYCODE() NonStopSelect = FALSE END END #IF(UPPER(CLIP(%AddAction)) = 'RETAIN RECORD') #IF(%CopyKey) #INSERT(%DupFldCall) #ENDIF #ENDIF CASE KEYCODE() OF EscKey !User pressed Escape key IF FIELD() <> ?Cancel !If user pressed Escape SELECT(?Cancel) !Select Cancel button PRESS(EnterKey) !Process Cancel button code CYCLE !Cycle to Accept END !Field was not Cancel button #IF(%HotKeysExist) #FOR(%HotKey) OF %HotKey !User defined HotKey %HotKeyProc !HotKey Procedure #ENDFOR #ENDIF END !End CASE Keycode CASE FIELD() !Process fields #FOR(%ScreenField) #IF(%ScreenFieldUse = '?Ok') OF ?Ok !On the OK button #IF(%ScreenFieldEdit <> %NULL) %ScreenFieldEdit #<!Field Edit procedure #ENDIF SELECT(1) !Start with the first field SELECT !and cycle non-stop NonStopSelect = TRUE !Set Up for Non-Stop Select SETKEYCODE(0) !Clear the KeyCode CYCLE !restart main process loop #ELSIF(%ScreenFieldUse = '?Cancel') OF ?Cancel !On Cancel button #IF(%AutoInc = 'Y') IF AutoIncAdd !ADDed autoincrement record? RESET(%Primary,AutoAddPtr) #<!Re-position record pointer NEXT(%Primary) #<!Re-read the record we added IF DiskError('Could not READ Record') !Check for file I/O error DO ProcedureReturn END !End IF Diskerror DELETE(%Primary) #<!DELETE the record IF DiskError('Record could not be Deleted') DO ProcedureReturn END !End IF Diskerror END !End IF AutoIncAdd #ENDIF #IF(%ScreenFieldEdit <> %NULL) %ScreenFieldEdit #<!Field edit procedure #ENDIF #IF(UPPER(CLIP(%AddAction)) <> 'RETURN TO CALLER') IF LastPosition #<!IF a record was added RESET(%Primary,LastPosition) #<!Position to the record NEXT(%Primary) #<!and read it ELSE #<!Else no LastPosition GET(%Primary,0) #<!signal Browse to re-read END #<!END If LastPosition #ELSE IF Action <> DeleteRecord #<! IF not called to delete GET(%Primary,0) #<! signal Browse to re-read END #<! END (IF not called...) #ENDIF DO ProcedureReturn #ELSE #INSERT(%ScreenEditRoutines) #ENDIF #ENDFOR #FOR(%PulldownField) #! add all procedure or #IF(%PulldownFieldType = 'PROCEDURE') #! source code calls OF %PulldownField #<!For a Pulldown field %PulldownFieldProc #<! execute its procedure #ENDIF #ENDFOR END !End CASE FIELD END !END MAIN PROCESS LOOP #FOR(%Formula) #IF(UPPER(%FormulaClass) = 'RETURN') #INSERT(%GenerateFormula) #<!Return Class formula #ENDIF #ENDFOR DO ProcedureReturn !───────────────────────────────────────────────────────────────────────────── ProcedureReturn ROUTINE #IF(%PullDownStructure) CLOSE(%PullDown) #ENDIF #IF(%SharedFiles) FREE(RecordQueue) #ENDIF #EMBED('Before Closing Screen') CLOSE(%Screen) #EMBED('Before Closing Files') #INSERT(%FileControl) #!Open files DO EndOfProcedureEmbed RETURN !───────────────────────────────────────────────────────────────────────────── EndOfProcedureEmbed ROUTINE #EMBED('End of Procedure') #EMBED('Custom Routines') #INSERT(%AutoIncCode) #INSERT(%ConcurrentWrite) #INSERT(%ConcurrentDelete) #INSERT(%RIUpdates) #INSERT(%RIDeletes) #INSERT(%InitQue) #INSERT(%InitFields) #INSERT(%GenFormulas) #IF(%SecondaryExist) #INSERT(%SecondaryLookups) #ENDIF #IF(UPPER(CLIP(%AddAction)) = 'RETAIN RECORD') #IF(%CopyKey) #INSERT(%SaveScrFlds) #INSERT(%DupField) #ENDIF #ENDIF #CHAIN('MultiPg.tpx')