home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Hall of Fame
/
HallofFameCDROM.cdr
/
data1
/
d_smpl12.lzh
/
SAMPLE.SRC
< prev
Wrap
Text File
|
1990-09-01
|
26KB
|
1,131 lines
* C_Simple(C) Ver C1.2 RiverSide Software Corp (204)477-4235
* ST. VITAL PO BOX 345 WINNIPEG MANITOBA CANADA R2M 3C5
* CLIPPER (R) EXTENDED Version Summer 87
*
* Program Name : SAMPLE.PRG
* CopyRight (C):____________________________________
* Author :____________________________________
* :____________________________________
* Date :____________________________________
* Project :____________________________________
* Comments :____________________________________
* :____________________________________
* :____________________________________
* Co-Pilot : Leslie E. Gros
*******************************************************
* Inquiry Functions supplied in C_Simple.Lib
EXTERNAL INQ_CHAR
EXTERNAL INQ_NUM
EXTERNAL INQ_DATE
EXTERNAL INQ_LOGIC
EXTERNAL INQ_COUNT
*******************************************************
SET PROCEDURE TO SAMPLE
SET DELETED ON
SET SAFETY OFF
SET EXACT OFF
SET TALK OFF
SET SOFTSEEK ON
SET EXCLUSIVE ON
* Declare Program Variables at top Level for Global Visibility
OK = .T. && Global Confirm Variable
INQ_FILTER = SPACE(0) && Inquirey Variable
SAMP_FLTR = SPACE(0) && Inquirey Variable
MAIN_SEL = SPACE(0) && Global Menu Variable
SAMP_DFLAG = .F. && Delete Flag
SAMPLE_1 = SPACE(0) && Variable for Field 1 LAST_NAME
SAMPLE_2 = SPACE(0) && Variable for Field 2 FIRT_NAME
SAMPLE_3 = SPACE(0) && Variable for Field 3 ADDRESS_1
SAMPLE_4 = SPACE(0) && Variable for Field 4 ADDRESS_2
SAMPLE_5 = SPACE(0) && Variable for Field 5 ADDRESS_3
SAMPLE_6 = SPACE(0) && Variable for Field 6 POSTAL
SAMPLE_7 = SPACE(0) && Variable for Field 7 COUNTRY
SAMPLE_8 = SPACE(0) && Variable for Field 8 AREA_CODE
SAMPLE_9 = SPACE(0) && Variable for Field 9 PHONE_NUM
SAMPLE_10 = .T. && Variable for Field 10 STATUS
SAMPLE_11 = DATE() && Variable for Field 11 LAST_TALK
SAMPLE_12 = 00000000.00 && Variable for Field 12 AMT_SALES
SAMPLE_13 = SPACE(0) && Variable for Field 13 KOMMENTS
*******************************************************
DO SAMP_SCRN && Display to Screen
SELECT 1 && Programmer SELECT Area
DO SAMP_FILE && Open dbf and indexes
DO SAMP_MAIN && Program Main Body
SELECT SAMPLE && Recall by Alias
DO SAMP_PACK && Check for Deleted Records
USE && Close the Database File
CLOSE PROCEDURE && Logical End of Module.
*******************************************************
PROCEDURE SAMP_MAIN && Main Body
SAMP_DONE = .F. && Local Flag variable
DO WHILE .NOT. SAMP_DONE
* Update ScoreBoard Header
IF .NOT. EMPTY(SAMPLE->KOMMENTS)
@ 00,25 SAY "<*MEMO*>"
ELSE
@ 00,25 SAY " "
ENDIF
IF .NOT. EMPTY(SAMP_FLTR)
@ 00,35 SAY "<*QUERY*>"
ELSE
@ 00,35 SAY " "
ENDIF
IF DELETED()
@ 00,50 SAY "<*DELETED*>"
ELSE
@ 00,50 SAY " "
ENDIF
* Update Display Information
DO SAMP_VIN && Swap Var IN from dbf
DO SAMP_GET && See Next Line
CLEAR GETS && Display data inverse on screen
* DO SAMP_SAY
* Select operation from Menu Bar
@ 23,00 CLEAR
SET MESSAGE to 24 CENTER
@23,00 PROMPT " Quit " MESSAGE "Quit SAMPLE.DBF"
@23,06 PROMPT " Add " MESSAGE "Add a New Record"
@23,11 PROMPT " Edit " MESSAGE "Edit this Record"
@23,17 PROMPT " Delete " MESSAGE "Delete this Record"
@23,25 PROMPT " Top " MESSAGE "Go to First Record"
@23,30 PROMPT " Next " MESSAGE "Next Record in File"
@23,36 PROMPT " Back " MESSAGE "Back Up one Record"
@23,42 PROMPT " Last " MESSAGE "Go to Last Record"
@23,48 PROMPT " Seek " MESSAGE "Get Record by Index"
@23,54 PROMPT " Inquire " MESSAGE "Query the database"
@23,63 PROMPT " Utility " MESSAGE "Utilities Menu"
@23,73 PROMPT " Memo " MESSAGE "Access to Memo Field"
MENU TO MENU_SEL
DO CASE
CASE MENU_SEL = 1
SAMP_DONE = .T.
LOOP
CASE MENU_SEL = 2
DO SAMP_ADD
CASE MENU_SEL = 3
DO SAMP_EDIT
CASE MENU_SEL = 4
DO SAMP_DEL
CASE MENU_SEL = 5
DO TOP
CASE MENU_SEL = 6
DO NEXT
CASE MENU_SEL = 7
DO BACK
CASE MENU_SEL = 8
DO LAST
CASE MENU_SEL = 9
DO SAMP_SEEK
CASE MENU_SEL = 10
DO SAMP_INQU
*
CASE MENU_SEL = 11
DO SAMP_UTIL
CASE MENU_SEL = 12
DO SAMP_MEMO
ENDCASE
ENDDO
*******************************************************
PROCEDURE SAMP_FILE && check files exist
IF .NOT. FILE ("SAMPLE.DBF")
DO PAUSE WITH "Warning The DBF File is MISSING "
DO CONFIRM WITH "Create New Database Shell "
IF OK
DO SAMP_CREA
ELSE
DO PAUSE WITH "Press Return to Quit"
ENDIF
ENDIF
IF .NOT. FILE ("SAMPLE.DBT")
DO PAUSE WITH "Warning MEMO File is MISSING "
DO CONFIRM WITH "Create New Database Shell "
IF OK
DO SAMP_CREA
ELSE
DO PAUSE WITH "Press Return to Quit"
ENDIF
ENDIF
USE SAMPLE.DBF
IF .NOT. FILE ("SAMPLE.NTX")
DO SAMP_NTX
ENDIF
SET INDEX TO SAMPLE.NTX
*******************************************************
PROCEDURE SAMP_CREA && create dbf
CREATE TEMP
USE TEMP
APPEND BLANK
REPLACE FIELD_NAME WITH "LAST_NAME"
REPLACE FIELD_TYPE WITH "C"
REPLACE FIELD_LEN WITH 30
REPLACE FIELD_DEC WITH 0
APPEND BLANK
REPLACE FIELD_NAME WITH "FIRT_NAME"
REPLACE FIELD_TYPE WITH "C"
REPLACE FIELD_LEN WITH 30
REPLACE FIELD_DEC WITH 0
APPEND BLANK
REPLACE FIELD_NAME WITH "ADDRESS_1"
REPLACE FIELD_TYPE WITH "C"
REPLACE FIELD_LEN WITH 20
REPLACE FIELD_DEC WITH 0
APPEND BLANK
REPLACE FIELD_NAME WITH "ADDRESS_2"
REPLACE FIELD_TYPE WITH "C"
REPLACE FIELD_LEN WITH 20
REPLACE FIELD_DEC WITH 0
APPEND BLANK
REPLACE FIELD_NAME WITH "ADDRESS_3"
REPLACE FIELD_TYPE WITH "C"
REPLACE FIELD_LEN WITH 20
REPLACE FIELD_DEC WITH 0
APPEND BLANK
REPLACE FIELD_NAME WITH "POSTAL"
REPLACE FIELD_TYPE WITH "C"
REPLACE FIELD_LEN WITH 13
REPLACE FIELD_DEC WITH 0
APPEND BLANK
REPLACE FIELD_NAME WITH "COUNTRY"
REPLACE FIELD_TYPE WITH "C"
REPLACE FIELD_LEN WITH 20
REPLACE FIELD_DEC WITH 0
APPEND BLANK
REPLACE FIELD_NAME WITH "AREA_CODE"
REPLACE FIELD_TYPE WITH "C"
REPLACE FIELD_LEN WITH 3
REPLACE FIELD_DEC WITH 0
APPEND BLANK
REPLACE FIELD_NAME WITH "PHONE_NUM"
REPLACE FIELD_TYPE WITH "C"
REPLACE FIELD_LEN WITH 8
REPLACE FIELD_DEC WITH 0
APPEND BLANK
REPLACE FIELD_NAME WITH "STATUS"
REPLACE FIELD_TYPE WITH "L"
REPLACE FIELD_LEN WITH 1
REPLACE FIELD_DEC WITH 0
APPEND BLANK
REPLACE FIELD_NAME WITH "LAST_TALK"
REPLACE FIELD_TYPE WITH "D"
REPLACE FIELD_LEN WITH 8
REPLACE FIELD_DEC WITH 0
APPEND BLANK
REPLACE FIELD_NAME WITH "AMT_SALES"
REPLACE FIELD_TYPE WITH "N"
REPLACE FIELD_LEN WITH 10
REPLACE FIELD_DEC WITH 2
APPEND BLANK
REPLACE FIELD_NAME WITH "KOMMENTS"
REPLACE FIELD_TYPE WITH "M"
REPLACE FIELD_LEN WITH 10
REPLACE FIELD_DEC WITH 0
COMMIT
USE
CREATE SAMPLE.DBF FROM TEMP.DBF
ERASE TEMP.DBF
*******************************************************
PROCEDURE SAMP_NTX && Re-Index routine
@ 24,00 CLEAR
@ 24,35 SAY "RE-INDEXING"
INDEX ON UPPER(SAMPLE->LAST_NAME) TO SAMPLE.NTX
@ 24,00 CLEAR
*******************************************************
PROCEDURE SAMP_PACK && Pack if Required
IF SAMP_DFLAG && Delete Flag
@ 23,00 CLEAR
@ 24,30 SAY "Packing Deleted Records"
PACK
@ 23,00 CLEAR
ENDIF
*******************************************************
PROCEDURE SAMP_SCRN && Screen Shell
DO COLOURS WITH "bg+/b,r+/n"
CLEAR
@ 01,00 TO 22,79 DOUBLE
@ 00,05 SAY "<** SAMPLE **>"
@ 2, 1 SAY "LAST_NAME :"
@ 3, 1 SAY "FIRT_NAME :"
@ 4, 1 SAY "ADDRESS_1 :"
@ 5, 1 SAY "ADDRESS_2 :"
@ 6, 1 SAY "ADDRESS_3 :"
@ 7, 1 SAY "POSTAL :"
@ 8, 1 SAY "COUNTRY :"
@ 9, 1 SAY "AREA_CODE :"
@ 10, 1 SAY "PHONE_NUM :"
@ 11, 1 SAY "STATUS :"
@ 12, 1 SAY "LAST_TALK :"
@ 13, 1 SAY "AMT_SALES :"
@ 14, 1 SAY "KOMMENTS :"
*******************************************************
PROCEDURE SAMP_ADD && Add New Record
DO SAMP_BLNK
DO SAMP_GET
READ
DO CONFIRM WITH "Confirm to Save New Record "
IF OK
APPEND BLANK
* Request Locking on this Record
IF .NOT. LOCK()
DO PAUSE WITH "Appended Record is Locked"
ELSE
DO SAMP_VOUT
UNLOCK
ENDIF
ENDIF
*******************************************************
PROCEDURE SAMP_EDIT && Edit Record
* Request Locking on this Record
IF .NOT. LOCK()
DO PAUSE WITH "Record is Locked by Other User"
RETURN
ENDIF
DO SAMP_VIN
DO SAMP_GET
READ
DO CONFIRM WITH "Confirm to Save Changes "
IF OK
DO SAMP_VOUT
ENDIF
UNLOCK
*******************************************************
PROCEDURE SAMP_DEL && Delete Record
* Request Locking on this Record
IF .NOT. LOCK()
DO PAUSE WITH "Record is Locked by Other User"
RETURN
ENDIF
DO CONFIRM WITH "CONFIRM TO DELETE RECORD "
IF OK
DELETE
SAMP_DFLAG = .T. && Delete Flag
DO BACK
ENDIF
UNLOCK
*******************************************************
PROCEDURE SAMP_SEEK && Index Find Routine
DO SAMP_BLNK
* DO SAMP_GET && See Next Line
* CLEAR GETS && Display data inverse on screen
DO SAMP_SAY
@ 2,15 GET SAMPLE_1 PICTURE "@S20"
READ
SEEK UPPER(SAMPLE_1)
IF .NOT. FOUND()
DO PAUSE WITH "Exact Match NOT Found"
ENDIF
*******************************************************
PROCEDURE SAMP_INQU && Inquirey Module
@ 23,00 CLEAR
DUMMY = ""
MENU_SEL = 1
SET MESSAGE to 24 CENTER && message at line 24
@ 23,00 CLEAR
@ 23,01 PROMPT " Exit " ;
MESSAGE "Exit with NO Change"
@ 23,08 PROMPT " Reset " ;
MESSAGE "Clear Query "
@ 23,16 PROMPT " Query " ;
MESSAGE "Query DataBase to Display and Selective Export"
@ 23,24 PROMPT " Count " ;
MESSAGE "Count the Number of Active Records "
MENU TO MENU_SEL
DO CASE
CASE MENU_SEL = 2
INQ_FILTER = ""
SAMP_FLTR = SPACE(0)
SET FILTER TO &SAMP_FLTR
CASE MENU_SEL= 3
INQ_FILTER = ""
DO SAMP_BLNK
DO SAMP_IGET
SAMP_FLTR = INQ_FILTER
SET FILTER TO &SAMP_FLTR
DO TOP
CASE MENU_SEL = 4
DO INQ_COUNT
ENDCASE
MENU_SEL = 10
RETURN
*******************************************************
PROCEDURE SAMP_IGET && Set a Filter Condition
* INQ_ CHAR NUM DATE LOGIC are provided in C_SIMPLE.LIB
* Link your_prog.obj c_simple.lib clipper.lib extend.lib
* These functions build a string that is used by FILTER
* First Parameter is the Variable Value
* Second parameter is the DBF Field Name
*
* LAST_NAME
@ 2,15 GET SAMPLE_1 PICTURE "@KS20" ;
VALID INQ_CHAR (SAMPLE_1,"LAST_NAME")
* FIRT_NAME
@ 3,15 GET SAMPLE_2 PICTURE "@KS20" ;
VALID INQ_CHAR (SAMPLE_2,"FIRT_NAME")
* ADDRESS_1
@ 4,15 GET SAMPLE_3 PICTURE "@KS20" ;
VALID INQ_CHAR (SAMPLE_3,"ADDRESS_1")
* ADDRESS_2
@ 5,15 GET SAMPLE_4 PICTURE "@KS20" ;
VALID INQ_CHAR (SAMPLE_4,"ADDRESS_2")
* ADDRESS_3
@ 6,15 GET SAMPLE_5 PICTURE "@KS20" ;
VALID INQ_CHAR (SAMPLE_5,"ADDRESS_3")
* POSTAL
@ 7,15 GET SAMPLE_6 PICTURE "@KS20" ;
VALID INQ_CHAR (SAMPLE_6,"POSTAL")
* COUNTRY
@ 8,15 GET SAMPLE_7 PICTURE "@KS20" ;
VALID INQ_CHAR (SAMPLE_7,"COUNTRY")
* AREA_CODE
@ 9,15 GET SAMPLE_8 PICTURE "@KS20" ;
VALID INQ_CHAR (SAMPLE_8,"AREA_CODE")
* PHONE_NUM
@ 10,15 GET SAMPLE_9 PICTURE "@KS20" ;
VALID INQ_CHAR (SAMPLE_9,"PHONE_NUM")
* STATUS
@ 11,15 GET SAMPLE_10 PICTURE "@Y" ;
VALID INQ_LOGIC (SAMPLE_10,"STATUS")
* LAST_TALK
@ 12,15 GET SAMPLE_11 PICTURE "@D" ;
VALID INQ_DATE (SAMPLE_11,"LAST_TALK")
* AMT_SALES
@ 13,15 GET SAMPLE_12 PICTURE "99999999.99" ;
VALID INQ_NUM (SAMPLE_12,"AMT_SALES")
* KOMMENTS
* @ 14,15 GET SAMPLE->KOMMENTS
READ
*******************************************************
PROCEDURE SAMP_UTIL && Utility routines
* Imports and exports can be changes to suit you needs.
* Extended Lotus and P.F.S. Import/Export can be added.
* Leslie E. Gros
MENU_SEL = 1
UT_NAME = SPACE(13)
@ 23,00 CLEAR
SET MESSAGE TO 24 CENTER
@ 23,01 PROMPT " Main Menu " MESSAGE "Return to Main Menu"
@ 23,13 PROMPT " Dos " MESSAGE "Dos Service"
@ 23,19 PROMPT " Import " MESSAGE "Import Ascii Delimited File"
@ 23,28 PROMPT " Export " MESSAGE "Export Ascii Delimited File"
@ 23,37 PROMPT " SDF in " MESSAGE "Import Ascii SDF Files"
@ 23,46 PROMPT " Out sdf " MESSAGE "Export Ascii SDF File"
@ 23,56 PROMPT " Merge ";
MESSAGE "Export Mail Merge Header and Ascii Data"
@ 23,64 PROMPT " Report ";
MESSAGE "Print Report to Printer (Query or All)"
@ 23,72 PROMPT " Labels ";
MESSAGE "Print Labels on Printer (Query or All)"
MENU TO MENU_SEL
DO CASE
CASE MENU_SEL = 1
* Do Nothing Exit
CASE MENU_SEL = 2
Do SERVICE
DO SAMP_SCRN
CASE MENU_SEL = 3
DO EXTN_NAME WITH UT_NAME
DO CONFIRM WITH "CONFIRM TO APPEND FROM " + UT_NAME
IF OK
APPEND FROM &UT_NAME DELIMITED
ENDIF
CASE MENU_SEL = 4
DO EXTN_NAME WITH UT_NAME
DO CONFIRM WITH "CONFIRM TO EXPORT TO " + UT_NAME
IF OK
COPY TO &UT_NAME DELIMITED
GO TOP
ENDIF
CASE MENU_SEL = 5
DO EXTN_NAME WITH UT_NAME
DO CONFIRM WITH "CONFIRM SDF APPEND FROM " + UT_NAME
IF OK
APPEND FROM &UT_NAME SDF
ENDIF
CASE MENU_SEL = 6
DO EXTN_NAME WITH UT_NAME
DO CONFIRM WITH "CONFIRM SDF EXPORT TO " + UT_NAME
IF OK
COPY TO &UT_NAME SDF
GO TOP
ENDIF
CASE MENU_SEL = 7
UT_NAME = SPACE(8)
DO EXTN_NAME WITH UT_NAME
COPY TO &UT_NAME DELIMITED
UT_NAME = TRIM(UT_NAME) + ".DAT"
SET ALTERNATE TO &UT_NAME
SET CONSOLE OFF
SET ALTERNATE ON
?? TRIM("LAST_NAME ") + ","
?? TRIM("FIRT_NAME ") + ","
?? TRIM("ADDRESS_1 ") + ","
?? TRIM("ADDRESS_2 ") + ","
?? TRIM("ADDRESS_3 ") + ","
?? TRIM("POSTAL ") + ","
?? TRIM("COUNTRY ") + ","
?? TRIM("AREA_CODE ") + ","
?? TRIM("PHONE_NUM ") + ","
?? TRIM("STATUS ") + ","
?? TRIM("LAST_TALK ") + ","
?? TRIM("AMT_SALES ") + ","
SET ALTERNATE OFF
CLOSE ALTERNATE
SET CONSOLE ON
GO TOP
CASE MENU_SEL = 8
DO REPORTS WITH "SAMPLE.FRM" && Report.Frm
CASE MENU_SEL = 9
DO LABELS WITH "SAMPLE.LBL" && Label.Lbl
ENDCASE
MENU_SEL = 11
RETURN
*******************************************************
PROCEDURE SAMP_MEMO && MEMO
MENU_SEL = 0
@ 23,00 CLEAR
SAMP_MSCR = SPACE(0)
SAMPLE_13 = SPACE(0)
SAMP_MSCR = SAVESCREEN(00,00,23,79)
SET MESSAGE to 24 CENTER && message at line 24
@ 23,01 PROMPT " Exit " ;
MESSAGE "Exit from the MEMO Screen Routine"
@ 23,07 PROMPT " View " ;
MESSAGE " View | Read Memo Field | No Changes Saved"
@ 23,13 PROMPT " Update " ;
MESSAGE "Update this current Memo Field"
@ 23,21 PROMPT " Delete " ;
MESSAGE "WARNING : Delete the Current MEMO"
@ 23,30 PROMPT " Hardcopy " ;
MESSAGE "Print Hard Copy to Printer"
MENU to MENU_SEL
DO CASE
CASE MENU_SEL = 2
CLEAR
@ 00,00 to 02,79 DOUBLE
@ 01,01 SAY "<ESC> to exit"
SAMPLE_13 = ;
MEMOEDIT(SAMPLE->KOMMENTS,04,00,22,79,.F.)
CASE MENU_SEL = 3
CLEAR
@ 00,00 to 02,79 DOUBLE
@ 01,01 SAY "<ESC> to abort"
@ 01,20 SAY "<Ctrl W> to Write changes to Disk"
SAMPLE_13 = ;
MEMOEDIT(SAMPLE->KOMMENTS,04,00,22,79,.T.,"MEMO_KEYS")
IF LASTKEY() = 23
REPLACE SAMPLE->KOMMENTS WITH SAMPLE_13
ENDIF
CASE MENU_SEL = 4
DO CONFIRM WITH "Confirm to Delete this Memo"
IF OK
REPLACE SAMPLE->KOMMENTS WITH ""
ENDIF
CASE MENU_SEL = 5
IF PRINTER_READY()
SET DEVICE TO PRINT
@ 00,00 SAY SAMPLE->KOMMENTS
EJECT
SET DEVICE TO SCREEN
ENDIF
ENDCASE
RESTSCREEN(00,00,23,79,SAMP_MSCR)
SAMP_MSCR = SPACE(0)
SAMPLE_13 = SPACE(0)
MENU_SEL = 12 && 12th pos on prior menu
RETURN
FUNCTION MEMO_KEYS
* Refer to a reference manual for a Scan Code Table.
* NOTE: Returning a Zero returns the orginal key pressed.
* See Clipper Manual (Summer 87) Page 6 - 127 and Table 6 - 17
* Look at Table G - 3
*
* Also Refer to Tom Rettig's TRHELP(c)
LAST_PRESS = LASTKEY()
DO CASE
CASE LAST_PRESS = 273 && Atl W
RETURN 22 && Ctrl V <Inset>
OTHERWISE
RETURN 0
ENDCASE
*******************************************************
PROCEDURE SAMP_GET && Keyboard to Variables
* Validation Functions are written at bottom of this source code.
* Modify them to your application needs.
*
* LAST_NAME
@ 2,15 GET SAMPLE_1 PICTURE "@KS20" ;
VALID VSAMP_1 (SAMPLE_1)
* FIRT_NAME
@ 3,15 GET SAMPLE_2 PICTURE "@KS20" ;
VALID VSAMP_2 (SAMPLE_2)
* ADDRESS_1
@ 4,15 GET SAMPLE_3 PICTURE "@KS20" ;
VALID VSAMP_3 (SAMPLE_3)
* ADDRESS_2
@ 5,15 GET SAMPLE_4 PICTURE "@KS20" ;
VALID VSAMP_4 (SAMPLE_4)
* ADDRESS_3
@ 6,15 GET SAMPLE_5 PICTURE "@KS20" ;
VALID VSAMP_5 (SAMPLE_5)
* POSTAL
@ 7,15 GET SAMPLE_6 PICTURE "@KS20" ;
VALID VSAMP_6 (SAMPLE_6)
* COUNTRY
@ 8,15 GET SAMPLE_7 PICTURE "@KS20" ;
VALID VSAMP_7 (SAMPLE_7)
* AREA_CODE
@ 9,15 GET SAMPLE_8 PICTURE "@KS20" ;
VALID VSAMP_8 (SAMPLE_8)
* PHONE_NUM
@ 10,15 GET SAMPLE_9 PICTURE "@KS20" ;
VALID VSAMP_9 (SAMPLE_9)
* STATUS
@ 11,15 GET SAMPLE_10 PICTURE "@Y"
* LAST_TALK
@ 12,15 GET SAMPLE_11 PICTURE "@D" ;
VALID VSAMP_11 (SAMPLE_11)
* AMT_SALES
@ 13,15 GET SAMPLE_12 PICTURE "99999999.99" ;
VALID VSAMP_12 (SAMPLE_12)
* KOMMENTS
* @ 14,15 GET SAMPLE->KOMMENTS
*******************************************************
PROCEDURE SAMP_SAY && Variables to Screen
@ 2,15 SAY SAMPLE_1 PICTURE "@S20"
@ 3,15 SAY SAMPLE_2 PICTURE "@S20"
@ 4,15 SAY SAMPLE_3 PICTURE "@S20"
@ 5,15 SAY SAMPLE_4 PICTURE "@S20"
@ 6,15 SAY SAMPLE_5 PICTURE "@S20"
@ 7,15 SAY SAMPLE_6 PICTURE "@S20"
@ 8,15 SAY SAMPLE_7 PICTURE "@S20"
@ 9,15 SAY SAMPLE_8 PICTURE "@S20"
@ 10,15 SAY SAMPLE_9 PICTURE "@S20"
@ 11,15 SAY SAMPLE_10 PICTURE "@Y"
@ 12,15 SAY SAMPLE_11 PICTURE "@D"
@ 13,15 SAY SAMPLE_12 PICTURE "@B99999999.99"
* @ 14,15 SAY SAMPLE->KOMMENTS
*******************************************************
PROCEDURE SAMP_BLNK && Blanks to Variables
SAMPLE_1 = SPACE(30) && Character Field
SAMPLE_2 = SPACE(30) && Character Field
SAMPLE_3 = SPACE(20) && Character Field
SAMPLE_4 = SPACE(20) && Character Field
SAMPLE_5 = SPACE(20) && Character Field
SAMPLE_6 = SPACE(13) && Character Field
SAMPLE_7 = SPACE(20) && Character Field
SAMPLE_8 = SPACE(3 ) && Character Field
SAMPLE_9 = SPACE(8 ) && Character Field
SAMPLE_10 = .T. && Logical Field
SAMPLE_11 = DATE() && Date Field
SAMPLE_12 = 0.00 && Numeric Field
* SAMPLE_13 && Memo Field are NOT Assigned
*******************************************************
PROCEDURE SAMP_VIN && Variables IN from dbf
* Memo Fields are Not effected
SAMPLE_1 = SAMPLE->LAST_NAME
SAMPLE_2 = SAMPLE->FIRT_NAME
SAMPLE_3 = SAMPLE->ADDRESS_1
SAMPLE_4 = SAMPLE->ADDRESS_2
SAMPLE_5 = SAMPLE->ADDRESS_3
SAMPLE_6 = SAMPLE->POSTAL
SAMPLE_7 = SAMPLE->COUNTRY
SAMPLE_8 = SAMPLE->AREA_CODE
SAMPLE_9 = SAMPLE->PHONE_NUM
SAMPLE_10 = SAMPLE->STATUS
SAMPLE_11 = SAMPLE->LAST_TALK
SAMPLE_12 = SAMPLE->AMT_SALES
*******************************************************
PROCEDURE SAMP_VOUT && Variables OUT to dbf
* Memo Fields are Not effected
REPLACE SAMPLE->LAST_NAME WITH SAMPLE_1
REPLACE SAMPLE->FIRT_NAME WITH SAMPLE_2
REPLACE SAMPLE->ADDRESS_1 WITH SAMPLE_3
REPLACE SAMPLE->ADDRESS_2 WITH SAMPLE_4
REPLACE SAMPLE->ADDRESS_3 WITH SAMPLE_5
REPLACE SAMPLE->POSTAL WITH SAMPLE_6
REPLACE SAMPLE->COUNTRY WITH SAMPLE_7
REPLACE SAMPLE->AREA_CODE WITH SAMPLE_8
REPLACE SAMPLE->PHONE_NUM WITH SAMPLE_9
REPLACE SAMPLE->STATUS WITH SAMPLE_10
REPLACE SAMPLE->LAST_TALK WITH SAMPLE_11
REPLACE SAMPLE->AMT_SALES WITH SAMPLE_12
COMMIT
*******************************************************
*
* The Following Routines are Generic
* And common to Multi-database programs
*
*******************************************************
PROCEDURE TOP && Top of File
@ 23,00 CLEAR
@ 23,35 SAY "SEARCHING"
GOTO TOP
*******************************************************
PROCEDURE NEXT && Next Record
IF RECCOUNT() = 0
DO PAUSE WITH "DataBase is Empty"
RETURN
ENDIF
@ 23,00 CLEAR
@ 23,35 SAY "SEARCHING"
IF EOF()
SKIP -1
ENDIF
SKIP
IF EOF()
@ 24,00 CLEAR
DO PAUSE WITH "Last Record / Press Return"
@ 24,00 CLEAR
GOTO BOTTOM
ENDIF
*******************************************************
PROCEDURE BACK && Prior Record
@ 23,00 CLEAR
@ 23,35 SAY "SEARCHING"
IF BOF()
@ 24,00 CLEAR
DO PAUSE WITH "First Record / Press Return"
@ 24,00 CLEAR
GOTO TOP
ELSE
SKIP -1
ENDIF
*******************************************************
PROCEDURE LAST && Last Record in File
@ 23,00 CLEAR
@ 23,35 SAY "SEARCHING"
GOTO BOTTOM
*******************************************************
PROCEDURE PAUSE && Support Routine
PARAMETER MESSAGE
IF LEN(MESSAGE) = 0
MESSAGE = "Press Enter to Continue"
ENDIF
STR_DUMMY = LEN(MESSAGE)
STR_DUMMY = ((80 - (STR_DUMMY)) / 2)
@ 24,00
?? CHR(7)
@ 24,00 CLEAR
@ 23,79
WAIT (SPACE(STR_DUMMY) + MESSAGE)
@ 24,00 CLEAR
*******************************************************
PROCEDURE CONFIRM && Support Routine
PARAMETER CON_MESSAGE
IF LEN(CON_MESSAGE) = 0
CON_MESSAGE = "Please Confirm "
ENDIF
STR_DUMMY = LEN(CON_MESSAGE)
STR_DUMMY = ((80 - (STR_DUMMY)) / 2)
@ 24,00
?? CHR(7)
@ 24,00 CLEAR
@ 24,STR_DUMMY SAY CON_MESSAGE GET OK PICTURE "@L"
READ
*******************************************************
PROCEDURE SERVICE && Dos Service
OK = .T.
DO WHILE OK
CLEAR
M_COMMAND = SPACE(60)
@ 0, 0 SAY "Simple Dos Service Type EXIT to return"
@ 2,1 GET M_COMMAND
READ
IF "EXIT"$(UPPER(M_COMMAND))
OK = .F.
ELSE
! &M_COMMAND
DO PAUSE WITH "Press Return to Continue "
ENDIF
ENDDO
*******************************************************
PROCEDURE EXTN_NAME && External Name
PARAMETER UT_NAME
@ 24,00 CLEAR
@ 24,30 SAY "FILE NAME => " GET UT_NAME PICTURE "!!!!!!!!!!!!"
READ
IF "" = TRIM(UT_NAME)
UT_NAME = "NONAME"
ENDIF
*******************************************************
PROCEDURE REPORTS && Report Module
PARAMETER REPORT_FRM
IF .NOT. FILE (REPORT_FRM)
DO PAUSE WITH "REPORT FILE " + REPORT_FRM + " NOT FOUND"
ELSE
IF PRINTER_READY()
SET CONSOLE OFF
REPORT FORM &REPORT_FRM TO PRINT
SET CONSOLE ON
DO TOP
ENDIF
ENDIF
*******************************************************
PROCEDURE LABELS && Labels Module
PARAMETER LABEL_LBL
IF .NOT. FILE (LABEL_LBL)
DO PAUSE WITH "LABEL FILE " + LABEL_LBL + " NOT FOUND"
ELSE
IF PRINTER_READY()
SET CONSOLE OFF
LABEL FORM &LABEL_LBL SAMPLE TO PRINT
SET CONSOLE ON
DO TOP
ENDIF
ENDIF
*******************************************************
PROCEDURE COLOURS && Set Screen Colour
PARAMETER THE_COLOUR
IF ISCOLOUR()
SET COLOR TO &THE_COLOUR
ENDIF
* =======================================================
*
* USER FUNCTIONS LISTED BELOW
* User Defined Functions are difrent than Procedures.
* A Function must have a return value.
*******************************************************
FUNCTION PRINTER_READY && General Printer Ready Routine
PRIVATE RESPONSE
@ 24,00 CLEAR
DO WHILE .NOT. ISPRINTER()
@ 24,24 SAY "Printer is NOT Ready : Retry Y/N"
RESPONSE = INKEY(0)
IF CHR(RESPONSE)$"Nn"
@ 24,00 CLEAR
RETURN (.F.)
ENDIF
ENDDO
@ 24,00 CLEAR
RETURN (.T.) && DEFAULT
*******************************************************
* Validation Functions for Gets
FUNCTION VSAMP_1
PARAMETER SAMPLE_1
IF EMPTY (SAMPLE_1)
DO PAUSE WITH "Field must be Filled"
RETURN (.F.)
ENDIF
RETURN .T.
FUNCTION VSAMP_2
PARAMETER SAMPLE_2
IF EMPTY (SAMPLE_2)
DO PAUSE WITH "Field must be Filled"
RETURN (.F.)
ENDIF
RETURN .T.
FUNCTION VSAMP_3
PARAMETER SAMPLE_3
IF EMPTY (SAMPLE_3)
DO PAUSE WITH "Field must be Filled"
RETURN (.F.)
ENDIF
RETURN .T.
FUNCTION VSAMP_4
PARAMETER SAMPLE_4
IF EMPTY (SAMPLE_4)
DO PAUSE WITH "Field must be Filled"
RETURN (.F.)
ENDIF
RETURN .T.
FUNCTION VSAMP_5
PARAMETER SAMPLE_5
IF EMPTY (SAMPLE_5)
DO PAUSE WITH "Field must be Filled"
RETURN (.F.)
ENDIF
RETURN .T.
FUNCTION VSAMP_6
PARAMETER SAMPLE_6
IF EMPTY (SAMPLE_6)
DO PAUSE WITH "Field must be Filled"
RETURN (.F.)
ENDIF
RETURN .T.
FUNCTION VSAMP_7
PARAMETER SAMPLE_7
IF EMPTY (SAMPLE_7)
DO PAUSE WITH "Field must be Filled"
RETURN (.F.)
ENDIF
RETURN .T.
FUNCTION VSAMP_8
PARAMETER SAMPLE_8
IF EMPTY (SAMPLE_8)
DO PAUSE WITH "Field must be Filled"
RETURN (.F.)
ENDIF
RETURN .T.
FUNCTION VSAMP_9
PARAMETER SAMPLE_9
IF EMPTY (SAMPLE_9)
DO PAUSE WITH "Field must be Filled"
RETURN (.F.)
ENDIF
RETURN .T.
FUNCTION VSAMP_11
PARAMETER SAMPLE_11
RETURN .T.
FUNCTION VSAMP_12
PARAMETER SAMPLE_12
RETURN .T.
*******************************************************
* End of C_Simple program SAMPLE.PRG source code