home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Power-Programmierung
/
CD1.mdf
/
xbase
/
library
/
clipper
/
template
/
tem_mntc.prg
< prev
next >
Wrap
Text File
|
1989-01-03
|
12KB
|
376 lines
* ________.PRG
* ________________________________ FILE MAINTENANCE by _________________
* created: __/__/__
* last update: __/__/__
*
****************************************************
* NOTE: All procedures called in this program are *
* at the bottom of this program. *
* *
* All UDFs (usually prefixed with c_) are *
* located in the TEM_UDFS.PRG program file. *
****************************************************
*
*****************************************
* HELP key Initialization (if required) *
*****************************************
* SET KEY 28 TO MNTCHELP
*
********************************************
* MESSAGE line intialization (if required) *
********************************************
* SET MESSAGE TO 2
*
****************************
* Open required data files *
****************************
*
***************************************************
* Establish Relations between files (if required) *
***************************************************
*
**************************************************
* Create memory variables to be accessed by the *
* UDFs c_MEMEMPTY(), c_SCATTER(), c_GATHER() and *
* c_BLANK(). *
**************************************************
FOR memctr = 1 TO FCOUNT()
memvar = "M"+FIELDNAME(memctr)
&memvar. = .T.
NEXT
*
**********************
* Display the screen *
**********************
CLEAR
morder="________" && Master Index Order (if applicable)
@ __,__ GET morder
CLEAR GETS
* @ 03,00 SAY REPLICATE(CHR(196),79) && Single Top Border Line ala LOTUS
* @ 23,00 SAY REPLICATE(CHR(196),79) && Block Bottom Border Line ala LOTUS
*
**********************
* Display the record *
**********************
mrecno=RECNO() && Mark position in file
DO ____DISP
*
DO WHILE .T.
*
c_MTC_MENU(1,00) && UDF to display Maintenance Menu (see TEM_UDFS.PRG)
*
DO CASE
CASE mmopt=0
EXIT
*
CASE mmopt=1
****************
* ADD a record *
****************
SET CURSOR ON
DO WHILE .T.
c_MEMEMPTY() && Initialize memory variables UDF
DO ____GETS && GET routine to clear variables on screen
CLEAR GETS
@ 24,40-(LEN(mmsg)/2) SAY mmsg
*
********************
* Get KEY field(s) *
********************
@ __,__ GET ________
READ
CLEAR GETS
IF LASTKEY()=27 .OR. EMPTY(________)
**************************************************
* ESCape was pressed or no input on key field(s) *
**************************************************
IF RECCOUNT()<>0
GOTO mrecno && Reset record pointer
ENDIF
EXIT
ENDIF
mskey=________ && Initialize key variable (if multiple keys)
SEEK mskey
IF .NOT. EOF()
* Record already exists
EXIT
ENDIF
mmsg="Enter all required information or press ESCape when finished"
@ 24,0
@ 24,40-(LEN(mmsg)/2) SAY mmsg
*
DO ____GETS && GET routine to input variables
READ
CLEAR GETS
*
IF LASTKEY()<>27
******************************************
* Continue if ESCape key was not pressed *
******************************************
mreply="Y"
@ 24,0
@ 24,26 SAY "OKAY TO ADD RECORD (Y/N)?" GET mreply PICTURE "!" VALID(mreply$"YN")
READ
@ 24,0
IF mreply="Y"
SEEK c_BLANK(________) && Seek empty record (c_BLANK() is a UDF in system module)
IF EOF()
APPEND BLANK
ENDIF
***********************************************************
* Update fields with memory variables through REPLACE UDF *
***********************************************************
c_GATHER()
*
mrecno=RECNO() && Update record pointer
ELSE
IF RECCOUNT()<>0
GOTO mrecno && Reposition record pointer
ENDIF
ENDIF
ENDIF lastkey()<>27
ENDDO .t. (main ADD control loop)
*
CASE mmopt=2
*******************
* DELETE a record *
*******************
SET CURSOR ON
mreply="N"
@ 24,10 SAY "DELETE THIS RECORD (Y/N)?" GET mreply PICTURE "!" VALID(mreply$"YN")
READ
IF mreply="Y"
mreply="N"
@ 24,47 SAY "ARE YOU SURE (Y/N)?" GET mreply PICTURE "!" VALID(mreply$"YN")
READ
IF mreply="Y"
c_DATAGONE() && Replace fields with empty values UDF
GO TOP && Reposition record pointer
ENDIF
ENDIF
*
CASE mmopt=3
*****************
* EDIT a record *
*****************
SET CURSOR ON
*
c_SCATTER() && Load memory variables with field values
*
mmsg="Enter changes or press ESCape when finished"
@ 24,0
@ 24,40-(LEN(mmsg)/2) SAY mmsg
*
DO ____GETS && GET routine to input variables
READ
CLEAR GETS
IF LASTKEY()<>27
**********************************************************
* If operator did not ESCape out of EDIT, perform memory *
* variables-to-fields UDF. *
**********************************************************
c_GATHER()
ENDIF
*
CASE mmopt=4
*********************
* GO to TOP of file *
*********************
GO TOP
*
CASE mmopt=5
*********************************************************
* GOTO SPECIFIED record. This routine uses system UDFs. *
*********************************************************
SET CURSOR ON
mscreen=SPACE(4000)
****************************************
* Save the INDEX order (if applicable) *
****************************************
mindex=INDEXORD() && Save the index order
SAVE SCREEN TO mscreen && Save the screen
c_BOXIT(18,13,23,65,1,c_goto_box) && Save the whales (oops!)
c_SAYIT(19,16,"Consignee ID ........",c_goto_box)
c_SAYIT(20,16,"Name ................",c_goto_box)
c_SAYIT(22,16,"Enter Values for Search or ESCape when finished",c_goto_box)
*
DO WHILE .T.
*************************************
* Initialize key memory variable(s) *
*************************************
******************************
* GET key memory variable(s) *
******************************
READ
CLEAR GETS
*
IF LASTKEY()=27 .OR. EMPTY(________)
**************************************************
* ESCape was pressed or no input on key field(s) *
**************************************************
IF RECCOUNT()<>0
GOTO mrecno && Reset record pointer
ENDIF
SET ORDER TO mindex && Reset master index
EXIT
ENDIF
*
mskey=________ && Initialize key variable (if multiple keys)
SEEK mskey
IF EOF()
mmsg="RECORD NOT FOUND - PRESS ANY KEY TO CONTINUE"
?? CHR(7)
@ 24,0
@ 24,40-(LEN(mmsg)/2) SAY mmsg
SET CONSOLE OFF
WAIT
SET CONSOLE ON
@ 24,0
ELSE
EXIT
ENDIF
ENDDO
SET CURSOR OFF
RESTORE SCREEN FROM mscreen
RELEASE mscreen
**************************************
* Display sort order (if applicable) *
**************************************
DO CASE
CASE INDEXORD()=1
morder="__________"
CASE INDEXORD()=2
morder="__________"
*
*
*
ENDCASE
@ __,__ GET morder
CLEAR GETS
*
CASE mmopt=6
**************************
* Print displayed record *
**************************
IF ISPRINTER()
mwork=" PAGE HEADING "
SET DEVICE TO PRINT
SET MARGIN TO 10
@ 01,40-(LEN(mwork)/2) SAY mwork
@ PROW()+3,00 SAY ""
Remaining fields and headings
EJECT
SET MARGIN TO
SET DEVICE TO SCREEN
ELSE
mmsg="PRINTER NOT READY - CORRECT AND PRESS ANY KEY TO CONTINUE"
?? CHR(7)
@ 24,0
@ 24,40-(LEN(mmsg)/2) SAY mmsg
SET CONSOLE OFF
WAIT
SET CONSOLE ON
ENDIF
*
CASE mmopt=7
*********************
* GO to LAST record *
*********************
GO BOTTOM
*
CASE mmopt=8
*********************
* GO to NEXT record *
*********************
SKIP
IF EOF()
GOTO BOTTOM
ENDIF
*
CASE mmopt=9
*************************
* GO to PREVIOUS record *
*************************
SKIP -1
IF BOF()
GOTO TOP
ENDIF
*
ENDCASE
@ 24,00
**********************
* Display the record *
**********************
DO ____DISP
ENDDO
**************************
* Housekeeping functions *
**************************
CLOSE DATABASES
*
* SET KEY 28 TO HELP && Reset help program (if applicable)
* SET MESSAGE TO && Reset message line (if applicable)
SET RELATION TO && Reset data relations (if applicable)
RETURN
*
*
*****************************************
* Maintenance Program PROCEDURES follow *
*****************************************
*
*
PROCEDURE ____DISP
*
**************************
* Display current record *
**************************
*
DO WHILE EMPTY(________) .AND. .NOT. EOF()
* Find first non-blank record in file
SKIP
ENDDO
*
mrecno=RECNO() && Mark position in file
*
****************************************
* GET required data fields for display *
****************************************
*
CLEAR GETS
RETURN
*
*
*
PROCEDURE ____GETS
*
********************************
* GET non-key memory variables *
********************************
RETURN
*
*
*