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