home *** CD-ROM | disk | FTP | other *** search
/ DOS Wares / doswares.zip / doswares / DATABASE / DBASE4NL / SAMPLES.ZIP / KLNT.PRG < prev    next >
Encoding:
Text File  |  1993-05-18  |  9.9 KB  |  287 lines
  1. *****************************************************************************************
  2. * PROGRAM NAME:                       KLNT.PRG
  3. *                                     CUSTOMER DATABASE SCREEN
  4. *                                     SAMPLE BUSINESS APPLICATION PROGRAM
  5. * LAST CHANGED:                       080692
  6. * WRITTEN BY:                         Borland International Inc.
  7. *****************************************************************************************
  8. *       FILES USED:
  9. *       Database file =  Klnt.dbf   (Customer file)
  10. *       Index file    =  Klnt.mdx 
  11. *           TAG: Klnt =  klant_nr  <= Master index
  12. *       External procedure file = Biblio.prg
  13. *****************************************************************************************
  14. * Main procedure
  15. PROCEDURE Klnt
  16.  
  17.    * Link to external procedure file of "tool" procedures
  18.    SET PROCEDURE TO Biblio
  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 klant_nr, categorie, klantnaam, adres1, adres2, woonplaats, provincie, postcode, telefoon
  28.    STORE "" TO contact, tel_contct, intern, dat_laatst, condities, commentaar
  29.  
  30.    * Miscellaneous variables - used to pass parameters to Library
  31.    STORE "KLNT" TO dbf, mlist         && Standard report and mailing list is available
  32.    STORE "N/B"  TO cust_rpt           && No custom reports available
  33.    STORE "m->klant_nr" TO key, key1
  34.    STORE "GEEN" TO key2, key3
  35.    keyname1 = "Klantnummer:"
  36.    STORE "" TO keyname2, keyname3, mcategory, mcity, mstate
  37.    list_flds = "KLANT_NR, CONTACT, TEL_CONTCT, INTERN"
  38.  
  39.    * Open database files and choose active indexes
  40.    SELECT 1
  41.    USE Klnt ORDER Klant_nr
  42.    GO TOP
  43.    * Used for area code lookup
  44.    USE Netnum ORDER Woonplaats IN 2
  45.    
  46.    record_num = RECNO()
  47.    * Load initial record from database into memory variables
  48.    DO Load_fld
  49.  
  50.    * Show data screen
  51.    CLEAR
  52.    DO Dstatus
  53.    DO Backgrnd
  54.    DO Show_data
  55.  
  56.    DO Bar_def            && Define popup menus
  57.    
  58.    * Activate main popup menu - execute user choices
  59.    SET COLOR TO &c_popup.
  60.    ACTIVATE POPUP main_mnu
  61.    DO Sub_ret
  62.    *
  63. RETURN
  64. *=============================== end of main procedure ===============================
  65.  
  66. *  UTILITY PROCEDURES (Proprietary to Cust.prg)
  67.  
  68. PROCEDURE Filter
  69.   * Filter (group) data into subset
  70.   * Select subset to set up filter condition  (J=turn on,N=abort selection,U=turn off)
  71.   * If filter is already on, set default choice to T, show window
  72.   * If filter is not on, set default choice to Y, show window
  73.   choice = IIF(filters_on,"N","J")
  74.   DO Filt_ans
  75.   IF choice = "J"
  76.      * Start process of choosing filter condition
  77.      mcategory  = SPACE(15)
  78.      mcity      = SPACE(20)
  79.      mstate     = SPACE(2)
  80.      STORE SPACE(10) TO mzip, mterms
  81.      ACTIVATE WINDOW alert
  82.     * Get user's filter condition selection(s)
  83.     @  0, 0 SAY "------- FILTERVOORWAARDE OPGEVEN ------"
  84.     @  1, 0 SAY "CATEGORIE:" GET mcategory FUNCTION "!" ;
  85.        MESSAGE "Typ de gewenste categorie:"
  86.     @  2, 0 SAY "WOONPLAATS: " GET mcity     FUNCTION "!" 
  87.     @  3, 0 SAY "PROVINCIE:  " GET mstate    PICTURE  "!!"
  88.     @  3,20 SAY "POSTCODE: " GET mzip
  89.     @  4, 0 SAY "CONDITIES:  " GET mterms    FUNCTION "!"
  90.     @  5, 0 SAY "Geef één of meer filtervoorwaarden op"
  91.     READ
  92.     DEACTIVATE WINDOW alert
  93.     subset = ""            && Initialize filter condition variable to null (empty)
  94.     * Process user's entries to build filter condition
  95.     mcategory = TRIM(mcategory)
  96.     mcity   = TRIM(mcity)
  97.     mstate  = TRIM(mstate)
  98.     mzip    = TRIM(mzip)
  99.     mterms  = TRIM(mterms)
  100.     subset  = subset + IIF("" <> mcategory, ;
  101.               [categorie = mcategory .AND. ], "")
  102.     subset  = subset + IIF("" <> mcity, ;
  103.               [UPPER(TRIM(woonplaats)) = UPPER(mcity) .AND. ],"")
  104.     subset  = subset + IIF("" <> mstate, ;
  105.               [provincie = mstate .AND. ], "")
  106.     subset  = subset + IIF("" <> mzip, ;
  107.               [postcode = mzip .AND. ], "")
  108.     subset  = subset + IIF("" <> mterms, ;
  109.               [condities = mterms .AND. ], "")
  110.     *
  111.     IF "" = TRIM(subset)    && Check whether data entered into subset string
  112.        DO Warnbell
  113.        filters_on = .F.
  114.     ELSE
  115.        * If string is not empty, truncate the .AND. from end of subset string
  116.        subset = SUBSTR(subset,1,LEN(subset)-6)
  117.        SET FILTER TO &subset.     && Filter on entered filter string condition
  118.        GO TOP                     && Activate filter by moving record pointer
  119.        * Check whether filter condition matches any records (none matching=EOF)
  120.        filters_on = .NOT. EOF()   && Filter is turned on if .T. (matching records found)
  121.        IF .NOT. filters_on        && 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 klant_nr TAG Klant_nr
  138.    GO TOP
  139. RETURN
  140.  
  141. PROCEDURE Init_fld
  142.    * Initialize memory variable values for data entry
  143.    STORE SPACE(30) TO klantnaam, adres1
  144.    STORE SPACE(20) TO woonplaats, contact, commentaar
  145.    STORE SPACE(10) TO postcode, condities
  146.    STORE SPACE(13) TO telefoon, tel_contct
  147.    provincie  = "NH"                     && Could be any state or blank
  148.    klant_nr   = SPACE(6)
  149.    categorie  = SPACE(15)
  150.    adres2     = SPACE(25)
  151.    intern     = SPACE(4)
  152.    dat_laatst = { - - }
  153. RETURN
  154.  
  155. PROCEDURE Load_fld
  156.    * Load field values from Klnt database record into memory variables
  157.    klant_nr   = klant_nr
  158.    categorie  = categorie
  159.    klantnaam  = klantnaam
  160.    adres1     = adres1
  161.    adres2     = adres2
  162.    woonplaats = woonplaats
  163.    provincie  = provincie
  164.    postcode   = postcode
  165.    telefoon   = telefoon
  166.    contact    = contact
  167.    tel_contct = tel_contct
  168.    intern     = intern
  169.    dat_laatst = dat_laatst
  170.    condities  = condities
  171.    commentaar = commentaar
  172. RETURN
  173.  
  174. PROCEDURE Repl_fld
  175.    * Replace database fields with values of current memory variables
  176.    REPLACE klant_nr WITH m->klant_nr, categorie WITH m->categorie, ;
  177.        klantnaam WITH m->klantnaam, adres1 WITH m->adres1, ;
  178.        adres2 WITH m->adres2, woonplaats WITH m->woonplaats, provincie WITH m->provincie
  179.    REPLACE postcode WITH m->postcode, telefoon WITH m->telefoon,;
  180.        contact WITH m->contact, tel_contct WITH m->tel_contct,;
  181.        intern WITH m->intern, dat_laatst WITH m->dat_laatst, ;
  182.        condities WITH m->condities, commentaar WITH m->commentaar
  183. RETURN
  184.  
  185. PROCEDURE Backgrnd
  186.    * Display screen for data entry and viewing
  187.    * Draw and fill in boxes
  188.    @  1,18 TO  3,41 DOUBLE COLOR &c_blue.
  189.    @  5, 2 TO  7,56 DOUBLE COLOR &c_red. 
  190.    @  2,19 FILL TO  2,40   COLOR &c_blue.
  191.    @  6, 3 FILL TO  6,55   COLOR &c_red.
  192.    @  9, 3 FILL TO 19,55   COLOR &c_red.
  193.    @ 15, 2 TO 15,56        COLOR &c_red.
  194.    @  8, 2 TO 20,56        COLOR &c_red.
  195.    * Show data
  196.    SET COLOR TO &c_data.
  197.    @  2,20 SAY " DATABASE KLANTEN"
  198.    @  6, 4 SAY "KLANTNUMMER:"
  199.    @  6,29 SAY "CATEGORIE:"
  200.    @  9, 4 SAY "NAAM:"
  201.    @ 10, 4 SAY "ADRES:"
  202.    @ 12, 4 SAY "PLAATS:"
  203.    @ 13, 4 SAY "PROV.:"
  204.    @ 13,26 SAY "POSTCODE:"
  205.    @ 14, 4 SAY "TEL.:"
  206.    @ 16, 4 SAY "CONTACT:"
  207.    @ 17, 4 SAY "TEL.:"
  208.    @ 17,27 SAY "TOESTEL:"
  209.    @ 18, 4 SAY "LAATSTE CONTACT OP:"
  210.    @ 19, 4 SAY "CONDITIES:"
  211.    @ 19,27 SAY "INFO:"
  212.    SET COLOR TO &c_standard.
  213. RETURN
  214.  
  215.    @  6,17 SAY klant_nr
  216.    @  6,40 SAY categorie
  217.    @  9,13 SAY klantnaam
  218.    @ 10,13 SAY adres1
  219.    @ 11,13 SAY adres2
  220.    @ 12,13 SAY woonplaats
  221.    @ 13,13 SAY provincie
  222.    @ 13,36 SAY postcode
  223.    @ 14,13 SAY telefoon
  224.    @ 16,13 SAY contact
  225.    @ 17,13 SAY tel_contct
  226.    @ 17,38 SAY intern
  227.    @ 18,26 SAY dat_laatst
  228.    @ 19,15 SAY condities
  229.    @ 19,35 SAY commentaar
  230.    SET COLOR TO &c_standard.
  231. RETURN
  232.  
  233. PROCEDURE Show_data
  234.    SET COLOR TO &c_fields.
  235.    @  6,17 SAY klant_nr
  236.    @  6,40 SAY categorie
  237.    @  9,13 SAY klantnaam
  238.    @ 10,13 SAY adres1
  239.    @ 11,13 SAY adres2
  240.    @ 12,13 SAY woonplaats
  241.    @ 13,13 SAY provincie
  242.    @ 13,36 SAY postcode
  243.    @ 14,13 SAY telefoon
  244.    @ 16,13 SAY contact
  245.    @ 17,13 SAY tel_contct
  246.    @ 17,38 SAY intern
  247.    @ 18,26 SAY dat_laatst
  248.    @ 19,15 SAY condities
  249.    @ 19,35 SAY commentaar
  250.    SET COLOR TO &c_standard.
  251. RETURN
  252.  
  253. PROCEDURE Get_data
  254.    SET COLOR TO &c_data.
  255.    @  6,17 GET m->klant_nr  PICTURE "!99999" ;
  256.            VALID Duplicat(&key.) ;
  257.            ERROR "Ongeldig klantnr.; voer ander nummer in" ;
  258.            MESSAGE "Typ klantnummer van zes cijfers, beginnend " + ;
  259.                    "met een letter, annuleer met Esc."
  260.    @  6,40 GET m->categorie ;
  261.            PICTURE "@M ARCHITECT,CONSULTANT,AANNEMER,JURIDISCH" ;
  262.            MESSAGE "Druk op spatiebalk voor andere categorie"
  263.    @  9,13 GET m->klantnaam    FUNCTION "!" ;
  264.            MESSAGE "Naam van klant"
  265.    @ 10,13 GET m->adres1
  266.    @ 11,13 GET m->adres2
  267.    @ 12,13 GET m->woonplaats   PICTURE "!XXXXXXXXXXXXX"
  268.    @ 13,13 GET m->provincie    PICTURE "!!"
  269.    @ 13,36 GET m->postcode
  270.    @ 14,13 GET m->telefoon     PICTURE "999X9X9999999"
  271.    @ 16,13 GET m->contact      FUNCTION "!" ;
  272.            MESSAGE "Naam van contactpersoon"
  273.    @ 17,13 GET m->tel_contct   PICTURE "999X9X9999999"
  274.    @ 17,38 GET m->intern       PICTURE "9999" ;
  275.            MESSAGE "Toestelnummer"
  276.    @ 18,26 GET m->dat_laatst   FUNCTION "D";
  277.            MESSAGE "Datum van laatste contact met cliënt"
  278.    @ 19,15 GET m->condities    PICTURE "@M CASH, NETTO30, NETTO45" ;
  279.            MESSAGE "Druk op spatiebalk voor andere conditie"
  280.    @ 19,35 GET m->commentaar   FUNCTION "!" ;
  281.            MESSAGE "Voer eventueel commentaar in"
  282.    SET COLOR TO &c_standard.
  283.    ON KEY LABEL F9 DO Findcode WITH m->woonplaats
  284. RETURN
  285.    
  286. ********************************  EINDE KLNT.PRG ***************************************
  287.