home *** CD-ROM | disk | FTP | other *** search
/ Liren Large Software Subsidy 5 / 05.iso / a / a031 / samples.exe / CUST.PRG < prev    next >
Encoding:
Text File  |  1992-03-10  |  9.2 KB  |  270 lines
  1. ******************************************************************************
  2. * PROGRAM NAME: CUST.PRG
  3. *               CUSTOMER DATABASE SCREEN
  4. *               SAMPLE BUSINESS APPLICATION PROGRAM
  5. * LAST CHANGED: 09/25/89 09:26AM
  6. * WRITTEN BY:   Borland International Inc.
  7. ******************************************************************************
  8. *       FILES USED:
  9. *       Database file =  Cust.dbf   (Customer file)
  10. *       Index file    =  Cust.mdx
  11. *           TAG: Cust =  cust_id  <= Master index
  12. *       External procedure file = Library.prg
  13. ******************************************************************************
  14. * Main procedure
  15. PROCEDURE Cust
  16.  
  17.    * Link to external procedure file of "tool" procedures
  18.    SET PROCEDURE TO Library
  19.  
  20.    * Set up database environment
  21.    DO Set_env
  22.  
  23.    SET COLOR TO &c_standard.
  24.  
  25.    * Declare variables used:
  26.    * Database memory variables
  27.    STORE "" TO cust_id, category, customer, address1, address2, city, state
  28.    STORE "" TO zip, phone, contact, phone_cont, phone_ext, date_last, terms
  29.    STORE "" TO comments
  30.  
  31.    * Miscellaneous variables - used to pass parameters to Library
  32.    STORE "CUST" TO dbf, mlist         && Standard report & mail list available
  33.    STORE "N/A"  TO cust_rpt           && No custom reports available
  34.    STORE "m->cust_id" TO key, key1
  35.    STORE "NONE" TO key2, key3
  36.    keyname1 = "Customer #:"
  37.    STORE "" TO keyname2, keyname3, mcategory, mcity, mstate
  38.    list_flds = "CUST_ID, CONTACT, PHONE_CONT, PHONE_EXT"
  39.  
  40.    * Open database files and choose active indexes
  41.    SELECT 1
  42.    USE Cust ORDER Cust_id
  43.    GO TOP
  44.    * Used for area code lookup
  45.    USE Codes ORDER City IN 2
  46.  
  47.    record_num = RECNO()
  48.    * Load initial record from database into memory variables
  49.    DO Load_fld
  50.  
  51.    * Show data screen
  52.    CLEAR
  53.    DO Dstatus
  54.    DO Backgrnd
  55.    DO Show_data
  56.  
  57.    DO Bar_def            && Define popup menus
  58.  
  59.    * Activate main popup menu - execute user choices
  60.    SET COLOR TO &c_popup.
  61.    ACTIVATE POPUP main_mnu
  62.    DO Sub_ret
  63.    *
  64. RETURN
  65.  
  66.  
  67. *  UTILITY PROCEDURES (Proprietary to Cust.prg)
  68.  
  69. PROCEDURE Filter
  70.   * Filter (group) data into subset
  71.   * Select subset to set up filter condition  (Y=turn on, N=abort selection, 
  72.   * T=turn off) If filter is already on, set default choice to T, show 
  73.   * window. If filter is not on, set default choice to Y, show window. 
  74.   choice = IIF(filters_on,"T","Y")
  75.   DO Filt_ans
  76.   IF choice = "Y"
  77.      * Start process of choosing filter condition
  78.      mcategory = SPACE(15)
  79.      mcity     = SPACE(20)
  80.      mstate    = SPACE(2)
  81.      STORE SPACE(10) TO mzip, mterms
  82.      ACTIVATE WINDOW alert
  83.         * Get user's filter condition selection(s)
  84.         @  0, 0 SAY "--------- ENTER FILTER CONDITION --------"
  85.         @  1, 0 SAY "CATEGORY:" GET mcategory FUNCTION "!" ;
  86.            MESSAGE "Enter a customer category"
  87.         @  2, 0 SAY "CITY:    " GET mcity     PICTURE "!XXXXXXXXXXXXXXXXXXX"
  88.         @  3, 0 SAY "STATE:   " GET mstate    PICTURE  "!!"
  89.         @  3,15 SAY "ZIP: "     GET mzip
  90.         @  4, 0 SAY "TERMS:   " GET mterms    FUNCTION "!"
  91.         @  5, 0 SAY "Enter one or more filter conditions"
  92.         READ
  93.     DEACTIVATE WINDOW alert
  94.     subset = " "          && Initialize filter condition variable to null
  95.     * Process user's entries to build filter condition
  96.     mcategory = TRIM(mcategory)
  97.     mcity   = UPPER(TRIM(mcity))
  98.     mstate  = TRIM(mstate)
  99.     mzip    = TRIM(mzip)
  100.     mterms  = TRIM(mterms)
  101.     subset  = subset + IIF("" <> mcategory, ;
  102.               [category = mcategory .AND. ], "")
  103.     subset  = subset + IIF("" <> mcity, ;
  104.               [UPPER(TRIM(city)) = mcity .AND. ], "")
  105.     subset  = subset + IIF("" <> mstate, ;
  106.               [state = mstate .AND. ], "")
  107.     subset  = subset + IIF("" <> mzip, ;
  108.               [zip = mzip .AND. ], "")
  109.     subset  = subset + IIF("" <> mterms, ;
  110.               [terms = mterms .AND. ], "")
  111.     *
  112.     IF "" = TRIM(subset)    && Check whether data entered into subset string
  113.        DO Warnbell
  114.        filters_on = .F.
  115.     ELSE
  116.        * If string is not empty, truncate the .AND. from end of subset string
  117.        subset = SUBSTR(subset,1,LEN(subset)-6)
  118.        SET FILTER TO &subset.     && Filter on entered filter string condition
  119.        GO TOP                     && Activate filter by moving record pointer
  120.        * Check whether filter condition matches any records (no match=EOF)
  121.        filters_on = .NOT. EOF()   && Filter is turned on if .T. 
  122.        IF .NOT. filters_on        && Turn off filter if no matches found
  123.           DO Warnbell
  124.           DO Show_msg WITH "No Customer records match the filter condition"
  125.           SET FILTER TO
  126.           GO record_num
  127.        ENDIF
  128.     ENDIF
  129.   ELSE
  130.      * If user selects "T", turn off filter
  131.      SET FILTER TO
  132.      filters_on = .F.
  133.   ENDIF
  134. RETURN
  135.  
  136. PROCEDURE Indexer
  137.    * Create/rebuild index
  138.    INDEX ON cust_id TAG Cust_id
  139.    GO TOP
  140. RETURN
  141.  
  142. PROCEDURE Init_fld
  143.    * Initialize memory variable values for data entry
  144.    STORE SPACE(30) TO customer, address1
  145.    STORE SPACE(20) TO city, contact, comments
  146.    STORE SPACE(10) TO zip, terms
  147.    STORE SPACE(13) TO phone, phone_cont
  148.    state     = "TX"                     && Could be any state or blank
  149.    cust_id   = SPACE(6)
  150.    category  = SPACE(15)
  151.    address2  = SPACE(25)
  152.    phone_ext = SPACE(4)
  153.    date_last = { / / }
  154. RETURN
  155.  
  156. PROCEDURE Load_fld
  157.    * Load field values from Cust database record into memory variables
  158.    cust_id    = cust_id
  159.    category   = category
  160.    customer   = customer
  161.    address1   = address1
  162.    address2   = address2
  163.    city       = city
  164.    state      = state
  165.    zip        = zip
  166.    phone      = phone
  167.    contact    = contact
  168.    phone_cont = phone_cont
  169.    phone_ext  = phone_ext
  170.    date_last  = date_last
  171.    terms      = terms
  172.    comments   = comments
  173. RETURN
  174.  
  175. PROCEDURE Repl_fld
  176.    * Replace database fields with values of current memory variables
  177.    REPLACE cust_id WITH m->cust_id, category WITH m->category, ;
  178.            customer WITH m->customer,address1 WITH m->address1, ;
  179.            address2 WITH m->address2,city WITH m->city, state WITH m->state
  180.    REPLACE zip WITH m->zip, phone WITH m->phone,;
  181.            contact WITH m->contact,phone_cont WITH m->phone_cont,;
  182.            phone_ext WITH m->phone_ext,date_last WITH m->date_last, ;
  183.            terms WITH m->terms,comments WITH m->comments
  184. RETURN
  185.  
  186. PROCEDURE Backgrnd
  187.    * Display background screen
  188.    * Draw and fill in boxes
  189.    @  1,18 TO  3,41 DOUBLE COLOR &c_blue.
  190.    @  5, 2 TO  7,56 DOUBLE COLOR &c_red.
  191.    @  2,19 FILL TO  2,40   COLOR &c_blue.
  192.    @  6, 3 FILL TO  6,55   COLOR &c_red.
  193.    @  9, 3 FILL TO 19,55   COLOR &c_red.
  194.    @ 15, 2 TO 15,56        COLOR &c_red.
  195.    @  8, 2 TO 20,56        COLOR &c_red.
  196.    SET COLOR TO &c_data.
  197.    @  2,20 SAY "CUSTOMER  DATABASE"
  198.    @  6, 4 SAY "CUSTOMER NO:"
  199.    @  6,30 SAY "CATEGORY:"
  200.    @  9, 4 SAY "NAME:"
  201.    @ 10, 4 SAY "ADDRESS:"
  202.    @ 12, 4 SAY "CITY:"
  203.    @ 13, 4 SAY "STATE:"
  204.    @ 13,16 SAY "ZIP:"
  205.    @ 14, 4 SAY "PHONE:"
  206.    @ 16, 4 SAY "CONTACT:"
  207.    @ 17, 4 SAY "PHONE:"
  208.    @ 17,27 SAY "EXTENSION:"
  209.    @ 18, 4 SAY "LAST CONTACT DATE:"
  210.    @ 19, 4 SAY "TERMS:"
  211.    @ 19,27 SAY "COMMENT:"
  212.    SET COLOR TO &c_standard.
  213. RETURN
  214.  
  215. PROCEDURE Show_data
  216.    * Display data for entry
  217.    SET COLOR TO &c_fields.
  218.    @  6,17 SAY cust_id
  219.    @  6,40 SAY category
  220.    @  9,13 SAY customer
  221.    @ 10,13 SAY address1
  222.    @ 11,13 SAY address2
  223.    @ 12,13 SAY city
  224.    @ 13,13 SAY state
  225.    @ 13,21 SAY zip
  226.    @ 14,13 SAY phone
  227.    @ 16,13 SAY contact
  228.    @ 17,13 SAY phone_cont
  229.    @ 17,38 SAY phone_ext
  230.    @ 18,23 SAY date_last
  231.    @ 19,13 SAY terms
  232.    @ 19,36 SAY comments
  233.    SET COLOR TO &c_standard.
  234. RETURN
  235.  
  236. PROCEDURE Get_data
  237.    * Display data for entry
  238.    SET COLOR TO &c_data.
  239.    @  6,17 GET m->cust_id   PICTURE  "!99999" ;
  240.            VALID Duplicat(&key.) ;
  241.            ERROR "Invalid customer ID number; please re-enter" ;
  242.            MESSAGE "Enter a six digit customer ID beginning " + ;
  243.                    "with a letter, or Esc to quit"
  244.    @  6,40 GET m->category ;
  245.            PICTURE "@M ARCHITECTS, CONSULTANTS, CONTRACTORS, LEGAL" ;
  246.            MESSAGE "Press spacebar for Category choices"
  247.    @  9,13 GET m->customer  FUNCTION "!" ;
  248.            MESSAGE "Enter name of customer"
  249.    @ 10,13 GET m->address1
  250.    @ 11,13 GET m->address2
  251.    @ 12,13 GET m->city       PICTURE "!XXXXXXXXXXXXX"
  252.    @ 13,13 GET m->state      PICTURE  "!!"
  253.    @ 13,21 GET m->zip
  254.    @ 14,13 GET m->phone      PICTURE  "(999)999-9999"
  255.    @ 16,13 GET m->contact    FUNCTION "!" ;
  256.            MESSAGE "Enter name of contact"
  257.    @ 17,13 GET m->phone_cont PICTURE "(999)999-9999"
  258.    @ 17,38 GET m->phone_ext  PICTURE "9999" ;
  259.            MESSAGE "Enter phone extension"
  260.    @ 18,23 GET m->date_last  FUNCTION "D" ;
  261.            MESSAGE "Enter date that customer was last contacted"
  262.    @ 19,13 GET m->terms      PICTURE "@M CASH, NET 30, NET 45" ;
  263.            MESSAGE "Press spacebar to see Terms choices"
  264.    @ 19,36 GET m->comments   FUNCTION "!" ;
  265.            MESSAGE "Enter any comments"
  266.    SET COLOR TO &c_standard.
  267.    ON KEY LABEL F9 DO Findcode WITH m->city
  268. RETURN
  269. ********************************  END OF CUST.PRG ****************************
  270.