home *** CD-ROM | disk | FTP | other *** search
/ World of Shareware - Software Farm 2 / wosw_2.zip / wosw_2 / DATABASE / D_SMPL12.ZIP / SAMPLE.SRC < prev   
Text File  |  1990-09-01  |  26KB  |  1,131 lines
  1.  
  2. *    C_Simple(C)  Ver C1.2     RiverSide Software Corp (204)477-4235
  3. *    ST. VITAL PO BOX 345  WINNIPEG  MANITOBA  CANADA  R2M 3C5
  4. *        CLIPPER (R) EXTENDED Version Summer 87 
  5. *
  6. *    Program Name :        SAMPLE.PRG
  7. *    CopyRight (C):____________________________________
  8. *    Author       :____________________________________
  9. *                 :____________________________________
  10. *    Date         :____________________________________
  11. *    Project      :____________________________________
  12. *    Comments     :____________________________________
  13. *                 :____________________________________
  14. *                 :____________________________________
  15. *    Co-Pilot     :        Leslie E. Gros 
  16.  
  17.  
  18.     *******************************************************
  19.  
  20. *    Inquiry Functions supplied in C_Simple.Lib
  21.  
  22. EXTERNAL INQ_CHAR
  23. EXTERNAL INQ_NUM
  24. EXTERNAL INQ_DATE
  25. EXTERNAL INQ_LOGIC
  26. EXTERNAL INQ_COUNT
  27.  
  28.     *******************************************************
  29.  
  30. SET PROCEDURE TO SAMPLE
  31.  
  32.     SET DELETED   ON
  33.     SET SAFETY    OFF
  34.     SET EXACT     OFF
  35.     SET TALK      OFF
  36.     SET SOFTSEEK  ON
  37.     SET EXCLUSIVE ON
  38.     
  39. *    Declare Program Variables at top Level for Global Visibility
  40.  
  41.     OK = .T.        &&    Global Confirm Variable
  42.     INQ_FILTER = SPACE(0)    &&    Inquirey Variable
  43.     SAMP_FLTR  = SPACE(0)    &&    Inquirey Variable
  44.     MAIN_SEL   = SPACE(0)    &&    Global Menu Variable
  45.     SAMP_DFLAG = .F.    &&    Delete Flag
  46.  
  47.     SAMPLE_1 = SPACE(0)    &&    Variable for Field 1  LAST_NAME
  48.     SAMPLE_2 = SPACE(0)    &&    Variable for Field 2  FIRT_NAME
  49.     SAMPLE_3 = SPACE(0)    &&    Variable for Field 3  ADDRESS_1
  50.     SAMPLE_4 = SPACE(0)    &&    Variable for Field 4  ADDRESS_2
  51.     SAMPLE_5 = SPACE(0)    &&    Variable for Field 5  ADDRESS_3
  52.     SAMPLE_6 = SPACE(0)    &&    Variable for Field 6  POSTAL
  53.     SAMPLE_7 = SPACE(0)    &&    Variable for Field 7  COUNTRY
  54.     SAMPLE_8 = SPACE(0)    &&    Variable for Field 8  AREA_CODE
  55.     SAMPLE_9 = SPACE(0)    &&    Variable for Field 9  PHONE_NUM
  56.     SAMPLE_10 = .T.      &&    Variable for Field 10 STATUS
  57.     SAMPLE_11 = DATE()    &&    Variable for Field 11 LAST_TALK
  58.     SAMPLE_12 = 00000000.00    &&    Variable for Field 12 AMT_SALES
  59.     SAMPLE_13 = SPACE(0)    &&    Variable for Field 13 KOMMENTS
  60.  
  61.  
  62.     *******************************************************
  63.  
  64.     DO SAMP_SCRN        &&    Display to Screen
  65.     SELECT 1        &&    Programmer SELECT Area
  66.     DO SAMP_FILE        &&    Open dbf and indexes
  67.     DO SAMP_MAIN        &&    Program Main Body
  68.     SELECT SAMPLE        &&    Recall by Alias
  69.     DO SAMP_PACK        &&    Check for Deleted Records
  70.     USE            &&    Close the Database File
  71.     CLOSE PROCEDURE        &&    Logical End of Module.
  72.  
  73.     *******************************************************
  74.  
  75. PROCEDURE SAMP_MAIN        &&     Main Body
  76.     
  77.     SAMP_DONE = .F.        &&    Local Flag variable
  78.  
  79.     DO WHILE .NOT. SAMP_DONE
  80.  
  81.     *    Update ScoreBoard Header
  82.         IF .NOT. EMPTY(SAMPLE->KOMMENTS)
  83.             @ 00,25 SAY "<*MEMO*>"
  84.         ELSE
  85.             @ 00,25 SAY "        "
  86.         ENDIF
  87.         IF .NOT. EMPTY(SAMP_FLTR)
  88.             @ 00,35 SAY "<*QUERY*>"
  89.         ELSE
  90.             @ 00,35 SAY "         "
  91.         ENDIF
  92.         IF DELETED()
  93.             @ 00,50 SAY "<*DELETED*>"
  94.         ELSE
  95.             @ 00,50 SAY "           "
  96.         ENDIF
  97.     
  98.     *    Update Display Information
  99.         DO SAMP_VIN    &&    Swap Var IN from dbf
  100.         DO SAMP_GET    &&    See Next Line
  101.         CLEAR GETS    &&    Display data inverse on screen
  102.     *    DO SAMP_SAY 
  103.  
  104.     *    Select operation from Menu Bar
  105.         @ 23,00 CLEAR
  106.         SET MESSAGE to 24 CENTER
  107.         @23,00    PROMPT    " Quit "    MESSAGE    "Quit SAMPLE.DBF"
  108.         @23,06    PROMPT    " Add "        MESSAGE    "Add a New Record"
  109.         @23,11    PROMPT    " Edit "    MESSAGE    "Edit this Record"
  110.         @23,17    PROMPT    " Delete "    MESSAGE    "Delete this Record"
  111.         @23,25    PROMPT    " Top "        MESSAGE    "Go to First Record"
  112.         @23,30    PROMPT    " Next "    MESSAGE    "Next Record in File"
  113.         @23,36    PROMPT    " Back "    MESSAGE    "Back Up one Record"
  114.         @23,42    PROMPT    " Last "    MESSAGE    "Go to Last Record"
  115.         @23,48    PROMPT    " Seek "    MESSAGE    "Get Record by Index"
  116.         @23,54    PROMPT    " Inquire "    MESSAGE    "Query the database"
  117.         @23,63    PROMPT    " Utility "    MESSAGE    "Utilities Menu"
  118.         @23,73    PROMPT    " Memo "    MESSAGE    "Access to Memo Field"
  119.  
  120.         MENU TO MENU_SEL
  121.  
  122.         DO CASE
  123.  
  124.             CASE MENU_SEL = 1
  125.                 SAMP_DONE = .T.
  126.                 LOOP
  127.  
  128.             CASE MENU_SEL = 2
  129.                 DO SAMP_ADD
  130.  
  131.             CASE MENU_SEL = 3
  132.                 DO SAMP_EDIT
  133.  
  134.             CASE MENU_SEL = 4
  135.                 DO SAMP_DEL
  136.  
  137.             CASE MENU_SEL = 5
  138.                 DO TOP
  139.  
  140.             CASE MENU_SEL = 6
  141.                 DO NEXT
  142.  
  143.             CASE MENU_SEL = 7
  144.                 DO BACK
  145.  
  146.             CASE MENU_SEL = 8
  147.                 DO LAST
  148.  
  149.             CASE MENU_SEL = 9
  150.                 DO SAMP_SEEK
  151.  
  152.             CASE MENU_SEL = 10
  153.                 DO SAMP_INQU
  154.  
  155. *
  156.             CASE MENU_SEL = 11
  157.                 DO SAMP_UTIL
  158.  
  159.             CASE MENU_SEL = 12
  160.                 DO SAMP_MEMO
  161.  
  162.         ENDCASE
  163.     ENDDO
  164.     
  165.  
  166.     *******************************************************
  167.  
  168. PROCEDURE SAMP_FILE        && check files exist
  169.  
  170.     IF .NOT. FILE ("SAMPLE.DBF")
  171.         DO PAUSE WITH "Warning The DBF File is MISSING "
  172.         DO CONFIRM WITH "Create New Database Shell " 
  173.         IF OK
  174.             DO SAMP_CREA
  175.         ELSE
  176.             DO PAUSE WITH "Press Return to Quit"
  177.         ENDIF
  178.     ENDIF
  179.     
  180.     IF .NOT. FILE ("SAMPLE.DBT")
  181.         DO PAUSE WITH "Warning MEMO File is MISSING "
  182.         DO CONFIRM WITH "Create New Database Shell " 
  183.         IF OK
  184.             DO SAMP_CREA
  185.         ELSE
  186.             DO PAUSE WITH "Press Return to Quit"
  187.         ENDIF
  188.     ENDIF
  189.     
  190.     USE SAMPLE.DBF
  191.     IF .NOT. FILE ("SAMPLE.NTX")
  192.         DO SAMP_NTX
  193.     ENDIF
  194.     
  195.     SET INDEX TO SAMPLE.NTX
  196.     
  197.  
  198.     *******************************************************
  199.  
  200. PROCEDURE SAMP_CREA        && create dbf
  201.  
  202.     CREATE TEMP
  203.     USE    TEMP
  204.  
  205.     APPEND BLANK
  206.     REPLACE FIELD_NAME WITH "LAST_NAME"
  207.     REPLACE FIELD_TYPE WITH "C"
  208.     REPLACE FIELD_LEN  WITH 30
  209.     REPLACE FIELD_DEC  WITH 0
  210.     APPEND BLANK
  211.     REPLACE FIELD_NAME WITH "FIRT_NAME"
  212.     REPLACE FIELD_TYPE WITH "C"
  213.     REPLACE FIELD_LEN  WITH 30
  214.     REPLACE FIELD_DEC  WITH 0
  215.     APPEND BLANK
  216.     REPLACE FIELD_NAME WITH "ADDRESS_1"
  217.     REPLACE FIELD_TYPE WITH "C"
  218.     REPLACE FIELD_LEN  WITH 20
  219.     REPLACE FIELD_DEC  WITH 0
  220.     APPEND BLANK
  221.     REPLACE FIELD_NAME WITH "ADDRESS_2"
  222.     REPLACE FIELD_TYPE WITH "C"
  223.     REPLACE FIELD_LEN  WITH 20
  224.     REPLACE FIELD_DEC  WITH 0
  225.     APPEND BLANK
  226.     REPLACE FIELD_NAME WITH "ADDRESS_3"
  227.     REPLACE FIELD_TYPE WITH "C"
  228.     REPLACE FIELD_LEN  WITH 20
  229.     REPLACE FIELD_DEC  WITH 0
  230.     APPEND BLANK
  231.     REPLACE FIELD_NAME WITH "POSTAL"
  232.     REPLACE FIELD_TYPE WITH "C"
  233.     REPLACE FIELD_LEN  WITH 13
  234.     REPLACE FIELD_DEC  WITH 0
  235.     APPEND BLANK
  236.     REPLACE FIELD_NAME WITH "COUNTRY"
  237.     REPLACE FIELD_TYPE WITH "C"
  238.     REPLACE FIELD_LEN  WITH 20
  239.     REPLACE FIELD_DEC  WITH 0
  240.     APPEND BLANK
  241.     REPLACE FIELD_NAME WITH "AREA_CODE"
  242.     REPLACE FIELD_TYPE WITH "C"
  243.     REPLACE FIELD_LEN  WITH 3
  244.     REPLACE FIELD_DEC  WITH 0
  245.     APPEND BLANK
  246.     REPLACE FIELD_NAME WITH "PHONE_NUM"
  247.     REPLACE FIELD_TYPE WITH "C"
  248.     REPLACE FIELD_LEN  WITH 8
  249.     REPLACE FIELD_DEC  WITH 0
  250.     APPEND BLANK
  251.     REPLACE FIELD_NAME WITH "STATUS"
  252.     REPLACE FIELD_TYPE WITH "L"
  253.     REPLACE FIELD_LEN  WITH 1
  254.     REPLACE FIELD_DEC  WITH 0
  255.     APPEND BLANK
  256.     REPLACE FIELD_NAME WITH "LAST_TALK"
  257.     REPLACE FIELD_TYPE WITH "D"
  258.     REPLACE FIELD_LEN  WITH 8
  259.     REPLACE FIELD_DEC  WITH 0
  260.     APPEND BLANK
  261.     REPLACE FIELD_NAME WITH "AMT_SALES"
  262.     REPLACE FIELD_TYPE WITH "N"
  263.     REPLACE FIELD_LEN  WITH 10
  264.     REPLACE FIELD_DEC  WITH 2
  265.     APPEND BLANK
  266.     REPLACE FIELD_NAME WITH "KOMMENTS"
  267.     REPLACE FIELD_TYPE WITH "M"
  268.     REPLACE FIELD_LEN  WITH 10
  269.     REPLACE FIELD_DEC  WITH 0
  270.     COMMIT
  271.     USE
  272.  
  273.     CREATE SAMPLE.DBF FROM TEMP.DBF
  274.     ERASE TEMP.DBF
  275.  
  276.  
  277.     *******************************************************
  278.  
  279. PROCEDURE SAMP_NTX        && Re-Index routine
  280.  
  281.     @ 24,00 CLEAR
  282.     @ 24,35 SAY "RE-INDEXING"
  283.     INDEX ON UPPER(SAMPLE->LAST_NAME) TO SAMPLE.NTX
  284.     @ 24,00 CLEAR
  285.  
  286.     *******************************************************
  287.  
  288. PROCEDURE SAMP_PACK        && Pack if Required
  289.  
  290.     IF SAMP_DFLAG        && Delete Flag
  291.         @ 23,00 CLEAR
  292.         @ 24,30 SAY "Packing Deleted Records"
  293.         PACK
  294.         @ 23,00 CLEAR
  295.     ENDIF
  296.  
  297.     *******************************************************
  298.  
  299. PROCEDURE SAMP_SCRN        && Screen Shell
  300.  
  301.     DO COLOURS WITH "bg+/b,r+/n"
  302.     CLEAR
  303.     @ 01,00 TO 22,79 DOUBLE
  304.     @ 00,05 SAY "<** SAMPLE **>"
  305.     @  2, 1 SAY "LAST_NAME   :"
  306.     @  3, 1 SAY "FIRT_NAME   :"
  307.     @  4, 1 SAY "ADDRESS_1   :"
  308.     @  5, 1 SAY "ADDRESS_2   :"
  309.     @  6, 1 SAY "ADDRESS_3   :"
  310.     @  7, 1 SAY "POSTAL      :"
  311.     @  8, 1 SAY "COUNTRY     :"
  312.     @  9, 1 SAY "AREA_CODE   :"
  313.     @ 10, 1 SAY "PHONE_NUM   :"
  314.     @ 11, 1 SAY "STATUS      :"
  315.     @ 12, 1 SAY "LAST_TALK   :"
  316.     @ 13, 1 SAY "AMT_SALES   :"
  317.     @ 14, 1 SAY "KOMMENTS    :"
  318.  
  319.     *******************************************************
  320.  
  321. PROCEDURE SAMP_ADD        && Add New Record
  322.  
  323.     DO SAMP_BLNK
  324.     DO SAMP_GET
  325.     READ
  326.     DO CONFIRM WITH "Confirm to Save New Record "
  327.     IF OK
  328.         APPEND BLANK
  329. *        Request Locking on this Record
  330.         IF .NOT. LOCK()
  331.             DO PAUSE WITH "Appended Record is Locked"
  332.         ELSE
  333.             DO SAMP_VOUT
  334.             UNLOCK
  335.         ENDIF
  336.     ENDIF
  337.  
  338.     *******************************************************
  339.  
  340. PROCEDURE SAMP_EDIT        && Edit Record
  341.  
  342. *    Request Locking on this Record
  343.     IF .NOT. LOCK()
  344.         DO PAUSE WITH "Record is Locked by Other User"
  345.         RETURN
  346.     ENDIF
  347.  
  348.     DO SAMP_VIN
  349.     DO SAMP_GET
  350.     READ
  351.     DO CONFIRM WITH "Confirm to Save Changes "
  352.     IF OK
  353.         DO SAMP_VOUT
  354.     ENDIF
  355.     UNLOCK
  356.  
  357.     *******************************************************
  358.  
  359. PROCEDURE SAMP_DEL        && Delete Record
  360.  
  361.  
  362. *    Request Locking on this Record
  363.     IF .NOT. LOCK()
  364.         DO PAUSE WITH "Record is Locked by Other User"
  365.         RETURN
  366.     ENDIF
  367.  
  368.     DO CONFIRM WITH "CONFIRM TO DELETE RECORD "
  369.     IF OK
  370.         DELETE
  371.         SAMP_DFLAG = .T.    &&    Delete Flag
  372.         DO BACK
  373.     ENDIF
  374.     UNLOCK
  375.  
  376.     *******************************************************
  377.  
  378. PROCEDURE SAMP_SEEK        && Index Find Routine
  379.     DO SAMP_BLNK
  380. *        DO SAMP_GET    &&    See Next Line
  381. *        CLEAR GETS    &&    Display data inverse on screen
  382.         DO SAMP_SAY 
  383.     @  2,15 GET SAMPLE_1    PICTURE "@S20"
  384.     READ
  385.     SEEK UPPER(SAMPLE_1)
  386.     IF .NOT. FOUND()
  387.         DO PAUSE WITH "Exact Match NOT Found"
  388.     ENDIF
  389.     
  390.  
  391.     *******************************************************
  392.  
  393. PROCEDURE SAMP_INQU        && Inquirey Module
  394.  
  395.     @ 23,00 CLEAR
  396.     DUMMY = ""
  397.     MENU_SEL = 1
  398.     SET MESSAGE to 24 CENTER    && message at line 24
  399.     @ 23,00 CLEAR
  400.     @ 23,01 PROMPT " Exit "        ;
  401.         MESSAGE "Exit with NO Change"
  402.     @ 23,08 PROMPT " Reset "    ;
  403.         MESSAGE "Clear Query "
  404.     @ 23,16 PROMPT " Query "    ;
  405.         MESSAGE "Query DataBase to Display and Selective Export"
  406.     @ 23,24 PROMPT " Count "    ;
  407.         MESSAGE "Count the Number of Active Records "
  408.     MENU TO MENU_SEL
  409.     DO CASE
  410.         CASE    MENU_SEL = 2
  411.             INQ_FILTER = ""
  412.             SAMP_FLTR = SPACE(0)
  413.             SET FILTER TO &SAMP_FLTR
  414.  
  415.         CASE    MENU_SEL= 3
  416.             INQ_FILTER = ""
  417.             DO SAMP_BLNK
  418.             DO SAMP_IGET
  419.             SAMP_FLTR = INQ_FILTER
  420.             SET FILTER TO &SAMP_FLTR
  421.             DO TOP
  422.  
  423.         CASE    MENU_SEL = 4
  424.             DO INQ_COUNT
  425.     ENDCASE
  426.     MENU_SEL = 10
  427.     RETURN
  428.  
  429.  
  430.     *******************************************************
  431.  
  432. PROCEDURE SAMP_IGET    && Set a Filter Condition
  433.  
  434. *    INQ_ CHAR NUM DATE LOGIC are provided in C_SIMPLE.LIB
  435. *    Link  your_prog.obj c_simple.lib clipper.lib extend.lib
  436. *    These functions build a string that is used by FILTER
  437. *        First  Parameter is the Variable Value
  438. *        Second parameter is the DBF Field Name
  439. *
  440. *    LAST_NAME
  441.     @  2,15 GET SAMPLE_1    PICTURE "@KS20"    ;
  442.         VALID INQ_CHAR (SAMPLE_1,"LAST_NAME")
  443.  
  444. *    FIRT_NAME
  445.     @  3,15 GET SAMPLE_2    PICTURE "@KS20"    ;
  446.         VALID INQ_CHAR (SAMPLE_2,"FIRT_NAME")
  447.  
  448. *    ADDRESS_1
  449.     @  4,15 GET SAMPLE_3    PICTURE "@KS20"    ;
  450.         VALID INQ_CHAR (SAMPLE_3,"ADDRESS_1")
  451.  
  452. *    ADDRESS_2
  453.     @  5,15 GET SAMPLE_4    PICTURE "@KS20"    ;
  454.         VALID INQ_CHAR (SAMPLE_4,"ADDRESS_2")
  455.  
  456. *    ADDRESS_3
  457.     @  6,15 GET SAMPLE_5    PICTURE "@KS20"    ;
  458.         VALID INQ_CHAR (SAMPLE_5,"ADDRESS_3")
  459.  
  460. *    POSTAL
  461.     @  7,15 GET SAMPLE_6    PICTURE "@KS20"    ;
  462.         VALID INQ_CHAR (SAMPLE_6,"POSTAL")
  463.  
  464. *    COUNTRY
  465.     @  8,15 GET SAMPLE_7    PICTURE "@KS20"    ;
  466.         VALID INQ_CHAR (SAMPLE_7,"COUNTRY")
  467.  
  468. *    AREA_CODE
  469.     @  9,15 GET SAMPLE_8    PICTURE "@KS20"    ;
  470.         VALID INQ_CHAR (SAMPLE_8,"AREA_CODE")
  471.  
  472. *    PHONE_NUM
  473.     @ 10,15 GET SAMPLE_9    PICTURE "@KS20"    ;
  474.         VALID INQ_CHAR (SAMPLE_9,"PHONE_NUM")
  475.  
  476. *    STATUS
  477.     @ 11,15 GET SAMPLE_10    PICTURE "@Y"    ;
  478.         VALID INQ_LOGIC (SAMPLE_10,"STATUS")
  479.  
  480. *    LAST_TALK
  481.     @ 12,15 GET SAMPLE_11    PICTURE "@D"    ;
  482.         VALID INQ_DATE (SAMPLE_11,"LAST_TALK")
  483.  
  484. *    AMT_SALES
  485.     @ 13,15 GET SAMPLE_12    PICTURE "99999999.99"    ;
  486.         VALID INQ_NUM (SAMPLE_12,"AMT_SALES")
  487.  
  488. *    KOMMENTS
  489. *    @ 14,15 GET SAMPLE->KOMMENTS
  490.  
  491.     READ
  492.  
  493.  
  494.     *******************************************************
  495.  
  496. PROCEDURE SAMP_UTIL        && Utility routines
  497. *         Imports and exports can be changes to suit you needs.
  498. *         Extended Lotus and P.F.S. Import/Export can be added.
  499. *                                        Leslie E. Gros
  500.  
  501.     MENU_SEL = 1
  502.     UT_NAME = SPACE(13)
  503.     @ 23,00 CLEAR
  504.     SET MESSAGE TO 24 CENTER
  505.     @ 23,01    PROMPT    " Main Menu "    MESSAGE    "Return to Main Menu"
  506.     @ 23,13    PROMPT    " Dos "        MESSAGE    "Dos Service"
  507.     @ 23,19    PROMPT    " Import "    MESSAGE    "Import Ascii Delimited File"
  508.     @ 23,28    PROMPT    " Export "    MESSAGE    "Export Ascii Delimited File"
  509.     @ 23,37    PROMPT    " SDF in "    MESSAGE    "Import Ascii SDF Files"
  510.     @ 23,46    PROMPT    " Out sdf "    MESSAGE    "Export Ascii SDF File"
  511.     @ 23,56    PROMPT    " Merge ";
  512.         MESSAGE    "Export Mail Merge Header and Ascii Data"
  513.     @ 23,64 PROMPT " Report ";
  514.         MESSAGE    "Print Report to Printer (Query or All)"
  515.     @ 23,72 PROMPT " Labels ";
  516.         MESSAGE    "Print Labels on Printer (Query or All)"
  517.         MENU TO  MENU_SEL
  518.  
  519.     DO CASE
  520.  
  521.         CASE MENU_SEL = 1
  522.  
  523.             * Do Nothing Exit
  524.  
  525.         CASE MENU_SEL = 2
  526.  
  527.             Do SERVICE
  528.             DO SAMP_SCRN
  529.  
  530.         CASE MENU_SEL = 3
  531.  
  532.             DO EXTN_NAME WITH UT_NAME
  533.             DO CONFIRM WITH "CONFIRM TO APPEND FROM " + UT_NAME
  534.             IF OK
  535.                 APPEND FROM &UT_NAME DELIMITED
  536.             ENDIF
  537.  
  538.         CASE MENU_SEL = 4
  539.  
  540.             DO EXTN_NAME WITH UT_NAME
  541.             DO CONFIRM WITH "CONFIRM TO EXPORT TO " + UT_NAME
  542.             IF OK
  543.                 COPY TO &UT_NAME DELIMITED
  544.                 GO TOP
  545.             ENDIF
  546.  
  547.         CASE MENU_SEL = 5
  548.  
  549.             DO EXTN_NAME WITH UT_NAME
  550.             DO CONFIRM WITH "CONFIRM SDF APPEND FROM " + UT_NAME
  551.             IF OK
  552.                 APPEND FROM &UT_NAME SDF
  553.             ENDIF
  554.  
  555.         CASE MENU_SEL = 6
  556.  
  557.             DO EXTN_NAME WITH UT_NAME
  558.             DO CONFIRM WITH "CONFIRM SDF EXPORT TO " + UT_NAME
  559.             IF OK
  560.                 COPY TO &UT_NAME SDF
  561.                 GO TOP
  562.             ENDIF
  563.  
  564.         CASE MENU_SEL = 7
  565.  
  566.             UT_NAME = SPACE(8)
  567.             DO EXTN_NAME WITH UT_NAME
  568.             COPY TO &UT_NAME DELIMITED
  569.             UT_NAME = TRIM(UT_NAME) + ".DAT"
  570.             SET ALTERNATE TO &UT_NAME
  571.             SET CONSOLE OFF
  572.             SET ALTERNATE ON
  573.                 ?? TRIM("LAST_NAME   ") + ","
  574.                 ?? TRIM("FIRT_NAME   ") + ","
  575.                 ?? TRIM("ADDRESS_1   ") + ","
  576.                 ?? TRIM("ADDRESS_2   ") + ","
  577.                 ?? TRIM("ADDRESS_3   ") + ","
  578.                 ?? TRIM("POSTAL      ") + ","
  579.                 ?? TRIM("COUNTRY     ") + ","
  580.                 ?? TRIM("AREA_CODE   ") + ","
  581.                 ?? TRIM("PHONE_NUM   ") + ","
  582.                 ?? TRIM("STATUS      ") + ","
  583.                 ?? TRIM("LAST_TALK   ") + ","
  584.                 ?? TRIM("AMT_SALES   ") + ","
  585.             SET ALTERNATE OFF
  586.             CLOSE ALTERNATE
  587.             SET CONSOLE ON
  588.             GO TOP
  589.  
  590.         CASE MENU_SEL = 8
  591.             DO REPORTS WITH "SAMPLE.FRM"    && Report.Frm
  592.  
  593.         CASE MENU_SEL = 9
  594.             DO LABELS  WITH "SAMPLE.LBL"    && Label.Lbl
  595.  
  596.     ENDCASE
  597.     MENU_SEL = 11
  598.     RETURN
  599.  
  600.  
  601.     *******************************************************
  602.  
  603. PROCEDURE SAMP_MEMO        && MEMO 
  604.  
  605.     MENU_SEL = 0
  606.     @ 23,00 CLEAR
  607.     SAMP_MSCR    = SPACE(0)
  608.     SAMPLE_13    = SPACE(0)
  609.     SAMP_MSCR = SAVESCREEN(00,00,23,79)
  610.     
  611.     SET MESSAGE to 24 CENTER    && message at line 24
  612.     @ 23,01    PROMPT    " Exit " ;
  613.             MESSAGE    "Exit from the MEMO Screen Routine"
  614.     @ 23,07    PROMPT    " View " ;
  615.             MESSAGE    " View | Read Memo Field | No  Changes Saved"
  616.     @ 23,13    PROMPT    " Update " ;
  617.             MESSAGE    "Update this current Memo Field"
  618.     @ 23,21    PROMPT    " Delete " ;
  619.             MESSAGE    "WARNING : Delete the Current MEMO"
  620.     @ 23,30    PROMPT    " Hardcopy " ;
  621.             MESSAGE    "Print Hard Copy to Printer"
  622.     MENU to MENU_SEL
  623.     DO CASE
  624.  
  625.         CASE MENU_SEL = 2
  626.             CLEAR
  627.             @ 00,00 to 02,79    DOUBLE
  628.             @ 01,01 SAY "<ESC> to exit"
  629.             SAMPLE_13 = ;
  630.             MEMOEDIT(SAMPLE->KOMMENTS,04,00,22,79,.F.)
  631.  
  632.         CASE MENU_SEL = 3
  633.             CLEAR
  634.             @ 00,00 to 02,79    DOUBLE
  635.             @ 01,01 SAY "<ESC> to abort"
  636.             @ 01,20 SAY "<Ctrl W> to Write changes to Disk"
  637.             SAMPLE_13 = ;
  638.             MEMOEDIT(SAMPLE->KOMMENTS,04,00,22,79,.T.,"MEMO_KEYS")
  639.             IF LASTKEY() = 23
  640.                 REPLACE SAMPLE->KOMMENTS WITH SAMPLE_13
  641.             ENDIF
  642.  
  643.         CASE MENU_SEL = 4
  644.             DO CONFIRM WITH "Confirm to Delete this Memo"
  645.             IF OK
  646.                 REPLACE SAMPLE->KOMMENTS WITH ""
  647.             ENDIF
  648.  
  649.         CASE MENU_SEL = 5
  650.             IF PRINTER_READY()
  651.                 SET DEVICE TO PRINT
  652.                 @ 00,00 SAY SAMPLE->KOMMENTS
  653.                 EJECT
  654.                 SET DEVICE TO SCREEN
  655.             ENDIF
  656.  
  657.         ENDCASE
  658.  
  659.     RESTSCREEN(00,00,23,79,SAMP_MSCR)
  660.     SAMP_MSCR    = SPACE(0)
  661.     SAMPLE_13    = SPACE(0)
  662.     MENU_SEL    = 12        && 12th pos on prior menu
  663.     RETURN
  664.  
  665.  
  666. FUNCTION    MEMO_KEYS
  667.  
  668. *    Refer to a reference manual for a Scan Code Table.
  669. *    NOTE:     Returning a Zero returns the orginal key pressed.
  670. *    See Clipper Manual (Summer 87) Page 6 - 127 and Table 6 - 17
  671. *            Look at Table G - 3
  672. *
  673. *            Also Refer to Tom Rettig's TRHELP(c)
  674.  
  675.         LAST_PRESS = LASTKEY()
  676.         DO CASE
  677.  
  678.             CASE LAST_PRESS = 273    && Atl W
  679.                 RETURN    22    && Ctrl V <Inset>
  680.  
  681.  
  682.             OTHERWISE
  683.                 RETURN  0
  684.  
  685.         ENDCASE
  686.  
  687.  
  688.     *******************************************************
  689.  
  690. PROCEDURE SAMP_GET        && Keyboard to Variables
  691.  
  692. *    Validation Functions are written at bottom of this source code.
  693. *        Modify them to your application needs.
  694. *    
  695. *    LAST_NAME
  696.     @  2,15 GET SAMPLE_1    PICTURE "@KS20"    ;
  697.         VALID VSAMP_1   (SAMPLE_1)
  698.  
  699. *    FIRT_NAME
  700.     @  3,15 GET SAMPLE_2    PICTURE "@KS20"    ;
  701.         VALID VSAMP_2   (SAMPLE_2)
  702.  
  703. *    ADDRESS_1
  704.     @  4,15 GET SAMPLE_3    PICTURE "@KS20"    ;
  705.         VALID VSAMP_3   (SAMPLE_3)
  706.  
  707. *    ADDRESS_2
  708.     @  5,15 GET SAMPLE_4    PICTURE "@KS20"    ;
  709.         VALID VSAMP_4   (SAMPLE_4)
  710.  
  711. *    ADDRESS_3
  712.     @  6,15 GET SAMPLE_5    PICTURE "@KS20"    ;
  713.         VALID VSAMP_5   (SAMPLE_5)
  714.  
  715. *    POSTAL
  716.     @  7,15 GET SAMPLE_6    PICTURE "@KS20"    ;
  717.         VALID VSAMP_6   (SAMPLE_6)
  718.  
  719. *    COUNTRY
  720.     @  8,15 GET SAMPLE_7    PICTURE "@KS20"    ;
  721.         VALID VSAMP_7   (SAMPLE_7)
  722.  
  723. *    AREA_CODE
  724.     @  9,15 GET SAMPLE_8    PICTURE "@KS20"    ;
  725.         VALID VSAMP_8   (SAMPLE_8)
  726.  
  727. *    PHONE_NUM
  728.     @ 10,15 GET SAMPLE_9    PICTURE "@KS20"    ;
  729.         VALID VSAMP_9   (SAMPLE_9)
  730.  
  731. *    STATUS
  732.     @ 11,15 GET SAMPLE_10    PICTURE "@Y"
  733.  
  734. *    LAST_TALK
  735.     @ 12,15 GET SAMPLE_11    PICTURE "@D"    ;
  736.         VALID VSAMP_11  (SAMPLE_11)
  737.  
  738. *    AMT_SALES
  739.     @ 13,15 GET SAMPLE_12    PICTURE "99999999.99"    ;
  740.         VALID VSAMP_12  (SAMPLE_12)
  741.  
  742. *    KOMMENTS
  743. *    @ 14,15 GET SAMPLE->KOMMENTS
  744.  
  745.  
  746.     *******************************************************
  747.  
  748. PROCEDURE SAMP_SAY        && Variables to Screen
  749.  
  750.     @  2,15 SAY SAMPLE_1    PICTURE "@S20"
  751.     @  3,15 SAY SAMPLE_2    PICTURE "@S20"
  752.     @  4,15 SAY SAMPLE_3    PICTURE "@S20"
  753.     @  5,15 SAY SAMPLE_4    PICTURE "@S20"
  754.     @  6,15 SAY SAMPLE_5    PICTURE "@S20"
  755.     @  7,15 SAY SAMPLE_6    PICTURE "@S20"
  756.     @  8,15 SAY SAMPLE_7    PICTURE "@S20"
  757.     @  9,15 SAY SAMPLE_8    PICTURE "@S20"
  758.     @ 10,15 SAY SAMPLE_9    PICTURE "@S20"
  759.     @ 11,15 SAY SAMPLE_10    PICTURE "@Y"
  760.     @ 12,15 SAY SAMPLE_11    PICTURE "@D"
  761.     @ 13,15 SAY SAMPLE_12    PICTURE "@B99999999.99"
  762. *    @ 14,15 SAY SAMPLE->KOMMENTS
  763.  
  764.     *******************************************************
  765.  
  766. PROCEDURE SAMP_BLNK        && Blanks to Variables
  767.  
  768.     SAMPLE_1     =   SPACE(30)    && Character Field
  769.     SAMPLE_2     =   SPACE(30)    && Character Field
  770.     SAMPLE_3     =   SPACE(20)    && Character Field
  771.     SAMPLE_4     =   SPACE(20)    && Character Field
  772.     SAMPLE_5     =   SPACE(20)    && Character Field
  773.     SAMPLE_6     =   SPACE(13)    && Character Field
  774.     SAMPLE_7     =   SPACE(20)    && Character Field
  775.     SAMPLE_8     =   SPACE(3 )    && Character Field
  776.     SAMPLE_9     =   SPACE(8 )    && Character Field
  777.     SAMPLE_10    =   .T.        && Logical Field
  778.     SAMPLE_11    =   DATE()        && Date Field
  779.     SAMPLE_12    =   0.00        && Numeric Field
  780. *    SAMPLE_13                 && Memo Field are NOT Assigned
  781.  
  782.     *******************************************************
  783.  
  784. PROCEDURE SAMP_VIN        && Variables IN from dbf
  785. *                Memo Fields are Not effected
  786.  
  787.     SAMPLE_1     =   SAMPLE->LAST_NAME
  788.     SAMPLE_2     =   SAMPLE->FIRT_NAME
  789.     SAMPLE_3     =   SAMPLE->ADDRESS_1
  790.     SAMPLE_4     =   SAMPLE->ADDRESS_2
  791.     SAMPLE_5     =   SAMPLE->ADDRESS_3
  792.     SAMPLE_6     =   SAMPLE->POSTAL
  793.     SAMPLE_7     =   SAMPLE->COUNTRY
  794.     SAMPLE_8     =   SAMPLE->AREA_CODE
  795.     SAMPLE_9     =   SAMPLE->PHONE_NUM
  796.     SAMPLE_10    =   SAMPLE->STATUS
  797.     SAMPLE_11    =   SAMPLE->LAST_TALK
  798.     SAMPLE_12    =   SAMPLE->AMT_SALES
  799.  
  800.     *******************************************************
  801.  
  802. PROCEDURE SAMP_VOUT        && Variables OUT to dbf
  803. *                Memo Fields are Not effected
  804.  
  805.     REPLACE SAMPLE->LAST_NAME   WITH SAMPLE_1
  806.     REPLACE SAMPLE->FIRT_NAME   WITH SAMPLE_2
  807.     REPLACE SAMPLE->ADDRESS_1   WITH SAMPLE_3
  808.     REPLACE SAMPLE->ADDRESS_2   WITH SAMPLE_4
  809.     REPLACE SAMPLE->ADDRESS_3   WITH SAMPLE_5
  810.     REPLACE SAMPLE->POSTAL      WITH SAMPLE_6
  811.     REPLACE SAMPLE->COUNTRY     WITH SAMPLE_7
  812.     REPLACE SAMPLE->AREA_CODE   WITH SAMPLE_8
  813.     REPLACE SAMPLE->PHONE_NUM   WITH SAMPLE_9
  814.     REPLACE SAMPLE->STATUS      WITH SAMPLE_10
  815.     REPLACE SAMPLE->LAST_TALK   WITH SAMPLE_11
  816.     REPLACE SAMPLE->AMT_SALES   WITH SAMPLE_12
  817.     COMMIT
  818.  
  819.     *******************************************************
  820.  
  821. *
  822. *        The  Following  Routines are  Generic
  823. *        And common to Multi-database programs
  824. *
  825.  
  826.     *******************************************************
  827.  
  828. PROCEDURE TOP        && Top of File
  829.  
  830.     @ 23,00 CLEAR
  831.     @ 23,35 SAY "SEARCHING"
  832.     GOTO TOP
  833.  
  834.     *******************************************************
  835.  
  836. PROCEDURE NEXT        && Next Record
  837.  
  838.     IF RECCOUNT() = 0
  839.         DO PAUSE WITH "DataBase is Empty"
  840.         RETURN
  841.     ENDIF
  842.     
  843.     @ 23,00 CLEAR
  844.     @ 23,35 SAY "SEARCHING"
  845.     IF EOF()
  846.         SKIP -1
  847.     ENDIF
  848.     SKIP
  849.     IF EOF()
  850.         @ 24,00 CLEAR
  851.         DO PAUSE WITH "Last Record  / Press Return"
  852.         @ 24,00 CLEAR
  853.         GOTO BOTTOM
  854.     ENDIF
  855.  
  856.     *******************************************************
  857.  
  858. PROCEDURE BACK        && Prior Record
  859.  
  860.     @ 23,00 CLEAR
  861.     @ 23,35 SAY "SEARCHING"
  862.     IF BOF()
  863.         @ 24,00 CLEAR
  864.         DO PAUSE WITH "First Record  / Press Return"
  865.         @ 24,00 CLEAR
  866.         GOTO TOP
  867.     ELSE
  868.         SKIP -1
  869.     ENDIF
  870.  
  871.     *******************************************************
  872.  
  873. PROCEDURE LAST        && Last Record in File
  874.  
  875.     @ 23,00 CLEAR
  876.     @ 23,35 SAY "SEARCHING"
  877.     GOTO BOTTOM
  878.  
  879.     *******************************************************
  880.  
  881. PROCEDURE PAUSE        && Support Routine
  882. PARAMETER MESSAGE
  883.  
  884.     IF LEN(MESSAGE) = 0
  885.          MESSAGE = "Press Enter to Continue"
  886.     ENDIF
  887.     STR_DUMMY = LEN(MESSAGE)
  888.     STR_DUMMY = ((80 - (STR_DUMMY)) / 2)
  889.     @ 24,00
  890.     ?? CHR(7)
  891.     @ 24,00 CLEAR
  892.     @ 23,79
  893.     WAIT (SPACE(STR_DUMMY) + MESSAGE)
  894.     @ 24,00 CLEAR
  895.  
  896.     *******************************************************
  897.  
  898. PROCEDURE CONFIRM        && Support Routine
  899. PARAMETER CON_MESSAGE
  900.  
  901.     IF LEN(CON_MESSAGE) = 0
  902.         CON_MESSAGE = "Please Confirm "
  903.     ENDIF
  904.     STR_DUMMY = LEN(CON_MESSAGE)
  905.     STR_DUMMY = ((80 - (STR_DUMMY)) / 2)
  906.     @ 24,00
  907.     ?? CHR(7)
  908.     @ 24,00 CLEAR
  909.     @ 24,STR_DUMMY SAY CON_MESSAGE GET OK PICTURE "@L"
  910.     READ
  911.  
  912.     *******************************************************
  913.  
  914. PROCEDURE SERVICE        && Dos Service
  915.  
  916.     OK = .T.
  917.     DO WHILE OK
  918.         CLEAR
  919.         M_COMMAND = SPACE(60)
  920.         @ 0, 0 SAY "Simple Dos Service    Type EXIT to return"
  921.         @ 2,1 GET M_COMMAND
  922.         READ
  923.         IF "EXIT"$(UPPER(M_COMMAND))
  924.             OK = .F.
  925.         ELSE
  926.             ! &M_COMMAND
  927.         DO PAUSE WITH "Press Return to Continue "
  928.         ENDIF
  929.     ENDDO
  930.  
  931.     *******************************************************
  932.  
  933. PROCEDURE EXTN_NAME        && External Name
  934. PARAMETER UT_NAME
  935.  
  936.     @ 24,00 CLEAR
  937.     @ 24,30 SAY "FILE NAME => " GET UT_NAME    PICTURE "!!!!!!!!!!!!"
  938.     READ
  939.     IF "" = TRIM(UT_NAME)
  940.         UT_NAME = "NONAME"
  941.     ENDIF
  942.  
  943.  
  944.     *******************************************************
  945.  
  946. PROCEDURE REPORTS        && Report Module
  947. PARAMETER REPORT_FRM
  948.  
  949.     IF .NOT. FILE (REPORT_FRM)
  950.         DO PAUSE WITH "REPORT FILE " + REPORT_FRM + " NOT FOUND"
  951.     ELSE
  952.         IF PRINTER_READY()
  953.             SET CONSOLE OFF
  954.             REPORT FORM &REPORT_FRM TO PRINT
  955.             SET CONSOLE ON
  956.             DO TOP
  957.         ENDIF
  958.     ENDIF
  959.  
  960.     *******************************************************
  961.  
  962. PROCEDURE LABELS        && Labels Module
  963. PARAMETER LABEL_LBL
  964.  
  965.     IF .NOT. FILE (LABEL_LBL)
  966.         DO PAUSE WITH "LABEL FILE " + LABEL_LBL + " NOT FOUND"
  967.     ELSE
  968.         IF PRINTER_READY()
  969.             SET CONSOLE OFF
  970.             LABEL FORM &LABEL_LBL SAMPLE TO PRINT
  971.             SET CONSOLE ON
  972.             DO TOP
  973.         ENDIF
  974.     ENDIF
  975.  
  976.     *******************************************************
  977.  
  978. PROCEDURE COLOURS        && Set Screen Colour
  979. PARAMETER THE_COLOUR
  980.  
  981.     IF ISCOLOUR()
  982.         SET COLOR TO &THE_COLOUR
  983.     ENDIF
  984.  
  985.  
  986. *    =======================================================
  987. *
  988. *            USER FUNCTIONS LISTED BELOW
  989. *    User Defined Functions are difrent than Procedures.
  990. *        A Function must have a return value.
  991.  
  992.     *******************************************************
  993.  
  994. FUNCTION    PRINTER_READY    &&    General Printer Ready Routine
  995. PRIVATE        RESPONSE
  996.  
  997.     @ 24,00 CLEAR
  998.     DO WHILE .NOT. ISPRINTER()
  999.         @ 24,24 SAY "Printer is NOT Ready :  Retry Y/N"
  1000.         RESPONSE = INKEY(0)
  1001.         IF CHR(RESPONSE)$"Nn"
  1002.             @ 24,00 CLEAR
  1003.             RETURN (.F.)
  1004.         ENDIF
  1005.     ENDDO
  1006.     @ 24,00 CLEAR
  1007.     RETURN (.T.)    && DEFAULT
  1008.  
  1009.  
  1010.  
  1011.     *******************************************************
  1012.  
  1013. *        Validation Functions for Gets
  1014.  
  1015.  
  1016. FUNCTION    VSAMP_1  
  1017. PARAMETER    SAMPLE_1
  1018.  
  1019.         IF EMPTY (SAMPLE_1)
  1020.             DO PAUSE WITH "Field must be Filled"
  1021.             RETURN    (.F.)
  1022.         ENDIF
  1023.  
  1024.         RETURN    .T.
  1025.  
  1026.  
  1027. FUNCTION    VSAMP_2  
  1028. PARAMETER    SAMPLE_2
  1029.  
  1030.         IF EMPTY (SAMPLE_2)
  1031.             DO PAUSE WITH "Field must be Filled"
  1032.             RETURN    (.F.)
  1033.         ENDIF
  1034.  
  1035.         RETURN    .T.
  1036.  
  1037.  
  1038. FUNCTION    VSAMP_3  
  1039. PARAMETER    SAMPLE_3
  1040.  
  1041.         IF EMPTY (SAMPLE_3)
  1042.             DO PAUSE WITH "Field must be Filled"
  1043.             RETURN    (.F.)
  1044.         ENDIF
  1045.  
  1046.         RETURN    .T.
  1047.  
  1048.  
  1049. FUNCTION    VSAMP_4  
  1050. PARAMETER    SAMPLE_4
  1051.  
  1052.         IF EMPTY (SAMPLE_4)
  1053.             DO PAUSE WITH "Field must be Filled"
  1054.             RETURN    (.F.)
  1055.         ENDIF
  1056.  
  1057.         RETURN    .T.
  1058.  
  1059.  
  1060. FUNCTION    VSAMP_5  
  1061. PARAMETER    SAMPLE_5
  1062.  
  1063.         IF EMPTY (SAMPLE_5)
  1064.             DO PAUSE WITH "Field must be Filled"
  1065.             RETURN    (.F.)
  1066.         ENDIF
  1067.  
  1068.         RETURN    .T.
  1069.  
  1070.  
  1071. FUNCTION    VSAMP_6  
  1072. PARAMETER    SAMPLE_6
  1073.  
  1074.         IF EMPTY (SAMPLE_6)
  1075.             DO PAUSE WITH "Field must be Filled"
  1076.             RETURN    (.F.)
  1077.         ENDIF
  1078.  
  1079.         RETURN    .T.
  1080.  
  1081.  
  1082. FUNCTION    VSAMP_7  
  1083. PARAMETER    SAMPLE_7
  1084.  
  1085.         IF EMPTY (SAMPLE_7)
  1086.             DO PAUSE WITH "Field must be Filled"
  1087.             RETURN    (.F.)
  1088.         ENDIF
  1089.  
  1090.         RETURN    .T.
  1091.  
  1092.  
  1093. FUNCTION    VSAMP_8  
  1094. PARAMETER    SAMPLE_8
  1095.  
  1096.         IF EMPTY (SAMPLE_8)
  1097.             DO PAUSE WITH "Field must be Filled"
  1098.             RETURN    (.F.)
  1099.         ENDIF
  1100.  
  1101.         RETURN    .T.
  1102.  
  1103.  
  1104. FUNCTION    VSAMP_9  
  1105. PARAMETER    SAMPLE_9
  1106.  
  1107.         IF EMPTY (SAMPLE_9)
  1108.             DO PAUSE WITH "Field must be Filled"
  1109.             RETURN    (.F.)
  1110.         ENDIF
  1111.  
  1112.         RETURN    .T.
  1113.  
  1114.  
  1115. FUNCTION    VSAMP_11 
  1116. PARAMETER    SAMPLE_11
  1117.  
  1118.         RETURN    .T.
  1119.  
  1120.  
  1121. FUNCTION    VSAMP_12 
  1122. PARAMETER    SAMPLE_12
  1123.  
  1124.         RETURN    .T.
  1125.  
  1126.  
  1127.     *******************************************************
  1128.  
  1129.  
  1130. *        End of C_Simple program  SAMPLE.PRG source code
  1131.