home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
High Voltage Shareware
/
high1.zip
/
high1
/
DIR2
/
CLATPL.ZIP
/
CLARION.TPL
next >
Wrap
Text File
|
1993-07-26
|
13KB
|
292 lines
#!------------------------------------------------------------------------------
#!
#! The Clarion Template File
#!
#! CLARION.TPL is the first of a chain of template files that contain the
#! standard Clarion procedure templates. These templates generate CUA
#! compliant, text-based applications. Other files in the template chain
#! are CLARION1.TPX, CLARION2.TPX, and so forth.
#!
#! Initial screen, report, and action images are contained in corresponding
#! application files with an extension of .APP (e.g. CLARION.APP).
#!
#! Template Directory
#!
#! CLARION1.TPX Batch Sequential record processing of a file.
#! CLARION3.TPX Browse Browse records directly from a file
#! CLARION6.TPX Child Update a batch of Child records
#! CLARION1.TPX External Document external procedure call
#! CLARION8.TPX File Select a file from a directory listing
#! CLARION4.TPX Form Update a record with a form
#! CLARION3.TPX List List a file's records from a memory queue
#! CLARION3.TPX Lookup Setup procedure to lookup a field
#! CLARION2.TPX Menu Execute a procedure from a pop-up menu
#! CLARION.TPL Module Initialize a module
#! CLARION4.TPX MultiPage Update a file with a multiple page entry form
#! CLARION4.TPX PageOf Data entry 'Page' used with the MultiPage Form
#! CLARION1.TPX Print Print a report from memory
#! CLARION.TPL Program Initialize a program
#! CLARION2.TPX Pulldown Execute a procedure from a pulldown menu
#! CLARION8.TPX Redirect Select destination for a report
#! CLARION7.TPX Report Print a report
#! CLARION1.TPX Screen Process any screen
#! CLARION3.TPX Select Load a selected record into memory
#! CLARION1.TPX Source Process any source code
#! CLARION1.TPX Todo Undefined procedure code
#! CLARION3.TPX Validate Edit procedure to lookup a field
#! CLARION8.TPX View View a selected text file in a listbox
#! CLARION9.TPX #GROUPs Groups used by multiple templates
#!
#!------------------------------------------------------------------------------
#PROGRAM
#!------------------------------------------------------------------------------
#!
#! The Program Template
#!
#! The Program template generates the PROGRAM statement, MAP structure,
#! FILE structures, and global declarations for a Clarion program. This
#! template also blanks the screen and calls the first procedure. There
#! is only one #PROGRAM segment in a template file chain.
#!
#!------------------------------------------------------------------------------
#PROMPT('Enable &Shared Files',CHECK),%SharedFiles
#PROMPT('Enable Mouse Support',CHECK),%MouseSupport
#PROMPT('Enhanced Background?',CHECK),%EnhancedBackground
#PROMPT('Close Unused &Files?',CHECK),%CloseFiles
#PROMPT('If &File Not Found',OPTION),%FileNotFound
#PROMPT('Create',RADIO)
#PROMPT('Halt',RADIO)
#PROMPT('Program &Author',@S30),%Author
#!
#IF(%SharedFiles)
#SET(%AccessMode,'42h')
#ELSE
#SET(%AccessMode,'22h')
#ENDIF
TITLE('%Program')
OMIT('╝')
╔════════════════════════════════════════════════════════════════════════════╗
║ Program - %Program #<! ║
║ Author - %Author #<! ║
╚════════════════════════════════════════════════════════════════════════════╝
PROGRAM
INCLUDE('KEYCODES.EQU')
INCLUDE('CLARION.EQU')
INCLUDE('ERRORS.EQU')
MAP
#IF(%CloseFiles)
CheckOpen(*FILE),BYTE
#ELSE
CheckOpen(*FILE)
#ENDIF
DiskError(<STRING>),BYTE
ShowWarning
%ModuleStructures
END
EJECT('File Layouts')
%GlobalData
#FOR(%AppFiles)
#FIX(%File,%AppFiles)
%FileStructure
#ENDFOR
AddRecord EQUATE(1) #<! Add a new record
ChangeRecord EQUATE(2) #<! Change the current record
DeleteRecord EQUATE(3) #<! Delete the current record
#EMBED('Data Section')
CODE
#EMBED('Setup Program')
LOADSYMBOLS #<!Display graphic mouse
#IF(%EnhancedBackground)
SETNOBLINK #<!Enable enhanced colors
#ENDIF
#IF(%HelpFile)
HELP('%HelpFile') #<!Open the help file
#ENDIF
#IF(%StyleFile )
GETSTYLES('%StyleFile') #<!Open the style file
#ENDIF
#IF(%MouseSupport)
SETMOUSE(1,1) #<!Turn on mouse
#ENDIF
SETCOLOR(WhiteOnBlack) #<!Set white on black
BLANK #<!Clear the screen
SETCOLOR #<!Turn off override color
%FirstProcedure #<!Call the first procedure
#EMBED('Before return to DOS')
RETURN #<!Return to DOS
OMIT('╝')
╔════════════════════════════════════════════════════════════════════════════╗
║ Check ERROR() function after opening a file ║
╚════════════════════════════════════════════════════════════════════════════╝
#IF(%CloseFiles) #!Generate function for close
CheckOpen FUNCTION(File)
CODE
OPEN(File,%AccessMode) #<!Attempt to open the file
CASE ERRORCODE() #<! and check for errors
OF NoError #<!Return opened flag
RETURN(1) ! signal successful open
OF IsOpenErr #<! or if already open.
RETURN(0)
#IF(%FileNotFound <> 'Halt')
OF NoFileErr #<!If file was not found
CREATE(File) #<!Create the file
OPEN(File,%AccessMode) #<! then open it
IF ~ERRORCODE() THEN RETURN(1). #<! And return if it opened
#ENDIF
OF InvalidFileErr #<!Invalid Record Declaration
GLO:Message1 = 'Error accessing: '& NAME(File)
GLO:Message2 = 'Code: ' & ERRORCODE() & ' ' & ERROR()
GLO:Message3 = 'Press OK to return to DOS'
ShowWarning
HALT(InvalidFileErr)
OF BadKeyErr #<!Key Files must be rebuilt
GLO:Message1 = NAME(File) & ' Key file is invalid'
GLO:Message3 = 'Press OK to rebuild keyfile'
ShowWarning
OPEN(File,12H) !Open for exclusive access
BUILD(File) !Rebuild the key files
IF ERRORCODE()
GLO:Message1 = NAME(File) & ' The file cannot be repaired'
GLO:Message2 = 'while other stations are using it'
GLO:Message3 = 'Press OK to return to DOS'
ShowWarning
HALT(BadKeyErr)
ELSE
CLOSE(File) !Close
OPEN(File,%AccessMode) #<! then re-open it
RETURN(1) ! signal successful open
END
END #<!End of Case Structure
IF DiskError(NAME(File) & ' File could not be opened') THEN HALT(0). #<!Cannot resume
#ELSE #!Generate procedure
CheckOpen PROCEDURE(File)
CODE
OPEN(File,%AccessMode) #<!Attempt to open the file
CASE ERRORCODE() #<! and check for errors
OF NoError #<!Return if no error
OROF IsOpenErr #<! or if already open.
RETURN
#IF(%FileNotFound <> 'Halt')
OF NoFileErr #<!If file was not found
CREATE(File) #<!Create the file
OPEN(File,%AccessMode) #<! then open it
IF ~ERRORCODE() THEN RETURN. #<! And return if it opened
#ENDIF
OF InvalidFileErr #<!Invalid Record Declaration
GLO:Message1 = 'Error accessing: '& NAME(File)
GLO:Message2 = 'Code: ' & ERRORCODE() & ' ' & ERROR()
GLO:Message3 = 'Press OK to return to DOS'
ShowWarning
HALT(InvalidFileErr)
OF BadKeyErr #<!Key Files must be rebuilt
GLO:Message1 = NAME(File) & ' Key file is invalid'
GLO:Message3 = 'Press OK to rebuild keyfile'
ShowWarning
OPEN(File,12H) #<!Open for exclusive access
BUILD(File) #<!Rebuild the key files
IF ERRORCODE()
GLO:Message1 = NAME(File) & ' The file cannot be repaired'
GLO:Message2 = 'while other stations are using it'
GLO:Message3 = 'Press OK to return to DOS'
ShowWarning
HALT(BadKeyErr)
ELSE
CLOSE(File) #<!Close
OPEN(File,%AccessMode) #<! then open it
END
END #<!End of Case Structure
IF DiskError(NAME(File) & ' File could not be opened') THEN HALT(0). #<!Cannot resume
#ENDIF
OMIT('╝')
╔════════════════════════════════════════════════════════════════════════════╗
║ Check ERROR() function after a disk access ║
╚════════════════════════════════════════════════════════════════════════════╝
DiskError FUNCTION(Cause)
StopMsg:: STRING(180)
CODE
IF ~ERRORCODE() THEN RETURN(0). #<!Return with no error
IF ~OMITTED(1) #<!If a cause was given
StopMsg:: = 'Cause: ' & Cause & LF:CR #<! Display it
END #<!End IF
IF ERRORFILE() #<!If error involves a file
StopMsg:: = CLIP(StopMsg::) & 'File : ' | #<! display the file
& ERRORFILE() & LF:CR
END #<!End IF
StopMsg:: = CLIP(StopMsg::) & 'Error: ' | #<!Display the error code
& ERRORCODE() & ' - ' | #<! and the error message
& ERROR() & LF:CR
STOP(StopMsg::) #<!Stop with message
RETURN(1) #<!Return with error
OMIT('╝')
╔════════════════════════════════════════════════════════════════════════════╗
║ Display a warning message using 3 Global message variables. ║
╚════════════════════════════════════════════════════════════════════════════╝
ShowWarning PROCEDURE
SaveStyle STRING(256)
Screen SCREEN(9,53),PRE(SCR),CENTER,SHADOW,CUA,COLOR(112)
ROW(1,1) STRING('█▀{51}█'),COLOR(116)
ROW(9,1) STRING('█▄{51}█'),COLOR(116)
REPEAT(7)
ROW(2,1) STRING('█'),COLOR(116)
ROW(2,53) STRING('█'),COLOR(116)
.
ROW(3,5) ENTRY(@S45),USE(GLO:Message1),INS,SKIP,COLOR(112,112,112)
ROW(4,5) ENTRY(@S45),USE(GLO:Message2),INS,SKIP,COLOR(112,112,112)
ROW(5,5) ENTRY(@s45),USE(GLO:Message3),INS,SKIP,COLOR(112,112,112)
ROW(7,24) BUTTON(' &Ok |'),SHADOW,USE(?Ok),COLOR(23,71,24,31,79)
.
CODE
SaveStyle = STYLES() #<!Save current style
GETSTYLES('') #<!Turn off Styles
GLO:Message1 = CENTER(GLO:Message1,SIZE(GLO:Message1))
GLO:Message2 = CENTER(GLO:Message2,SIZE(GLO:Message2))
GLO:Message3 = CENTER(GLO:Message3,SIZE(GLO:Message3))
OPEN(Screen)
DISPLAY
ACCEPT #<!Enable keyboard and mouse
CLEAR(GLO:MessageGroup) #<!Blank out message fields
SETSTYLES(SaveStyle) #<!Restore user styles
RETURN
#!
#MODULE
#!------------------------------------------------------------------------------
#!
#! The Module Template
#!
#! The Module template generates the MEMBER statement, and module
#! level data declarations for a source module of a Clarion program.
#! There is only one #MODULE segment in a template file chain.
#!
#!------------------------------------------------------------------------------
MEMBER('%Program')
OMIT('╝')
╔════════════════════════════════════════════════════════════════════════════╗
║ %Module - %ModuleDescription #<! ║
╚════════════════════════════════════════════════════════════════════════════╝
%ModuleData
#EMBED('Data Section')
#!
#CHAIN('CLARION1.TPX')