home *** CD-ROM | disk | FTP | other *** search
/ DOS Wares / doswares.zip / doswares / DATABASE / DBASE4NL / SAMPLES.ZIP / LEVERAN.PRG < prev    next >
Encoding:
Text File  |  1993-05-18  |  8.3 KB  |  251 lines
  1. ******************************************************************************
  2. * PROGRAM NAME:     LEVERAN.PRG
  3. *                   VENDORS DATABASE SCREEN 
  4. *                   SAMPLE BUSINESS APPLICATION PROGRAM
  5. * LAST CHANGED:     080692
  6. * WRITTEN BY:       Borland International Inc.
  7. ******************************************************************************
  8. *
  9. *       FILES USED:
  10. *       Database file    =  Verkoper.dbf  (Vendors file)
  11. *       Index file       =  Verkoper.mdx 
  12. *         TAG: Verkoop_nr =  verkoop_nr  <= Master index
  13. *       External procedure file = Biblio.prg
  14. ******************************************************************************
  15.  
  16. * Main procedure
  17. PROCEDURE Leveran
  18.  
  19.    * Link to external procedure file of "tool" procedures
  20.    SET PROCEDURE TO Biblio
  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.    korting = 0
  30.    STORE "" TO  verkoop_nr, verkoper, adres1, adres2, woonplaats, provincie, postcode, telefoon, ;
  31.      contact, intern, condities
  32.  
  33.    * Miscellaneous variables - used to pass parameters to Library
  34.    STORE "VERKOPER" TO dbf, mlist       && Standard report and mailing list is available
  35.    cust_rpt = "N/B"                    && No custom reports available
  36.    STORE "m->verkoop_nr" TO key, key1
  37.    STORE  "GEEN" TO key2, key3
  38.    keyname1 = "Verkoopnr.:"
  39.    STORE "" TO keyname2, keyname3
  40.    list_flds = "VERKOOP_NR, VERKOPER, TELEFOON"
  41.  
  42.    * Open databases files and choose active indexes
  43.    SELECT 1
  44.    USE Verkoper ORDER Verkoop_nr
  45.    GO TOP
  46.    * Used for area code lookup
  47.    USE Netnum ORDER Woonplaats IN 2
  48.  
  49.    record_num = RECNO()
  50.    * Load initial record from database into memory variables
  51.    DO Load_fld
  52.  
  53.    * Show data screen
  54.    CLEAR
  55.    DO Dstatus
  56.    DO Backgrnd
  57.    DO Show_data
  58.  
  59.    * Define popup menus
  60.    DO Bar_def
  61.    
  62.    * Activate main popup menu - execute user choices
  63.    SET COLOR TO &c_popup.
  64.    ACTIVATE POPUP main_mnu
  65.    DO Sub_ret
  66.    *
  67. RETURN
  68. *================= end of main procedure ===================================
  69.  
  70. *  UTILITY PROCEDURES (Proprietary to Vendors.prg)
  71.  
  72. PROCEDURE Filter
  73.    * Filter (group) data into subset
  74.    * Select subset to set up filter condition  (Y=turn on,N=abort selection,T=turn off)
  75.    * If filter is already on, set default choice to T, show window
  76.    * If filter is not on, set default choice to Y, show window
  77.    choice = IIF(filters_on,"U","J")
  78.    DO Filt_ans
  79.    IF choice = "J"
  80.       * Start process of choosing filter condition
  81.       STORE SPACE(15) TO woonplaats, condities
  82.       STORE SPACE(2)  TO provincie
  83.       STORE SPACE(7) TO postcode
  84.       ACTIVATE WINDOW alert
  85.      * Get users filter condition selection(s)
  86.      @   0,0 SAY "------- FILTERVOORWAARDE OPGEVEN -------"
  87.      @   1,1 SAY "WOONPLAATS:  " GET m->woonplaats FUNCTION "!"
  88.      @   2,1 SAY "PROVINCIE:   " GET m->provincie  PICTURE "!!"
  89.      @   3,1 SAY "POSTCODE:    " GET m->postcode
  90.      @   4,1 SAY "CONDITIES:   " GET m->condities  FUNCTION "!"
  91.      READ
  92.       DEACTIVATE WINDOW alert
  93.       * Initialize filter condition variable to null (empty)
  94.       PUBLIC subset1,subset2,subset3,subset4,subset5
  95.       subset1 = ""
  96.       * Process user's entries to build filter condition
  97.       subset2 = subset1 + IIF([] <> TRIM(m->woonplaats), ;
  98.                 [UPPER(woonplaats) = UPPER(TRIM(m->woonplaats)) .AND. ], [])
  99.       subset3 = subset2 + IIF([] <> TRIM(m->provincie), ;
  100.                 [provincie = TRIM(provincie) .AND. ], [])
  101.       subset4 = subset3 + IIF([] <> TRIM(m->postcode), ;
  102.                 [postcode = TRIM(postcode) .AND. ], [])
  103.       subset5 = subset4 + IIF("" <> TRIM(m->condities), ;
  104.                 [condities = TRIM(condities) .AND. ], [])
  105.       subset = subset5
  106.       *
  107.       * Check whether data entered into subset string
  108.       IF "" = TRIM(subset)
  109.      DO Warnbell
  110.      filters_on = .F.
  111.       ELSE
  112.      * If string is not empty, truncate the .AND. from end of subset string
  113.      subset = SUBSTR(subset,1,LEN(subset)-6)
  114.      * Filter on entered filter string condition
  115.      SET FILTER TO &subset.
  116.      * Activate filter by moving record pointer
  117.      GO TOP
  118.      * Check whether filter condition matches any records (none matching=EOF)
  119.      filters_on = .NOT. EOF()   && Filter is turned on if .T. (matching record)
  120.      IF .NOT. filters_on
  121.         * Turn off filter if no matching records found
  122.         DO Warnbell
  123.         DO Show_msg WITH "0 records voldoen aan filtervoorwaarde"
  124.         SET FILTER TO 
  125.         GO record_num
  126.      ENDIF
  127.       ENDIF
  128.    ELSE
  129.       * If user selects "T", turn off filter
  130.       SET FILTER TO 
  131.       filters_on = .F.
  132.    ENDIF
  133. RETURN
  134.  
  135. PROCEDURE Indexer
  136.    * Create/rebuild index 
  137.    INDEX ON verkoop_nr TAG Verkoop_nr
  138.    GO TOP
  139. RETURN
  140.  
  141. PROCEDURE Init_fld
  142.    * Initialize memory variable values - for data entry
  143.    STORE SPACE(4)  TO verkoop_nr,intern
  144.    STORE SPACE(30) TO verkoper, adres1, adres2, contact
  145.    condities = SPACE(15)
  146.    korting   = 0
  147.    woonplaats = SPACE(20)
  148.    provincie = SPACE(2)                   && Could be any state or blank
  149.    postcode   = SPACE(7)
  150.    telefoon = SPACE(13)
  151. RETURN
  152.  
  153. PROCEDURE Load_fld
  154.    * Copy field values from Vendors database record into memory variables
  155.    verkoop_nr = verkoop_nr
  156.    verkoper   = verkoper
  157.    adres1     = adres1
  158.    adres2     = adres2
  159.    woonplaats = woonplaats
  160.    provincie  = provincie
  161.    postcode   = postcode
  162.    telefoon   = telefoon
  163.    contact    = contact
  164.    intern     = intern   
  165.    condities  = condities
  166.    korting    = korting  
  167. RETURN
  168.  
  169. PROCEDURE Repl_fld
  170.    * Replace database fields with values of current memory variables
  171.    REPLACE verkoop_nr WITH m->verkoop_nr,verkoper WITH m->verkoper, ;
  172.        adres1 WITH m->adres1,adres2 WITH m->adres2, ;
  173.        woonplaats WITH m->woonplaats,provincie  WITH m->provincie, ;
  174.        postcode WITH m->postcode,telefoon WITH m->telefoon, ;   
  175.        contact WITH m->contact,intern  WITH m->intern, ;
  176.        condities WITH m->condities,korting WITH m->korting 
  177. RETURN
  178.  
  179. PROCEDURE Backgrnd
  180.    * Display screen for data entry and viewing
  181.    * Draw and fill in boxes
  182.    @ 14, 5 TO 14,52        COLOR &c_red.
  183.    @  1,22 TO  3,53 DOUBLE COLOR &c_blue.
  184.    @  5, 4 TO  7,27 DOUBLE COLOR &c_red. 
  185.    @  8, 4 TO 19,53        COLOR &c_red.
  186.    @  2,23 FILL TO  2,52   COLOR &c_blue.
  187.    @  6, 5 FILL TO  6,26   COLOR &c_red.
  188.    @  9, 5 FILL TO 18,52   COLOR &c_red.
  189.    * Show data
  190.    SET COLOR TO &c_data.
  191.    @  2,28 SAY "DATABASE LEVERANCIERS" 
  192.    @  6, 6 SAY "LEVERANCIERNR:" 
  193.    @  9, 6 SAY "NAAM:   "    
  194.    @ 10, 6 SAY "ADRES:"
  195.    @ 12, 6 SAY "WOONPLAATS:   "
  196.    @ 13, 6 SAY "PROVINCIE:  " 
  197.    @ 13,30 SAY "POSTCODE:"        
  198.    @ 15, 6 SAY "CONTACT:" 
  199.    @ 16, 6 SAY "TELEFOON:  "    
  200.    @ 16,32 SAY "INTERN:"  
  201.    @ 17, 6 SAY "CONDITIES:  "    
  202.    @ 18, 6 SAY "KORTING:"   
  203.    @ 18,20 SAY "%"
  204.    SET COLOR TO &c_standard.
  205. RETURN
  206.  
  207. PROCEDURE Show_data
  208.    SET COLOR TO &c_fields.
  209.    @  6,21 SAY verkoop_nr
  210.    @  9,18 SAY verkoper
  211.    @ 10,18 SAY adres1   
  212.    @ 11,18 SAY adres2
  213.    @ 12,18 SAY woonplaats
  214.    @ 13,18 SAY provincie 
  215.    @ 13,40 SAY postcode
  216.    @ 15,18 SAY contact
  217.    @ 16,18 SAY telefoon
  218.    @ 16,41 SAY intern 
  219.    @ 17,18 SAY condities 
  220.    @ 18,18 SAY korting   PICTURE "99"
  221.    SET COLOR TO &c_standard.
  222. RETURN
  223.  
  224. PROCEDURE Get_data
  225.    SET COLOR TO &c_data.
  226.    @  6,21 GET m->verkoop_nr  PICTURE "9999" ;
  227.            VALID Duplicat(&key.) ;
  228.            ERROR "Ongeldig leveranciernr.; voer ander nummer in" ;
  229.            MESSAGE "Typ een leveranciernr. (4 cijfers) of annuleer met Esc."
  230.    @  9,18 GET m->verkoper     FUNCTION "!" ;
  231.            MESSAGE "Naam van leverancier"
  232.    @ 10,18 GET m->adres1       FUNCTION "!"
  233.    @ 11,18 GET m->adres2       FUNCTION "!"
  234.    @ 12,18 GET m->woonplaats   PICTURE "!XXXXXXXXXXXXX"
  235.    @ 13,18 GET m->provincie    PICTURE "!!"
  236.    @ 13,40 GET m->postcode
  237.    @ 15,18 GET m->contact      FUNCTION "!" ;
  238.            MESSAGE "Naam van contactpersoon"
  239.    @ 16,18 GET m->telefoon     PICTURE "999X9X9999999"
  240.    @ 16,41 GET m->intern       PICTURE "9999" ;
  241.            MESSAGE "Toestelnummer"
  242.    @ 17,18 GET m->condities    FUNCTION "!" ;
  243.            MESSAGE "Verkoopcondities van leverancier"
  244.    @ 18,18 GET m->korting      PICTURE "99" ;
  245.            MESSAGE "Gewenste kortingspercentage"
  246.    SET COLOR TO &c_standard.
  247.    ON KEY LABEL F9 DO Findcode WITH m->woonplaats
  248. RETURN
  249.  
  250.  
  251.