home *** CD-ROM | disk | FTP | other *** search
/ DOS Wares / doswares.zip / doswares / DATABASE / DBASE4NL / SAMPLES.ZIP / BESTEL.PRG < prev    next >
Encoding:
Text File  |  1993-05-18  |  11.2 KB  |  309 lines
  1. *****************************************************************************************
  2. * PROGRAM NAME:                    BESTEL.PRG                  
  3. *                                  ORDERS TRANSACTIONS DATABASE SCREEN
  4. *                                  SAMPLE BUSINESS APPLICATION PROGRAM
  5. * LAST CHANGED:                    080692
  6. * WRITTEN BY:                      Borland International Inc.
  7. *****************************************************************************************
  8. *
  9. *       FILES USED IN CUSTOMER FILE:
  10. *       Database    =  Bestel.dbf 
  11. *       Index file  =  Bestel.mdx 
  12. *       TAG: Bestel =  klant_nr+DTOS(dat_trans)+magazn_nr <= Master index
  13. *       External Procedure File used: Biblio.prg
  14. *****************************************************************************************
  15.  
  16. * Main procedure
  17. PROCEDURE Bestel
  18.  
  19.    * Link to external procedure file of 'tool' procedures
  20.    SET PROCEDURE TO Biblio
  21.  
  22.    * Set database environment
  23.    DO Set_env
  24.    SET NEAR on
  25.    SET COLOR TO &c_standard.
  26.  
  27.    * Declare Variables Used:
  28.    * Database memory variables
  29.    STORE "" TO klant_nr, magazn_nr, pers_nr, ondrdl_nr
  30.    STORE {  -  -  } TO dat_trans
  31.    ondrdl_ant = 0
  32.    factuur  = .F.
  33.  
  34.    * Misc variables - used to pass parameters to Library
  35.    * for Find record, Output reports, List records and other options
  36.    dbf   = "BESTEL"                   && std report is available
  37.    mlist = "NIET RELEVANT"            && no mailing list is available
  38.    STORE "N/B" TO cust_rpt            && no custom reports are available
  39.    key  = "m->klant_nr+DTOC(m->dat_trans)+m->magazn_nr"
  40.    key1 = "m->klant_nr"
  41.    key2 = "DTOC(m->dat_trans)"
  42.    key3 = "m->magazn_nr"
  43.    keyname1 = "Klantnr.:"
  44.    keyname2 = "Besteldatum:"
  45.    keyname3 = "Magazijnnr.:"
  46.    list_flds = "KLANT_NR,DAT_TRANS,MAGAZN_NR,ONDRDL_NR,ONDRDL_ANT,Goederen->PRIJS"
  47.    STORE "" TO mcustid, mpartid, mempid
  48.    mdatetrans = {  -  -  }
  49.  
  50.    * Open databases and choose active indexes
  51.    SELECT 1
  52.    USE Bestel   ORDER Bestel
  53.    USE Goederen ORDER Ondrdl_nr IN 2
  54.    USE Klnt     ORDER Klant_nr IN 3
  55.    USE Personel ORDER Pers_nr IN 4
  56.    SET RELATION TO ondrdl_nr INTO Goederen, klant_nr INTO Klnt, pers_nr INTO Personel
  57.    GO TOP
  58.    
  59.    * Load initial record from database into memory
  60.    record_num = RECNO()
  61.    DO Load_fld
  62.  
  63.    * Show data screen
  64.    CLEAR
  65.    DO Dstatus
  66.    DO Backgrnd
  67.    DO Show_data
  68.    CLEAR GETS
  69.  
  70.    * Define popup bar menus of user choices
  71.    DO BAR_DEF
  72.    
  73.    * Activate main popup bar menu - execute user choices
  74.    SET COLOR TO &c_popup.
  75.    ACTIVATE POPUP main_mnu
  76.    DO Sub_ret
  77.    *
  78. RETURN
  79. *==============================end of main procedure=====================================
  80.  
  81. *  UTILITY PROCEDURES (PROPRIETARY TO Orders)
  82.  
  83. PROCEDURE Filter
  84.    * Filter (group) data into subset
  85.    * Select subset to set up filter condition  (Y=turn on,N=abort selection,T=turn off)
  86.    * If filter is already on, set default choice to Turn off; show window
  87.    * If filter is not on, set default choice to Yes; show window
  88.    choice = IIF(filters_on,"U","J")
  89.    DO Filt_ans
  90.    IF choice = "J"
  91.       * Start process of choosing filter condition.
  92.       *
  93.       mcustid    = SPACE(6)
  94.       mdatetrans = {  -  -  }
  95.       mpartid    = SPACE(10)
  96.       mempid     = SPACE(11)
  97.       ACTIVATE WINDOW alert
  98.      * Get user's filter condition selection(s)
  99.      @  0, 0 SAY "------ FILTERVOORWAARDE OPGEVEN -----"
  100.      @  2, 0 SAY "KLANTNR.:"      GET mcustid     FUNCTION "!" ;
  101.         MESSAGE "Typ een klantnr. (6 tekens) beginnend met een letter; stoppen: Esc"
  102.      @  2,18 SAY "DAT. TRANS"     GET mdatetrans  FUNCTION "D"
  103.      @  3, 0 SAY "ONDERDEELNR.:"  GET mpartid     FUNCTION "!"
  104.      @  4, 0 SAY "PERSONEELSNR.:" GET mempid
  105.      @  5, 0 SAY "Geef één of meer voorwaarden op"
  106.      READ
  107.      DEACTIVATE WINDOW alert
  108.      * Initialize filter condition variable to null (empty)
  109.      subset = " "
  110.      * Process user's entries to build filter condition
  111.      mcustid   = TRIM(mcustid)
  112.      mpartid   = TRIM(mpartid)
  113.      mempid    = TRIM(mempid)
  114.      subset =  subset + IIF("" <> mcustid,"klant_nr = '&mcustid.' .AND. ","")
  115.      subset =  subset + IIF("" <> mpartid,"ondrdl_nr = '&mpartid.' .AND. ","")
  116.      subset =  subset + IIF("" <> mempid, "pers_nr = '&mempid.'  .AND. ","")
  117.      *
  118.      IF "" = TRIM(subset)        && Check whether data entered into subset string
  119.     * If nothing entered, exit
  120.     DO Warnbell
  121.     filters_on = .F.
  122.      ELSE
  123.     * If string is not empty, truncate the .AND. from end of subset string
  124.     subset = SUBSTR(subset,1,LEN(subset)-6)
  125.     SET FILTER TO &subset.   && Filter on entered filter string condition
  126.     GO TOP                   && Activate filter by moving record pointer
  127.     * Check whether filter condition matches any records (none matching=EOF)
  128.     filters_on = .NOT. EOF()
  129.     IF .NOT. filters_on           && Filter is turned off if filters_on = .F.
  130.        DO Warnbell
  131.        DO Show_msg WITH "0 records voldoen aan filtervoorwaarde."
  132.        SET FILTER TO 
  133.        GO record_num
  134.     ENDIF
  135.       ENDIF
  136.    ELSE 
  137.       * If user selects "T", turn off filter
  138.       SET FILTER TO 
  139.       filters_on = .F.
  140.    ENDIF
  141. RETURN
  142.  
  143. PROCEDURE Indexer
  144.    * Create/rebuild index
  145.    INDEX ON klant_nr+DTOC(dat_trans)+magazn_nr TAG Bestel
  146.    GO TOP
  147. RETURN
  148.  
  149. PROCEDURE Init_fld
  150.    * Initialize memory variables values for data entry
  151.    klant_nr   = SPACE(6)
  152.    dat_trans  = DATE()
  153.    magazn_nr  = SPACE(5)
  154.    pers_nr    = SPACE(11)
  155.    ondrdl_nr  = SPACE(10)
  156.    ondrdl_ant = 0
  157.    factuur    = .F.
  158. RETURN
  159.  
  160. PROCEDURE Load_fld
  161.    * Copy fields from ORDERS database record into memory variables
  162.    klant_nr   = klant_nr
  163.    dat_trans  = dat_trans
  164.    magazn_nr  = magazn_nr
  165.    pers_nr    = pers_nr
  166.    ondrdl_nr  = ondrdl_nr
  167.    ondrdl_ant = ondrdl_ant
  168.    factuur    = factuur
  169. RETURN
  170.  
  171. PROCEDURE Repl_fld
  172.    * Replace database file fields with contents of memory variables
  173.    REPLACE klant_nr WITH m->klant_nr, magazn_nr WITH m->magazn_nr,;
  174.       dat_trans WITH m->dat_trans, pers_nr WITH m->pers_nr,;
  175.       ondrdl_nr WITH m->ondrdl_nr, ondrdl_ant WITH m->ondrdl_ant,;
  176.       factuur WITH m->factuur
  177. RETURN
  178.  
  179. FUNCTION Prof_mgn
  180.    PARAMETERS cost,price
  181.    * Calculate profit margin
  182.    margin = ROUND((price-cost)/price*100,1)
  183. RETURN margin
  184.  
  185. PROCEDURE Backgrnd
  186.    * Show screen for data entry/viewing
  187.    @  1,18 TO  3,49 DOUBLE COLOR &c_blue.
  188.    @  5, 2 TO  8,56 DOUBLE COLOR &c_red. 
  189.    @ 16, 2 TO 16,56        COLOR &c_red.
  190.    @  9, 2 TO 18,56        COLOR &c_red.
  191.    @  2,19 FILL TO  2,48   COLOR &c_blue.
  192.    @  6, 3 FILL TO  7,55   COLOR &c_red.
  193.    @ 10, 3 FILL TO 17,55   COLOR &c_red.
  194.    @  6, 3 FILL TO 17,55   COLOR &c_red.
  195.    SET COLOR TO &c_data.
  196.    @  2,23 SAY "DATABASE BESTELLINGEN"
  197.    @  6, 4 SAY "KLANTNR.: "
  198.    @  7, 4 SAY "BESTELDATUM:  "   
  199.    @  7,35 SAY "MAGAZIJNNR.:"     
  200.    @ 10, 4 SAY "ONDERDLNR.:  "    
  201.    @ 11, 4 SAY "ARTIKEL:"
  202.    @ 12, 4 SAY "AANT. BESTELD:   " 
  203.    @ 12,25 SAY "  à"
  204.    @ 12,35 SAY "PRIJS: ƒ"
  205.    @ 13, 4 SAY "AANT. VOORRADIG:"
  206.    @ 13,25 SAY "  à"
  207.    @ 13,35 SAY "MARGE:"
  208.    @ 13,53 SAY "%"
  209.    @ 14, 4 SAY "PERSONEELSNR.:"    
  210.    @ 15, 4 SAY "FACTUUR:"      
  211.    @ 17, 4 SAY "OPMERKING: "   
  212.    SET COLOR TO &c_standard.
  213. RETURN
  214.  
  215. PROCEDURE Show_data
  216.    SET COLOR TO &c_fields.
  217.    @  6,18 SAY klant_nr
  218.    @  7,18 SAY dat_trans
  219.    @  7,48 SAY magazn_nr
  220.    @ 10,18 SAY ondrdl_nr
  221.    @ 12,21 SAY ondrdl_ant   PICTURE "999"
  222.    @ 14,18 SAY pers_nr
  223.    @ 15,14 SAY factuur      PICTURE "Y"
  224.    @ 17,14 SAY Info
  225.    IF .NOT. BAR() = 2
  226.       @  6,26 SAY Klnt->Klantnaam                       COLOR &c_yelowhit.
  227.       @ 11,18 SAY Goederen->Artikel                      COLOR &c_yelowhit.
  228.       @ 12,44 SAY Goederen->Prijs      PICTURE "999999.99" COLOR &c_yelowhit.
  229.       @ 13,21 SAY Goederen->Aant_voorr PICTURE "999"       COLOR &c_yelowhit.
  230.       @ 13,48 SAY Prof_mgn(Goederen->Kostprijs,Goederen->Prijs) ;
  231.               PICTURE "99.9" COLOR &c_yelowhit.
  232.       @ 14,32 SAY TRIM(Personel->Voornaam)+" "+ Personel->Achternaam ;
  233.               COLOR &c_yelowhit.
  234.    ELSE
  235.       * Mode is Add: clear screen field areas of related data
  236.       @  6,26 SAY SPACE(30)    && CUSTOMER
  237.       @ 11,18 SAY SPACE(20)    && PARTNAME
  238.       @ 12,44 SAY SPACE(9)     && PRICE
  239.       @ 13,21 SAY SPACE(3)     && QTY ONHAND
  240.       @ 13,48 SAY SPACE(4)     && MARGIN
  241.       @ 14,30 SAY SPACE(26)    && EMPLOYEE
  242.    ENDIF
  243.    IF ISCOLOR()
  244.       @ 20, 4 SAY "Gele tekst/getallen uit verwante database/berekening" ; 
  245.      COLOR &c_yelowhit.
  246.    ELSE
  247.       @ 20, 4 SAY "Grijze tekst/getallen uit verwante database/berekening" COLOR &c_red.
  248.    ENDIF
  249.    SET COLOR TO &c_standard.
  250. RETURN
  251.  
  252. PROCEDURE Get_data
  253. ** Duplicat(&key.)
  254.    SET COLOR TO &c_data.
  255.    @  6,18 GET m->klant_nr  PICTURE "!99999" ;
  256.            VALID Lookupid(m->klant_nr,"Klnt","Klanten",2) ;
  257.            ERROR "Ongeldig klantnr.; voer ander nummer in" ;
  258.            MESSAGE "Typ klantnummer van zes cijfers, beginnend " + ;
  259.                    "met een letter, of annuleer met Esc."
  260.    @  7,18 GET m->dat_trans    FUNCTION "D" ;
  261.            MESSAGE "Voer datum van deze bestelling in"
  262.    @  7,48 GET m->magazn_nr    FUNCTION "!" ;
  263.            MESSAGE "Voer nummer van klant in"
  264.    @ 10,18 GET m->ondrdl_nr    FUNCTION "!" ;
  265.            VALID Lookupid(m->ondrdl_nr,"Goederen", "Onderdeel", 3) ;
  266.            ERROR "Ongeldig onderdeelnr.; voer ander nummer in" ;
  267.            MESSAGE "Typ een onderdeelnr. of annuleer met Esc"
  268.    @ 12,21 GET m->ondrdl_ant   PICTURE "999" ;
  269.            MESSAGE "Voer het aantal bestelde onderdelen in"
  270.    @ 14,18 GET m->pers_nr      PICTURE "999-99-9999" ;
  271.            VALID Lookupid(m->pers_nr, "Personel", "Werknemer", 6) ;
  272.            ERROR "Ongeldig personeelsnr.; voer ander nummer in" ;
  273.            MESSAGE "Typ een personeelsnr. of annuleer met Esc"
  274.    @ 15,14 GET m->factuur      PICTURE "Y" ;
  275.            MESSAGE "Geef op of al factuur is verzonden " + ;
  276.                    "(wordt meestal automatisch afgehandeld)"
  277.    @ 17,14 GET Info WINDOW memo_windo ;
  278.            MESSAGE "Info typen: Ctrl-Home - Einde: Ctrl-End"
  279.    IF .NOT. BAR() = 2
  280.       @  6,26 SAY Klnt->Klantnaam                       COLOR &c_yelowhit.
  281.       @ 11,18 SAY Goederen->Artikel                      COLOR &c_yelowhit.
  282.       @ 12,44 SAY Goederen->Prijs      PICTURE "999999.99" COLOR &c_yelowhit.
  283.       @ 13,21 SAY Goederen->Aant_voorr PICTURE "999"       COLOR &c_yelowhit.
  284.       @ 13,48 SAY Prof_mgn(Goederen->Kostprijs,Goederen->Prijs) ;
  285.               PICTURE "99.9" COLOR &c_yelowhit.
  286.       @ 14,32 SAY TRIM(Personel->Voornaam)+" "+ Personel->Achternaam ;
  287.               COLOR &c_yelowhit.
  288.    ELSE
  289.       * Mode is Add: clear screen field areas of related data
  290.       @  6,26 SAY SPACE(30)    && CUSTOMER
  291.       @ 11,18 SAY SPACE(20)    && PARTNAME
  292.       @ 12,44 SAY SPACE(9)     && PRICE
  293.       @ 13,21 SAY SPACE(3)     && QTY ONHAND
  294.       @ 13,48 SAY SPACE(4)     && MARGIN
  295.       @ 14,30 SAY SPACE(26)    && EMPLOYEE
  296.    ENDIF
  297.    IF ISCOLOR()
  298.       @ 20, 4 SAY "Gele tekst/getallen uit verwante database/berekening" ; 
  299.      COLOR &c_yelowhit.
  300.    ELSE
  301.       @ 20, 4 SAY "Grijze tekst/getallen uit verwante database/berekening" COLOR &c_red.
  302.    ENDIF
  303.    SET COLOR TO &c_standard.
  304.    ON KEY LABEL F9 DO Findcust WITH m->klant_nr
  305.    ON KEY LABEL F10 DO Findpart WITH m->ondrdl_nr
  306. RETURN
  307.  
  308.  
  309.