home *** CD-ROM | disk | FTP | other *** search
/ DOS Wares / doswares.zip / doswares / DATABASE / DBASE4NL / SAMPLES.ZIP / PERSONEL.PRG < prev    next >
Encoding:
Text File  |  1993-05-18  |  10.8 KB  |  321 lines
  1. *****************************************************************************************
  2. * PROGRAM NAME:           PERSONEL.PRG
  3. *                         EMPLOYEE DATABASE SCREEN
  4. *                         SAMPLE BUSINESS APPLICATION PROGRAM
  5. * LAST CHANGED:           080692
  6. * WRITTEN BY:             Borland International
  7. *****************************************************************************************
  8. *
  9. *       FILES USED:
  10. *       Database        = Personel.dbf  (Employee personnel file)
  11. *       Index file      = Personel.mdx
  12. *           TAG: Namen  = achternaam+voornaam+invoeg  <= Master index
  13. *           TAG: Afdel  = afdeling+achternaam+voornaam+invoeg
  14. *           TAG: Status = afdeling+STR(salaris,8,2)
  15. *           TAG: Jaren  = STR(dienstjr,4,1)
  16. *           TAG: Pers_nr= pers_nr
  17. *       External procedure file used = Biblio.prg
  18. *****************************************************************************************
  19. * Main procedure 
  20. PROCEDURE Personel
  21.  
  22.    * Link to external procedure file of "tool" procedures
  23.    SET PROCEDURE TO Biblio
  24.    * Do not overwrite C_SAVE if it already exists
  25.    IF TYPE("C_SAVE")="U"
  26.     public c_save
  27.     set console off
  28.     c_save=SET("ATTRIBUTES")
  29.     set console on
  30.    ENDIF
  31.    * Set up database environment
  32.    DO Set_env
  33.  
  34.    SET COLOR TO &c_standard.
  35.  
  36.    * Declare variables used:
  37.    * Database memory variables
  38.    STORE ""  TO achternaam, voornaam, invoeg, adres1, adres2, woonplaats, provincie, postcode, telefoon
  39.    STORE ""  TO pers_nr, branche, titel, bonus, info, afdeling, functie
  40.    STORE  0  TO schaal, dienstjr, salaris, toeslag
  41.    STORE .F. TO spaarfonds, deeltijd
  42.    in_dienst = {  -  -  }
  43.  
  44.    * Miscellaneous variables - used to pass parameters to Library
  45.    STORE "PERSONEL" TO dbf,mlist      && Standard report and mailing list are available
  46.    STORE "" TO cust_rpt               && Custom report(s) are available
  47.    key      = "m->achternaam+m->voornaam"
  48.    key1     = "m->achternaam"
  49.    key2     = "m->voornaam"
  50.    key3     = "GEEN"
  51.    keyname1 = "Achternaam:"
  52.    keyname2 = "Voornaam:"
  53.    keyname3 = ""
  54.    list_flds  = "ACHTERNAAM, VOORNAAM, AFDELING, TELEFOON"
  55.  
  56.    * Open database files and choose active indexes
  57.    SELECT 1
  58.    USE Personel ORDER Namen
  59.    GO TOP
  60.    * Used for area code lookup
  61.    USE Netnum ORDER Woonplaats IN 2
  62.    
  63.    * Load initial record from database into memory variables
  64.    record_num = RECNO()
  65.    DO Load_fld
  66.  
  67.    * Show data screen
  68.    CLEAR
  69.    DO Dstatus
  70.    DO Backgrnd
  71.    DO Show_data
  72.  
  73.    * Define popup menus 
  74.    DO Bar_def
  75.  
  76.    * Activate main popup menu - execute user choices
  77.    SET COLOR TO &c_popup.
  78.    ACTIVATE POPUP main_mnu
  79.    DO Sub_ret
  80.    *
  81. RETURN
  82. *========================= end of main procedure ===================================
  83.  
  84. *  UTILITY PROCEDURES (Proprietary to Employee.prg)
  85.  
  86. PROCEDURE Filter
  87.   * Filter (group) data into subset
  88.   * Select subset to set up filter condition (J=turn on,N=abort selection,U=turn off)
  89.   * If filter is already on, set default choice to U, show window
  90.   * If filter is not on, set default choice to J, show window
  91.   choice = IIF(filters_on,"U","J")
  92.   DO Filt_ans
  93.   IF choice = "J"
  94.     * Start process of choosing filter condition
  95.     STORE SPACE(15) TO afdeling, functie
  96.     STORE SPACE(11) TO branche
  97.     STORE SPACE(3)  TO titel
  98.     ACTIVATE WINDOW alert
  99.        @   0,0 SAY "-------- FILTERVOORWAARDE OPGEVEN -------"
  100.        @   1,1 SAY "AFDELING:   " GET m->afdeling   FUNCTION "!"
  101.        @   2,1 SAY "FUNCTIE:    " GET m->functie    FUNCTION "!"
  102.        @   3,1 SAY "BRANCHE:    " GET m->branche    FUNCTION "!"
  103.        @   4,1 SAY "TITEL:      " GET m->titel      FUNCTION "!"
  104.        @   5,1 SAY "Geef één of meer voorwaarden op"
  105.        READ
  106.     DEACTIVATE WINDOW alert
  107.     * Initialize filter variable to null (empty)
  108.     subset = ""
  109.     * Process user's entries to build filter condition 
  110.     subset = subset + IIF("" <> TRIM(m->afdeling), ;
  111.        [afdeling = TRIM("&afdeling.") .AND.], "")
  112.     subset = subset + IIF("" <> TRIM(m->functie), ;
  113.        [functie = TRIM("&functie.") .AND.], "")
  114.     subset = subset + IIF("" <> TRIM(m->branche), ;
  115.        [branche = TRIM("&branche.") .AND.], "")
  116.     subset = subset + IIF("" <> TRIM(m->titel), ;
  117.        [titel = TRIM("&titel.") .AND.], "")
  118.     *
  119.     * Check whether data entered into subset string
  120.     IF "" = TRIM(subset)
  121.        DO Warnbell
  122.        filters_on = .F.
  123.     ELSE
  124.        * If string is not empty, truncate the .AND. from end of subset string
  125.        subset = SUBSTR(subset,1,LEN(subset)-6)
  126.        * Filter on entered filter string condition
  127.        SET FILTER TO &subset.
  128.        * Activate filter by moving record pointer
  129.        GO TOP
  130.        * Check whether filter condition matches any records (none matching=EOF)
  131.        filters_on = .NOT. EOF()
  132.        IF .NOT. filters_on
  133.       * Turn off filter if no matching records found
  134.       DO Warnbell
  135.       DO Show_msg WITH "0 records voldoen aan filtervoorwaarde"
  136.       SET FILTER TO 
  137.       GO record_num
  138.        ENDIF
  139.     ENDIF
  140.   ELSE
  141.     * If user selects "U", turn off filter
  142.     SET FILTER TO 
  143.     filters_on = .F.
  144.   ENDIF
  145. RETURN
  146.  
  147. PROCEDURE Indexer
  148.    * Create/rebuild indexes
  149.    INDEX ON afdeling+achternaam+voornaam+invoeg  TAG Afdel
  150.    INDEX ON afdeling+STR(salaris,8,2)            TAG Status
  151.    INDEX ON STR(dienstjr,4,1)                    TAG Jaren
  152.    INDEX ON pers_nr                              TAG Pers_nr
  153.    INDEX ON achternaam+voornaam+invoeg           TAG Namen
  154.    GO TOP
  155. RETURN
  156.  
  157. PROCEDURE Init_fld
  158.     * Initialize memory variable values for data entry
  159.     initial    = " "
  160.     STORE SPACE(20) TO adres1, adres2
  161.     STORE SPACE(10) TO voornaam, postcode
  162.     STORE SPACE(15) TO achternaam, afdeling, functie, bonus
  163.     STORE SPACE(11) TO pers_nr, branche
  164.     STORE 0 TO schaal, dienstjr, salaris, toeslag
  165.     STORE .T. TO spaarfonds, deeltijd
  166.     woonplaats = SPACE(14)
  167.     provincie  = SPACE(2)
  168.     telefoon   = SPACE(13)
  169.     titel      = SPACE(3)
  170.     info       = SPACE(40)
  171.     in_dienst  = {  -  -  }
  172. RETURN
  173.  
  174. PROCEDURE Load_fld
  175.    * Load field values from Employee database record into memory variables
  176.    achternaam = achternaam
  177.    voornaam   = voornaam
  178.    invoeg     = invoeg
  179.    pers_nr    = pers_nr
  180.    adres1     = adres1
  181.    adres2     = adres2
  182.    woonplaats = woonplaats
  183.    provincie  = provincie
  184.    postcode   = postcode
  185.    telefoon   = telefoon
  186.    afdeling   = afdeling
  187.    functie    = functie
  188.    schaal     = schaal
  189.    spaarfonds = spaarfonds
  190.    deeltijd   = deeltijd
  191.    in_dienst  = in_dienst
  192.    branche    = branche
  193.    dienstjr   = dienstjr
  194.    titel      = titel
  195.    salaris    = salaris
  196.    toeslag    = toeslag
  197.    bonus      = bonus
  198.    info       = info
  199. RETURN
  200.  
  201.  
  202. PROCEDURE Repl_fld
  203.    * Replace database fields with values of current memory variables
  204.    REPLACE pers_nr WITH m->pers_nr, achternaam WITH m->achternaam, ;
  205.        voornaam WITH m->voornaam, invoeg WITH m->invoeg, ;
  206.        adres1 WITH m->adres1, adres2 WITH m->adres2, ;
  207.        woonplaats WITH m->woonplaats, provincie WITH m->provincie, postcode WITH m->postcode, ;
  208.        telefoon WITH m->telefoon, afdeling WITH m->afdeling
  209.    REPLACE functie WITH m->functie, schaal WITH m->schaal, ;
  210.        spaarfonds WITH m->spaarfonds, deeltijd WITH m->deeltijd, ;
  211.        in_dienst WITH m->in_dienst, branche WITH m->branche, ;
  212.        dienstjr WITH m->dienstjr, titel WITH m->titel, ;
  213.        salaris WITH m->salaris, toeslag WITH m->toeslag, ;
  214.        bonus WITH m->bonus, info WITH m->info
  215. RETURN
  216.  
  217. PROCEDURE Backgrnd
  218.    * Display screen for data entry and viewing
  219.    * Draw and fill in boxes 
  220.    @  1,18 TO   3,41 DOUBLE COLOR &c_blue.
  221.    @  4, 1 TO   6,56 DOUBLE COLOR &c_red. 
  222.    @  2,19 FILL TO  2,40    COLOR &c_blue.
  223.    @  4, 2 FILL TO 21,55    COLOR &c_red.
  224.    @ 11, 1 TO  11,56        COLOR &c_red.
  225.    @  7, 1 TO  22,56        COLOR &c_red. 
  226.    * Show data
  227.    SET COLOR TO &c_data.
  228.    @  2,20 SAY "DATABASE PERSONEEL"
  229.    @  5, 3 SAY "NAAM:"
  230.    @  5,26 SAY "VOORNAAM:"
  231.    @  5,49 SAY "."
  232.    @  8, 3 SAY "ADRES:"
  233.    @  9, 3 SAY "PLAATS: "
  234.    @  9,32 SAY "PROVINCIE:"
  235.    @ 10, 3 SAY "POSTCODE:"
  236.    @ 10,32 SAY "TELEFOON:"         
  237.    @ 12, 3 SAY "AFDELING: "
  238.    @ 12,32 SAY "FUNCTIE:"
  239.    @ 13,32 SAY "BRANCHE:"
  240.    @ 14, 3 SAY "PERSONEELNR:"
  241.    @ 14,32 SAY "IN DIENST:"        
  242.    @ 15,32 SAY "DEELTIJD:"         
  243.    @ 16,32 SAY "SPAARFONDS:"
  244.    @ 17,32 SAY "SCHAAL:"           
  245.    @ 18, 3 SAY "SALARIS: ƒ "       
  246.    @ 18,32 SAY "TOESLAG:   "       
  247.    @ 18,54 SAY "%"
  248.    @ 19, 3 SAY "TITEL:    "        
  249.    @ 19,32 SAY "DIENSTJAREN:  "    
  250.    @ 20, 3 SAY "BONUS:    "        
  251.    @ 21, 3 SAY "COMMENTAAR:"       
  252.    SET COLOR TO &c_standard.
  253. RETURN
  254.  
  255. PROCEDURE Show_data
  256.    SET COLOR TO &c_fields.
  257.    @  5, 9 SAY achternaam
  258.    @  5,36 SAY voornaam
  259.    @  5,48 SAY invoeg
  260.    @  8,12 SAY adres1
  261.    @  8,36 SAY adres2
  262.    @  9,12 SAY woonplaats
  263.    @  9,43 SAY provincie
  264.    @ 10,12 SAY postcode
  265.    @ 10,43 SAY telefoon
  266.    @ 12,16 SAY afdeling
  267.    @ 12,40 SAY functie
  268.    @ 13,40 SAY branche
  269.    @ 14,16 SAY pers_nr
  270.    @ 14,43 SAY in_dienst
  271.    @ 15,43 SAY deeltijd    PICTURE "Y"
  272.    @ 16,43 SAY spaarfonds  PICTURE "Y"
  273.    @ 17,43 SAY schaal      PICTURE "9"
  274.    @ 18,14 SAY salaris     PICTURE "999,999.99"
  275.    @ 18,50 SAY toeslag     PICTURE "99.9"
  276.    @ 19,14 SAY titel
  277.    @ 19,50 SAY dienstjr    PICTURE "99.9"
  278.    @ 20,14 SAY bonus
  279.    @ 21,14 SAY info
  280.    SET COLOR TO &c_standard.
  281.  
  282. PROCEDURE Get_data
  283.    SET COLOR TO &c_data.
  284.    @  5, 9 GET m->achternaam  PICTURE "!XXXXXXXXXXXXXX" ;
  285.            MESSAGE "Typ de achternaam van de werknemer"
  286.    @  5,36 GET m->voornaam    PICTURE "!XXXXXXXXX"
  287.    @  5,48 GET m->invoeg      PICTURE "!"
  288.    @  8,12 GET m->adres1
  289.    @  8,36 GET m->adres2
  290.    @  9,12 GET m->woonplaats   PICTURE "!XXXXXXXXXXXXX"
  291.    @  9,43 GET m->provincie    PICTURE "!!"
  292.    @ 10,12 GET m->postcode
  293.    @ 10,43 GET m->telefoon     PICTURE "999X9X9999999"
  294.    @ 12,16 GET m->afdeling     PICTURE "@M VERKOOP,DIRECTIE" ;
  295.            MESSAGE "Druk op spatiebalk voor andere afdeling"
  296.    @ 12,40 GET m->functie      FUNCTION "!"
  297.    @ 13,40 GET m->branche      FUNCTION "!"
  298.    @ 14,16 GET m->pers_nr      PICTURE "999-99-9999" 
  299.    @ 14,43 GET m->in_dienst    FUNCTION "D"
  300.    @ 15,43 GET m->deeltijd     PICTURE "Y" ;
  301.            WHEN TRIM(m->afdeling) <> "DIRECTIE"
  302.    @ 16,43 GET m->spaarfonds   PICTURE "Y" ;
  303.            WHEN TRIM(m->afdeling) <> "DIRECTIE"
  304.    @ 17,43 GET m->schaal       PICTURE "9"
  305.    @ 18,14 GET m->salaris      PICTURE "999,999.99"
  306.    @ 18,50 GET m->toeslag      PICTURE "99.9" ;
  307.            WHEN TRIM(m->afdeling) <> "DIRECTIE"
  308.    @ 19,14 GET m->titel        PICTURE "!!!"
  309.    @ 19,50 GET m->dienstjr     PICTURE "99.9" 
  310.    @ 20,14 GET m->bonus        FUNCTION "!"
  311.    @ 21,14 GET m->info
  312.    SET COLOR TO &c_standard.
  313.    ON KEY LABEL F9 DO Findcode WITH m->woonplaats
  314. RETURN
  315.  
  316.  
  317.    
  318.  
  319.  
  320. **********************************  END OF EMPLOYEE.PRG  ********************************
  321.