home *** CD-ROM | disk | FTP | other *** search
/ Liren Large Software Subsidy 5 / 05.iso / a / a031 / samples.exe / GOODS.PRG < prev    next >
Encoding:
Text File  |  1992-03-10  |  7.9 KB  |  236 lines
  1. ******************************************************************************
  2. * PROGRAM NAME: GOODS.PRG
  3. *               INVENTORY 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      =  Goods.dbf  (Inventory file)
  11. *       Index file         =  Goods.mdx
  12. *           TAG: Part_id   =  part_id   <= Master index
  13. *           TAG: Vendor_id =  vendor_id
  14. *       External procedure file = Library.prg
  15. ******************************************************************************
  16.  
  17. * Main procedure
  18. PROCEDURE Goods
  19.  
  20.    * Link to external procedure file of "tool" procedures
  21.    SET PROCEDURE TO Library
  22.  
  23.    * Set up database environment
  24.    DO Set_env
  25.  
  26.    SET COLOR TO &c_standard.
  27.  
  28.    * Declare variables used:
  29.    * Database memory variables
  30.    STORE ""  TO part_id, part_name, descript, vendor_id, comments
  31.    STORE 0   TO price, cost, qty_onhand, qty_2order, lead_time
  32.    discontinu = .F.
  33.  
  34.    * Miscellaneous variables - used to pass parameters to Library
  35.    dbf      = "GOODS"                    && Standard report is available
  36.    mlist    = "NOT AVAILABLE"            && No mailing list available
  37.    cust_rpt = "N/A"                      && No custom reports available
  38.    STORE "m->part_id" TO key, key1
  39.    STORE "NONE" TO key2, key3
  40.    keyname1 = "Part ID:"
  41.    STORE "" TO keyname2, keyname3, mvendorid
  42.    list_flds = "PART_ID, PART_NAME, QTY_ONHAND"
  43.  
  44.    * Open database files and choose active index files
  45.    SELECT 1
  46.    USE Goods ORDER Part_id
  47.    GO TOP
  48.    * Used for vendor data lookup
  49.    USE Vendors ORDER Vendor_id IN 2
  50.  
  51.    record_num = RECNO()
  52.    DO Load_fld
  53.  
  54.    * Show data screen
  55.    CLEAR
  56.    DO Dstatus
  57.    DO Backgrnd
  58.    DO Show_data
  59.  
  60.    * Define popup menus
  61.    DO Bar_def
  62.  
  63.    * Activate main popup menu - execute user choices
  64.    SET COLOR TO &c_popup.
  65.    ACTIVATE POPUP main_mnu
  66.    DO Sub_ret
  67.    *
  68. RETURN
  69. *======================== end of main procedure ==============================
  70.  
  71. *  UTILITY PROCEDURES (Proprietary to Goods.prg)
  72.  
  73. PROCEDURE Filter
  74.    * Filter (group) data into subset
  75.    * Select subset to set up filter condition (Y=turn on, N=abort selection,
  76.    * T=turn off). If filter is already on, set default choice to T, show 
  77.    * window. If filter is not on, set default choice to Y, show window.
  78.    choice = IIF(filters_on,"T","Y")
  79.    DO Filt_ans
  80.    IF choice = "Y"
  81.       * Start process of choosing filter condition
  82.       mvendorid  = SPACE(4)
  83.       ACTIVATE WINDOW alert
  84.          * Get user's filter condition selection(s)
  85.          @  0, 0 SAY "-------- ENTER FILTER CONDITION --------"
  86.          @  2, 0 SAY "VENDOR ID:" GET mvendorid FUNCTION "9"
  87.          READ
  88.       DEACTIVATE WINDOW alert
  89.       *
  90.       * Check whether data entered into subset string
  91.       IF "" = TRIM(mvendorid)
  92.          filters_on = .F.
  93.          DO Warnbell
  94.       ELSE
  95.          * Filter on entered filter string condition
  96.          SET FILTER TO vendor_id = TRIM(mvendorid)
  97.          * Activate filter by moving record pointer
  98.          GO TOP
  99.          * Check whether filter condition matches any records (no match=EOF)
  100.          filters_on = .NOT. EOF()   && Filter is turned on if .T.
  101.          IF .NOT. filters_on
  102.             * Turn off filter if no matching records found
  103.             DO Warnbell
  104.             DO Show_msg WITH "No Goods (inventory) records match the " + ;
  105.                              "filter condition"
  106.             SET FILTER TO
  107.             GO record_num
  108.          ENDIF
  109.       ENDIF
  110.    ELSE
  111.       * If user selects "T", turn off filter
  112.       SET FILTER TO
  113.       filters_on = .F.
  114.    ENDIF
  115. RETURN
  116.  
  117. PROCEDURE Indexer
  118.    * Create/rebuild indexes
  119.    INDEX ON vendor_id TAG Vendor_id
  120.    INDEX ON part_id   TAG Part_id
  121.    GO TOP
  122. RETURN
  123.  
  124. PROCEDURE Init_fld
  125.    * Initialize memory variable values for data entry
  126.    part_id   = SPACE(10)
  127.    STORE SPACE(30) TO part_name, descript, comments
  128.    STORE 0 TO qty_onhand, cost, price, qty_2order, lead_time
  129.    vendor_id = SPACE(4)
  130. RETURN
  131.  
  132. PROCEDURE Load_fld
  133.    * Load field values from Goods database record into memory variables
  134.    part_id    = part_id
  135.    part_name  = part_name
  136.    descript   = descript
  137.    qty_onhand = qty_onhand
  138.    cost       = cost
  139.    price      = price
  140.    qty_2order = qty_2order
  141.    vendor_id  = vendor_id
  142.    lead_time  = lead_time
  143.    comments   = comments
  144. RETURN
  145.  
  146. PROCEDURE Repl_fld
  147.    * Replace database fields with values of current memory variables
  148.    REPLACE part_id WITH m->part_id, part_name WITH m->part_name, ;
  149.            descript WITH m->descript, qty_onhand WITH m->qty_onhand, ;
  150.            cost WITH m->cost, price WITH m->price, ;
  151.            qty_2order WITH m->qty_2order, vendor_id WITH m->vendor_id, ;
  152.            lead_time WITH m->lead_time, comments WITH m->comments
  153. RETURN
  154.  
  155. PROCEDURE Backgrnd
  156.    * Show background screen
  157.    * Draw and fill in boxes
  158.    @  1,17 TO  3,46 DOUBLE COLOR &c_blue.
  159.    @  5, 2 TO  7,30 DOUBLE COLOR &c_red.
  160.    @  2,18 FILL TO  2,45   COLOR &c_blue.
  161.    @  6, 3 FILL TO  6,29   COLOR &c_red.
  162.    @  9, 3 FILL TO 18,54   COLOR &c_red.
  163.    @ 13, 3 TO 13,54        COLOR &c_red.
  164.    @  8, 2 TO 19,55        COLOR &c_red.
  165.    SET COLOR TO &c_data.
  166.    @  2,19 SAY "GOODS (INVENTORY) DATABASE"
  167.    @  6, 4 SAY "PART NO.:"
  168.    @  9, 4 SAY "NAME:"
  169.    @ 10, 4 SAY "DESCRIPTION:"
  170.    @ 11, 4 SAY "SALES PRICE:"
  171.    @ 12, 4 SAY "QUANTITY ON HAND:"
  172.    @ 12,32 SAY "DISCONTINUED:"
  173.    @ 14, 4 SAY "VENDOR NUMBER:"
  174.    @ 15, 4 SAY "COST:     $"
  175.    @ 16, 4 SAY "QUANTITY TO ORDER:"
  176.    @ 16,29 SAY "(minimum/batch)"
  177.    @ 17, 4 SAY "LEAD TIME:"
  178.    @ 17,20 SAY "(in days)"
  179.    @ 18, 4 SAY "COMMENTS:"
  180.    SET COLOR TO &c_standard.
  181. RETURN
  182.  
  183. PROCEDURE Show_data
  184.    * Show screen for data entry
  185.    SET COLOR TO &c_fields.
  186.    @  6,15 SAY part_id
  187.    @  9,17 SAY part_name
  188.    @ 10,17 SAY descript
  189.    @ 11,17 SAY price      PICTURE  "99,999.99"
  190.    @ 12,22 SAY qty_onhand PICTURE  "9,999"
  191.    @ 12,46 SAY discontinu PICTURE  "Y"
  192.    @ 14,19 SAY vendor_id
  193.    @ 15,16 SAY cost       PICTURE  "99,999.99"
  194.    @ 16,23 SAY qty_2order PICTURE  "9,999"
  195.    @ 17,16 SAY lead_time  PICTURE  "999"
  196.    @ 18,16 SAY comments
  197.    SET COLOR TO &c_standard.
  198. RETURN
  199.  
  200. PROCEDURE Get_data
  201.    * Show screen for data entry
  202.    SET COLOR TO &c_data.
  203.    @  6,15 GET m->part_id    FUNCTION "!" ;
  204.            VALID Duplicat(&key.) ;
  205.            ERROR "Duplicate part ID number, please re-enter" ;
  206.            MESSAGE "Enter a part ID number, or Esc to quit"
  207.    @  9,17 GET m->part_name  FUNCTION "!" ;
  208.            MESSAGE "Enter the name of the part"
  209.    @ 10,17 GET m->descript   FUNCTION "!" ;
  210.            MESSAGE "Enter a description of the part"
  211.    @ 11,17 GET m->price      PICTURE  "99,999.99" ;
  212.            MESSAGE "Enter the selling price of this part"
  213.    @ 12,22 GET m->qty_onhand PICTURE  "9,999" ;
  214.            MESSAGE "Enter how many of these parts are in current inventory"
  215.    @ 12,46 GET m->discontinu PICTURE  "Y" ;
  216.            MESSAGE "Is the part now discontinued (Y/N)"
  217.    @ 14,19 GET m->vendor_id  FUNCTION "9" ;
  218.            VALID Lookupid((m->vendor_id),"Vendors", "Vendor",1) ;
  219.            ERROR "Invalid vendor ID number, please re-enter" ;
  220.            MESSAGE "Enter a vendor ID number, or Esc to quit"
  221.    @ 15,16 GET m->cost       PICTURE  "99,999.99" ;
  222.            MESSAGE "Enter the cost of the part"
  223.    @ 16,23 GET m->qty_2order PICTURE  "9,999" ;
  224.            MESSAGE "Enter the minimum quantity which can be ordered"
  225.    @ 17,16 GET m->lead_time  PICTURE  "999" ;
  226.            MESSAGE "Enter the lead time before vendor " + ;
  227.                    "typically ships the parts"
  228.    @ 18,16 GET m->comments   FUNCTION "!" ;
  229.            MESSAGE "Enter any comments on this part"
  230.    SET COLOR TO &c_standard.
  231.    ON KEY LABEL F9 DO Findvend WITH m->vendor_id
  232. RETURN
  233.  
  234. *********************************** END OF GOODS.PRG *************************
  235.  
  236.