home *** CD-ROM | disk | FTP | other *** search
/ DOS Wares / doswares.zip / doswares / DATABASE / DBASE4NL / SAMPLES.ZIP / BIBLIO.PRG < prev    next >
Encoding:
Text File  |  1993-05-18  |  39.6 KB  |  1,111 lines
  1. ******************************************************************************
  2. * PROGRAM NAME: BIBLIO.PRG
  3. *               LIBRARY OF PROCEDURES COMMON TO ALL BUSINESS PROGRAMS
  4. *               SAMPLE BUSINESS APPLICATION PROGRAM
  5. * LAST CHANGED: 080692
  6. * WRITTEN BY:   Borland International Inc.
  7. ******************************************************************************
  8.  
  9. PROCEDURE Add_new
  10.    * Add new record to database file
  11.    * Erase previous record number from screen
  12.    @ 0,65 SAY SPACE(15) COLOR &c_yellow.
  13.    * Display F9 lookup key message, if lookup available
  14.    IF lookup_ok
  15.       DO Sho_look WITH dbf
  16.    ENDIF
  17.    DO Init_fld
  18.    DO Get_data
  19.    READ
  20.    * Erase lookup message from screen
  21.    @ 0,0 SAY SPACE(51)
  22.    * If user didn't enter data into key fields, exit without saving
  23.    IF "" = TRIM(&key.) .OR. READKEY() < 256
  24.        RETURN
  25.    ELSE
  26.       * Each application checks for duplicates if duplicate keys not allowed
  27.       * If duplicate key (when not allowed), exit from add mode without saving
  28.       IF rec_is_dup
  29.          * Reset status flag and exit
  30.          rec_is_dup = .F.
  31.          RETURN
  32.       ELSE
  33.          * Append and save validated record
  34.          DO Sav_data
  35.          GO record_num
  36.       ENDIF
  37.    ENDIF
  38. RETURN
  39.  
  40. PROCEDURE Bar_def
  41.    * Define the main popup OPTION MENU, main_mnu
  42.    mesg = "Druk op eerste letter van de optie of selecteer en druk op <Return>"
  43.    DEFINE POPUP main_mnu FROM 2,58 TO 22,78 MESSAGE mesg
  44.    DEFINE BAR  1 OF main_mnu PROMPT "==  OPTIEMENU  ==" SKIP
  45.    DEFINE BAR  2 OF main_mnu PROMPT " Toevoegen record"
  46.    DEFINE BAR  3 OF main_mnu PROMPT " Bewerken record"
  47.    DEFINE BAR  4 OF main_mnu PROMPT " Wissen record"
  48.    DEFINE BAR  5 OF main_mnu PROMPT "-------------------" SKIP
  49.    DEFINE BAR  6 OF main_mnu PROMPT " Volgend record"
  50.    DEFINE BAR  7 OF main_mnu PROMPT " Record terug"
  51.    DEFINE BAR  8 OF main_mnu PROMPT " Eerste record"
  52.    DEFINE BAR  9 OF main_mnu PROMPT " Laatste record"
  53.    DEFINE BAR 10 OF main_mnu PROMPT " Overslaan records"
  54.    DEFINE BAR 11 OF main_mnu PROMPT " Zoeken record"
  55.    DEFINE BAR 12 OF main_mnu PROMPT "-------------------" SKIP
  56.    DEFINE BAR 13 OF main_mnu PROMPT " Inhoud database"
  57.    DEFINE BAR 14 OF main_mnu PROMPT " Uitvoeren rapport"
  58.    DEFINE BAR 15 OF main_mnu PROMPT " Groep records" SKIP FOR dbf = "REKN_REC"
  59.    DEFINE BAR 16 OF main_mnu PROMPT " Aantal records"
  60.    DEFINE BAR 17 OF main_mnu PROMPT " Database indexeren"
  61.    DEFINE BAR 18 OF main_mnu PROMPT " Hulp"
  62.    DEFINE BAR 19 OF main_mnu PROMPT " Stop & hoofdmenu"
  63.    * Define the popup dest_mnu for printing reports to a destination
  64.    DEFINE POPUP dest_mnu FROM 13,10 TO 19,38 MESSAGE mesg
  65.    DEFINE BAR 1 OF dest_mnu PROMPT "======= BESTEMMING =======" SKIP
  66.    DEFINE BAR 2 OF dest_mnu PROMPT " Printer"
  67.    DEFINE BAR 3 OF dest_mnu PROMPT " Bestand"
  68.    DEFINE BAR 4 OF dest_mnu PROMPT " Scherm"
  69.    DEFINE BAR 5 OF dest_mnu PROMPT " Terug naar optiemenu"
  70.    * Define the popup rpt_mnu for printing reports to a destination
  71.    DEFINE POPUP rpt_mnu FROM 11, 5 TO 17,38 MESSAGE mesg
  72.    DEFINE BAR 1 OF rpt_mnu  PROMPT "============ RAPPORTEN ===========" SKIP
  73.    DEFINE BAR 2 OF rpt_mnu  PROMPT " Database-rapport: " + dbf
  74.    DEFINE BAR 3 OF rpt_mnu  PROMPT " Verzendlijst: "  + mlist ;
  75.       SKIP FOR mlist = "NIET BESCHIKBAAR"
  76.    DEFINE BAR 4 OF rpt_mnu  PROMPT " Rapport eigen programma: " + cust_rpt ;
  77.       SKIP FOR cust_rpt = "N/B"
  78.    DEFINE BAR 5 OF rpt_mnu  PROMPT " Einde en naar optiemenu"
  79.    * Define which procedures are executed by the defined popups
  80.    ON SELECTION POPUP main_mnu DO Barpop
  81.    ON SELECTION POPUP rpt_mnu  DO Barpop_r
  82.    ON SELECTION POPUP dest_mnu DO Barpop_d
  83.    * Define windows for text, msgs, etc.
  84.    DEFINE WINDOW alert      FROM 15, 3 TO 22,46 PANEL COLOR &c_alert.
  85.    DEFINE WINDOW duplicat   FROM 15, 5 TO 21,70 PANEL COLOR &c_alert.
  86.    DEFINE WINDOW lister     FROM  5, 3 TO 22,74 PANEL COLOR &c_list.
  87.    DEFINE WINDOW look       FROM  6, 5 TO 16,65 PANEL COLOR &c_list.
  88.    DEFINE WINDOW memo_windo FROM  7, 4 TO 19,75 PANEL COLOR &c_list.
  89. RETURN
  90.  
  91. PROCEDURE Barpop
  92.    * Perform action selected by user from OPTION MENU bars
  93.    DO CASE
  94.        * BAR() = 1 is title of menu
  95.        CASE BAR() = 2                  && Record toevoegen
  96.           DO Add_new
  97.        CASE BAR() = 3                  && Record bewerken
  98.           DO Edit
  99.        CASE BAR() = 4                  && Wissen record
  100.           DO Eraser
  101.        CASE BAR() = 6                  && Volgend record
  102.           DO Skip_rec WITH 1
  103.        CASE BAR() = 7                  && Record terug
  104.           DO Skip_rec WITH -1
  105.        CASE BAR() = 8                  && Eerste record
  106.           GO TOP
  107.        CASE BAR() = 9                  && Laatste record
  108.           GO BOTTOM
  109.        CASE BAR() = 10                 && Overslaan records
  110.           DO Skip_rec WITH 0
  111.        CASE BAR() = 11                 && Zoeken record
  112.           DO Find_rec WITH key, key1, keyname1, key2, keyname2, key3, keyname3
  113.        CASE BAR() = 13                 && Inhoud database
  114.           DO List_rec
  115.        CASE BAR() = 14                 && Uitvoeren rapport
  116.           SAVE SCREEN TO Pre_rept      && Scherm opslaan
  117.           ACTIVATE POPUP rpt_mnu
  118.           RESTORE SCREEN FROM Pre_rept
  119.           RELEASE SCREEN Pre_rept
  120.        CASE BAR() = 15              && Groep records
  121.           DO Filter
  122.        CASE BAR() = 16                 && Aantal records
  123.           ************
  124.           IF NETWORK()
  125.              * Turn off file lock to count
  126.              SET LOCK off
  127.              DO Kount
  128.              SET LOCK on
  129.              ***********
  130.           ELSE
  131.              DO Kount
  132.           ENDIF
  133.        CASE BAR() = 17                  && Index voor database
  134.           ************
  135.           IF NETWORK()
  136.              old_tag = ORDER()
  137.              USE (dbf) EXCLUSIVE
  138.              IF net_choice <> 27        && controleer optie Net_err (Esc=27)
  139.                 DO Indexer
  140.                 SET EXCLUSIVE off
  141.                 USE (dbf) ORDER (old_tag)
  142.              ENDIF
  143.              ***********************
  144.           ELSE
  145.              DO Indexer
  146.           ENDIF
  147.        CASE BAR() = 18                  && Hulp
  148.           SET COLOR TO &c_standard.
  149.           DO Helper
  150.        CASE BAR() = 19                && Einde en hoofdmenu
  151.           DEACTIVATE POPUP
  152.    ENDCASE
  153.    DO Dstatus                         && Recordnr. en filterstatus tonen
  154.    DO Show_data                       && Scherm met huidig record tonen
  155.    CLEAR GETS
  156.    SET COLOR TO &c_popup.
  157. RETURN
  158.  
  159. PROCEDURE Barpop_d
  160.    * Perform action selected by user from Destination menu
  161.    SET COLOR TO &c_popup.
  162.    DO CASE
  163.       * BAR() 1 is title of menu
  164.       CASE BAR() = 2                  && Uitvoer naar printer
  165.          DO Prt_menu                  && Menu voor printopties activeren
  166.          SET PRINTER on
  167.          SET CONSOLE off
  168.          DO Printout                  && Gekozen rapport uitvoeren
  169.          SET PRINTER off
  170.          SET CONSOLE on
  171.       CASE BAR() = 3                  && Uitvoeren naar bestand
  172.          answer = SPACE(8)
  173.          ACTIVATE WINDOW alert
  174.             @ 0,0 SAY "----------- RAPPORT NAAR BESTAND ---------"
  175.             @ 2,1 SAY "Typ bestandsnaam voor rapport: " GET answer ;
  176.                VALID "" <> TRIM(answer) ;
  177.                MESSAGE "Typ bestandsnaam van maximaal acht tekens"
  178.             READ
  179.          DEACTIVATE WINDOW alert
  180.          SET ALTERNATE TO &answer.
  181.          SET ALTERNATE on
  182.          SET CONSOLE off
  183.          GO TOP
  184.          DO Printout                  && Output report or labels to file
  185.          SET ALTERNATE off
  186.          SET CONSOLE on
  187.       CASE BAR() = 4                  && Output to screen
  188.          SET COLOR TO &c_standard.
  189.          CLEAR
  190.          * Store current page settings
  191.          plength  = _plength
  192.          rmargin  = _rmargin
  193.          * Set page width & length for screen
  194.          _plength = 25
  195.          _rmargin = 80
  196.          DO Printout                  && Output chosen report/labels to screen
  197.          CLEAR
  198.          * Reset page settings
  199.          _plength = plength
  200.          _rmargin = rmargin
  201.          GO record_num                && Return to original record
  202.       CASE BAR() = 5                  && Exit to OPTION MENU
  203.          DEACTIVATE POPUP
  204.    ENDCASE
  205.    SET COLOR TO &c_standard.
  206.    DEACTIVATE POPUP
  207. RETURN
  208.  
  209. PROCEDURE Barpop_r
  210.    * Select available reports menu
  211.    SET COLOR TO &c_popup.
  212.    reportype = SPACE(6)
  213.    DO CASE
  214.       CASE BAR() = 2                  && Output standard report to destination
  215.          reportype = "LISTING"
  216.          ACTIVATE POPUP dest_mnu      && Activate printer destination menu
  217.       CASE BAR() = 3                  && Output mailing labels to destination
  218.          reportype = "LABELS"
  219.          ACTIVATE POPUP dest_mnu      && Activate printer destination menu
  220.       CASE BAR() = 4                  && Output custom report to destination
  221.          reportype = "CUSTOM"
  222.          ACTIVATE WINDOW alert
  223.             * Get custom report name from user
  224.             * First, allow READ errors and warning bell
  225.             ON READERROR
  226.             SET BELL ON
  227.             rpt_name = SPACE(8)
  228.             @ 0,0 SAY "-------- RAPPORT EIGEN PROGRAMMA --------"
  229.             @ 2,1 SAY "Typ de rapportnaam:" GET rpt_name ;
  230.                VALID FILE(TRIM(rpt_name) + ".prg") ;
  231.                MESSAGE "Typ bestandsnaam van max. acht " + ;
  232.                        "tekens, b.v. Lg_rept " ;
  233.                ERROR "Bestandsnaam ongeldig. Typ andere naam"
  234.             READ
  235.             * Now, put the READ error redirection back.
  236.             ON READERROR
  237.             SET BELL OFF
  238.          DEACTIVATE WINDOW alert
  239.          IF LASTKEY() <> 27           && A report filename was found
  240.             SET COLOR TO &c_popup.
  241.             ACTIVATE POPUP dest_mnu
  242.          ENDIF
  243.    ENDCASE
  244.    SET COLOR TO &c_popup.
  245.    DEACTIVATE POPUP
  246. RETURN
  247.  
  248. PROCEDURE Colo_rese
  249. PRIVATE old_color, c_messages, c_titles, c_box, c_info, c_fields
  250.  
  251. old_color = c_save
  252.  
  253. * Set the Primary colors
  254. SET COLOR TO &old_color.
  255.  
  256. * Remove primary colors and start at the secondary colors
  257. old_color = STUFF(old_color, 1, AT("&",old_color)+2, "")
  258.  
  259. comma = AT(",",old_color)
  260. c_messages = LEFT(old_color, comma-1)        && Get MESSAGES color
  261. old_color = STUFF(old_color, 1, comma, "")    && Remove MESSAGES color
  262.  
  263. comma = AT(",",old_color)
  264. c_titles = LEFT(old_color, comma-1)        && Get TITLES color
  265. old_color = STUFF(old_color, 1, comma, "")    && Remove TITLES color
  266.  
  267. comma = AT(",",old_color)
  268. c_box = LEFT(old_color, comma-1)        && Get BOX color
  269. old_color = STUFF(old_color, 1, comma, "")    && Remove BOX color
  270.  
  271. comma = AT(",",old_color)
  272. c_info = LEFT(old_color, comma-1)        && Get INFORMATION color
  273. old_color = STUFF(old_color, 1, comma, "")    && Remove INFORMATION color
  274.  
  275. comma = AT(",",old_color)
  276. c_fields = old_color                                    && Get FIELDS color
  277.  
  278. SET COLOR OF MESSAGES    TO &c_messages.
  279. SET COLOR OF TITLES      TO &c_titles.
  280. SET COLOR OF BOX         TO &c_box.
  281. SET COLOR OF INFORMATION TO &c_info.
  282. SET COLOR OF FIELDS      TO &c_fields.
  283. RETURN
  284.  
  285.  
  286. PROCEDURE Sub_ret
  287.    IF erased
  288.       * Pack deleted records (if any) - erases completely from database
  289.       ************
  290.       IF NETWORK()
  291.          USE (dbf) EXCLUSIVE
  292.       ENDIF
  293.       IF net_choice <> 27       && Skip if user pressed Esc 
  294.       *******************       && error condition
  295.          ?? CHR(7)
  296.          ACTIVATE WINDOW alert
  297.             @ 0,0 SAY "--------- DATABASE WORDT GESCHOOND -------"
  298.             @ 2,0 SAY "Records met wismarkering worden verwijderd"
  299.             @ 3,0 SAY "Even geduld a.u.b....SCHAKEL NIETS UIT"
  300.             PACK
  301.          DEACTIVATE WINDOW alert
  302.       ENDIF
  303.    ENDIF
  304.    * Houskeeping
  305.    CLOSE DATABASES
  306.    CLEAR WINDOWS
  307.    RELEASE ALL
  308.    CLEAR
  309.    ON ERROR
  310.    ON KEY LABEL F9             && Turn off ON KEY LABEL F9/F10 commands
  311.    ON KEY LABEL F10
  312.    * Restore environment (in case user began at Control Center or dot prompt)
  313.    DO Rest_env
  314.    CLEAR
  315. RETURN TO MASTER               && Exit Subapplication
  316.  
  317. FUNCTION Duplicat
  318.    PARAMETERS key
  319.    * Used if duplicates are not allowed in a database
  320.    * Set rec_is_dup to .T. if user entered duplicate key data
  321.    rec_is_dup = .F.
  322.    IF RECCOUNT() = 0 .OR. "" = TRIM(key)
  323.       * Do not check if database or key field(s) is empty
  324.       RETURN rec_is_dup
  325.    ENDIF
  326.    record_num = RECNO()               && Save current record position 
  327.    SEEK  TRIM(key)
  328.    * Determine if record is duplicate key
  329.    * PROMPT() used instead of BAR() for clarity
  330.    DO CASE
  331.       CASE PROMPT() = " Bewerken record"
  332.          * If seek finds a record other than the current one, 
  333.          * the edited record has a duplicate key 
  334.          rec_is_dup =  record_num <> RECNO() .AND. FOUND()
  335.       CASE PROMPT() = " Toevoegen record"
  336.          * New record is duplicate if seek finds any record that matches
  337.          rec_is_dup = FOUND()
  338.    ENDCASE
  339.    IF rec_is_dup                      && Show duplicate record in window
  340.       ACTIVATE WINDOW duplicat
  341.          CLEAR
  342.          DO Warnbell
  343.          ?  "------------------ DUPLICAAT " + dbf + ;
  344.             " RECORD ------------------"
  345.          ?  "                Duplicaten niet toegestaan"
  346.          DO CASE
  347.             CASE dbf = "KLNT"
  348.                ?  " " + klant_nr + " " + klantnaam
  349.                ? "Dit is actieve record in de database; " + ;
  350.                  "Typ opnieuw een klantnr."
  351.             CASE dbf = "VERKOPER"
  352.                ?  " " + verkoop_nr + " " + verkoper
  353.                ? "Dit is actieve record in de database; " + ;
  354.                  "Typ opnieuw een verkoopnr."
  355.             CASE dbf = "GOEDEREN"
  356.                ?  " " + ondrdl_nr + " " + artikel
  357.                ? "Dit is actieve record in de database; " + ;
  358.                  "Typ opnieuw een artikelnr."
  359.             CASE dbf = "REKN_REC"
  360.                ?  " " + factuur_nr + " " + klant + " " + DTOC(fact_datum)
  361.                ? "Dit is actieve record in de database; " + ;
  362.                  "Typ opnieuw een factuurnr."
  363.          ENDCASE
  364.          WAIT "   Ga verder met de spatiebalk..."
  365.       DEACTIVATE WINDOW duplicat
  366.    ENDIF
  367.    GO record_num                     && Return to original record
  368. RETURN .NOT. rec_is_dup
  369.  
  370. PROCEDURE Dstatus
  371.    * Display filter status and current record number
  372.    * Set colors with blink on/off depending on hardware
  373.    IF filters_on
  374.       * Show blinking msg for filter status
  375.       @ 0,51 SAY "Filter ACTIEF" COLOR &c_blink. 
  376.    ELSE
  377.       SET COLOR TO &c_standard.
  378.       * Erase message - filter is off
  379.       @ 0,51
  380.    ENDIF
  381.    * Show  current record number on screen
  382.    @ 0,66 SAY "Recordnr." + STR(RECNO(),5,0) COLOR &c_yellow.
  383. RETURN
  384.  
  385. PROCEDURE Edit
  386.    * Edit current record
  387.    * Display lookup key message if lookup available (set in each application)
  388.    IF lookup_ok
  389.       DO Sho_look WITH dbf
  390.    ENDIF
  391.    record_num = RECNO()
  392.    * Load data from record into memory variables
  393.    DO Load_fld
  394.    IF NETWORK()                      && Edit data in a network
  395.       ready = .F.
  396.       DO WHILE .NOT. ready
  397.          IF CHANGE()
  398.             * If the record was changed by somone since user first accessed it
  399.             DO Warnbell
  400.             GO RECNO()           && Updates database record with changed data
  401.             IF DELETED()
  402.                DO Show_msg WITH "ATTENTIE: record is verwijderd"
  403.                SKIP
  404.                DO Show_data
  405.                RETURN            && Exit to OPTION MENU - quit edit
  406.             ELSE
  407.                DO Show_msg WITH ;
  408.                   "Gegevens gewijzigd; nieuwe gegevens op scherm"
  409.                DO Load_fld           && Updates memvars with database data
  410.             ENDIF
  411.          ENDIF
  412.          DO Get_data
  413.          READ                        && Edit data
  414.          * Test if another user changed data while editing this data
  415.          ready = .NOT. CHANGE()      && DO loop will repeat if CHANGE() is .F.
  416.       ENDDO
  417.    ELSE                              && Non-network edit
  418.       DO Get_data
  419.       READ                           && Edit data
  420.    ENDIF
  421.    *****
  422.    * Erase F9 lookup message from screen
  423.    @ 0,0 SAY SPACE(51)
  424.    IF "" = TRIM(&key.) .OR. READKEY() < 256
  425.       * Exit if user blanked key, did not change data, or deleted record
  426.       RETURN
  427.    ELSE
  428.       * Save edited data to disk
  429.       DO Sav_data
  430.    ENDIF
  431. RETURN
  432.  
  433. PROCEDURE Eraser
  434.    * Erase current record
  435.    answer = " "
  436.    ACTIVATE WINDOW alert
  437.       @ 0,0 SAY "----------GEGEVENSRECORD WISSEN-----------"
  438.       @ 2,1 SAY "Dit gegevensrecord wissen? (J=Ja,N=Nee)" GET answer PICTURE "Y"
  439.       READ
  440.    DEACTIVATE WINDOW alert
  441.    IF answer = "J"
  442.       DELETE
  443.       * Position to the next record
  444.       SKIP
  445.       * Check if the last record was deleted
  446.       DO CASE
  447.          CASE filters_on .AND. EOF()
  448.             * If no records left in filter subset, turn off filter
  449.             SET FILTER TO   
  450.             filters_on = .F.
  451.             * If last record deleted, go to beginning of database
  452.             GO TOP          
  453.          CASE .NOT. filters_on .AND. EOF()
  454.             * If last record deleted, go to beginning of database
  455.             GO TOP
  456.       ENDCASE
  457.       * Set erased status flag that record was deleted
  458.       erased = .T.          
  459.    ENDIF
  460. RETURN
  461.  
  462. PROCEDURE Filt_ans
  463.    * Get answer from user about filtering data into subset
  464.    ACTIVATE WINDOW alert
  465.       @ 0,0 SAY "--Groeperen in DEELVERZAMELING (filter)--"
  466.       IF filters_on
  467.          * Filter window - to turn off filter
  468.          @ 2,0 SAY "  Deelverzameling is geselecteerd."
  469.          @ 3,0 SAY "  Filter uitschakelen ?"
  470.          @ 4,0 SAY "  (U=Uit, N=Nee)  "GET choice PICTURE "!" ;
  471.            VALID choice $ "UN"
  472.       ELSE
  473.          * Filter window - to turn on filter
  474.          @ 2,1 SAY "Kies tijdelijke deelverzameling met"
  475.          @ 3,1 SAY "gegevens (typ filtervoorwaarde(n)) "
  476.          @ 4,1 SAY "                                  "
  477.          @ 5,1 SAY "Doorgaan? (J=Ja, N=Nee)   "GET choice PICTURE "Y"
  478.       ENDIF
  479.       READ
  480.    DEACTIVATE WINDOW alert
  481.    IF choice = "N"              && Do not change filter status
  482.       RETURN TO Barpop          && Do not finish processing Filter proceedure
  483.    ENDIF
  484. RETURN
  485.  
  486. PROCEDURE Findcode
  487.    PARAMETERS acity
  488.    * Look up area code for phone number - by city
  489.    i = INKEY()
  490.    acode = 0
  491.    ACTIVATE WINDOW alert
  492.       CLEAR
  493.       acode = LOOKUP(Netnum->kengetal,TRIM(acity),Netnum->woonplaats)
  494.       ? "-------- ZOEKFUNCTIE KENGETAL --------"
  495.       IF .NOT. FOUND("Netnum") .OR. "" = TRIM(acity)
  496.          DO Warnbell
  497.          ? "Woonplaats: " + TRIM(acity) + " komt"    AT 2
  498.          ? "komt NIET voor in tabel met kengetallen." AT 2
  499.       ELSE
  500.          ?
  501.          ? "KENGETAL is: " + acode AT 2
  502.          ? "voor " + TRIM(acity)  AT 16
  503.       ENDIF
  504.       ?
  505.       i= INKEY(3)                   && Display for 3 seconds
  506.    DEACTIVATE WINDOW alert
  507. RETURN
  508.  
  509. PROCEDURE Findcust
  510.    PARAMETERS custid
  511.    * Look up customer from customer ID
  512.    i= INKEY()
  513.    acust = ""
  514.    ACTIVATE WINDOW alert
  515.       CLEAR
  516.       acust = LOOKUP(Klnt->klantnaam,TRIM(custid),Klnt->klant_nr)
  517.       ? "-------- ZOEKFUNCTIE KLANTNUMMER ---------"
  518.       IF .NOT. FOUND("Klnt") .OR. "" = TRIM(custid)
  519.          DO Warnbell
  520.          ? "Klantnummer: " + TRIM(custid) + " komt" AT 2
  521.          ? "NIET voor in database Klnt." AT 2
  522.       ELSE
  523.          ? "Klant: " + TRIM(acust)  AT 2
  524.          ? "Tel.:    " + klnt->telefoon  AT 2
  525.          ? "nummer: "   + TRIM(custid) AT 12
  526.       ENDIF
  527.       WAIT " Ga verder met de spatiebalk..."
  528.    DEACTIVATE WINDOW alert
  529. RETURN
  530.  
  531. PROCEDURE Find_rec
  532.    PARAMETERS key, key1, keyname1, key2, keyname2, key3, keyname3
  533.    * Get target data to find/seek and show data record after retrieving
  534.    STORE "" TO target1, target2, target3
  535.    target1 = IIF(TYPE(key1) = "C", SPACE(LEN(&key1.)), {  /  /  })
  536.    * If key2 exists (database requires two keys)
  537.    IF "GEEN" <> key2
  538.       target2 = IIF(TYPE(key2) = "C", SPACE(LEN(&key2.)), {  /  /  })
  539.       * If key3 exists (database has three keys)
  540.       IF "GEEN" <> key3
  541.          target3 = IIF(TYPE(key3) = "C", SPACE(LEN(&key3.)), {  /  /  })
  542.       ENDIF
  543.    ENDIF
  544.    ACTIVATE WINDOW alert
  545.       @ 0,0 SAY "------- TYP TE ZOEKEN DOELGEGEVENS -------"
  546.       @ 2, 1 SAY keyname1
  547.       @ 2,15 GET target1  MESSAGE "Typ " + keyname1
  548.       IF "GEEN" <> key2
  549.          @ 3, 1 SAY keyname2
  550.          @ 3,15 GET target2
  551.          IF "GEEN" <> key3
  552.             @ 4, 1 SAY keyname3
  553.             @ 4,15 GET target3
  554.          ENDIF
  555.       ENDIF
  556.       @ 5,1 SAY "Typ gegevens (geheel of gedeeltelijk)"
  557.       READ
  558.    DEACTIVATE WINDOW alert
  559.    target = IIF(type(key1) = "C", target1, DTOC(target1))
  560.    IF "GEEN" <> key2
  561.       target = target + IIF(type(key2) = "C", target2, DTOC(target2))
  562.       IF "GEEN" <> key3
  563.          target = target + IIF(type(key3) = "C", target3, DTOC(target3))
  564.       ENDIF
  565.    ENDIF
  566.    target = TRIM(target)
  567.    IF RIGHT(target, 6) = "  /  /"
  568.       * If a date key wasn't filled in, remove the template
  569.       target = LEFT(target, LEN(target) - 6)
  570.    ENDIF
  571.    IF "" = target
  572.       * If user entered nothing (blank key) => exit
  573.       RETURN
  574.    ENDIF
  575.    * Store record no. that the user was viewing
  576.    record_num = RECNO()
  577.    * Find record with target key
  578.    IF .NOT. SEEK(target)
  579.       * If target not found, uppercase & look again
  580.       IF .NOT. SEEK(UPPER(target))
  581.          * Sound bell and alert user with message
  582.          DO Warnbell
  583.          DO Show_msg WITH "Record met doelgegevens NIET gevonden."
  584.          * Return to original record user was viewing
  585.          GO record_num
  586.       ENDIF
  587.    ENDIF
  588. RETURN
  589.  
  590. PROCEDURE Findpart
  591.    PARAMETERS partid
  592.    * Look up part data using part ID number in Goods database when 
  593.    * function key pressed
  594.    i = INKEY()
  595.    p_name = SPACE(30)
  596.    ACTIVATE WINDOW alert
  597.       CLEAR
  598.       p_name = LOOKUP(Goederen->artikel,TRIM(partid),Goederen->ondrdl_nr)
  599.       ? "-------- ZOEKFUNCTIE DEELGEGEVENS --------"
  600.       IF .NOT. FOUND("Goederen") .OR. "" = TRIM(partid)
  601.          DO Warnbell
  602.          ? "Artikel: " + TRIM(partid) AT 2
  603.          ? "NIET gevonden in database Goederen." AT 2
  604.       ELSE
  605.          ? "nummer:    " + partid       AT 2
  606.          ? "Artikel: " + TRIM(p_name) AT 2
  607.          ? "In voorraad: " + STR(Goederen->aant_voorr,4) AT 2
  608.          ? "Prijs: ƒ " AT 2, Goederen->prijs PICTURE "99999.99"
  609.       ENDIF
  610.       WAIT " .....Ga verder met de spatiebalk..."
  611.    DEACTIVATE WINDOW alert
  612. RETURN
  613.  
  614. PROCEDURE Findvend
  615.    PARAMETERS vendr
  616.    * Look up vendor name using vendor ID number in Vendor database
  617.    * when function key pressed
  618.    i = INKEY()
  619.    v_name = SPACE(30)
  620.    ACTIVATE WINDOW alert
  621.       CLEAR
  622.       v_name = LOOKUP(Verkoper->verkoper,TRIM(vendr),Verkoper->verkoop_nr)
  623.       ? "----- ZOEKFUNCTIE VERKOOPNUMMER -----"
  624.       IF .NOT. FOUND("Verkoper")
  625.          DO Warnbell
  626.          ? "Verkoopnr.: " + TRIM(vendr)    AT 2
  627.          ? "komt NIET voor in database Verkoper." AT 2
  628.       ELSE
  629.          ? "Lever.:  " + TRIM(v_name)   AT 2
  630.          ? "Telnr.:  " + Verkoper->telefoon AT 2
  631.          ? "Nummer:  " + vendr          AT 2
  632.       ENDIF
  633.       WAIT "   Ga verder met de spatiebalk..."
  634.    DEACTIVATE WINDOW alert
  635. RETURN
  636.  
  637. PROCEDURE Kount
  638.    * Count and display number of records in database
  639.    record_num = RECNO()
  640.    ACTIVATE WINDOW alert
  641.      @ 0,0 SAY "------------- AANTAL RECORDS -------------"
  642.      @ 2,1 SAY "Records worden geteld..."
  643.      * Use count if filter is active (subset of records)
  644.      IF filters_on
  645.         COUNT TO kount
  646.      ELSE
  647.         * Use reccount if filter is not active (all records)
  648.         kount = RECCOUNT()
  649.      ENDIF
  650.      @ 2,1 SAY dbf +" bevat " + STR (kount,6) + " records"
  651.      ?
  652.      WAIT " Druk op een toets om verder te gaan..."
  653.    DEACTIVATE WINDOW alert
  654.    * Return to original record (before count)
  655.    GO record_num
  656. RETURN
  657.  
  658. PROCEDURE List_rec
  659.    * Lists records (in active index order) from top
  660.    * If filter is active, then subset listed
  661.    record_num = RECNO()                 && Store current record position
  662.    GO TOP                               && Start at beginning
  663.    ACTIVATE WINDOW lister
  664.       answer = " "
  665.       CLEAR
  666.       @ 0,0 SAY "-------------------------- INHOUD DATABASE " + ;
  667.                 "---------------------------" ;
  668.             COLOR &c_red.
  669.       SCAN WHILE .NOT. answer $ "tT"
  670.          LIST OFF NEXT 10 &list_flds.
  671.          WAIT "Ga verder met de spatiebalk of druk op T voor " + ;
  672.               "OPTIEMENU." TO answer
  673.          CLEAR
  674.       ENDSCAN
  675.    DEACTIVATE WINDOW lister
  676.    * Return to original record (before viewing list)
  677.    GO record_num
  678. RETURN
  679.  
  680. PROCEDURE Look_msg
  681.    DO CASE                                && Show proper lookup msg in window
  682.       CASE similar = .F.                  && No similar data found
  683.          @ 1,1 SAY "Ingev. "+look_name+" nr. komt niet voor in     " + ;
  684.                look_dbf+" dbf.     "
  685.          ?
  686.          WAIT "Geen " + look_name + " overeenk. nrs. - " + ;
  687.               "T om naar scherm te gaan." TO answer
  688.       CASE similar = .T. .AND. listcount > 0   
  689.          && Similar data found and listed
  690.          WAIT "Spatiebalk voor vervolg of " + ;
  691.               "T om naar scherm te gaan." TO answer
  692.          CLEAR
  693.    ENDCASE
  694.    CLEAR
  695. RETURN
  696.  
  697. FUNCTION Lookupid
  698.    PARAMETERS l_target, look_dbf, look_name, matchchars
  699.    * During data entry or editing, validate data entered into any of the
  700.    * fields of customer ID, parts ID, vendor ID, and employee ID by checking 
  701.    * for their existence in their respective databases - list any similar data 
  702.    * by matching the first one or more characters (between entered data and 
  703.    * database). 
  704.    * Note: matchchars = number of initial matching characters for lookup lists
  705.    * Example: list will show customers whose cust_id's first two characters
  706.    * match with the entered cust_id's first two characters (matchchars = 2)
  707.    IF .NOT. SEEK(l_target,(look_dbf))     && Seek data in its respective dbf
  708.       ACTIVATE WINDOW look
  709.       DO Warnbell
  710.       answer = " "
  711.       similar = .F.
  712.       SELECT (look_dbf)                   && Use appropriate dbf for listing
  713.       GO TOP
  714.       DO WHILE .NOT. (EOF() .OR. answer $ "tT")
  715.          * Show list of records having identical initial character(s) 
  716.          * in ID number
  717.          @ 0,0 SAY "---FOUT BIJ GEGEVENSINVOER:" + look_name + ;
  718.                    " ONGELDIG NUMMER-------"
  719.          @ 1,0 SAY " Dit is een lijst met op elkaar lijkende " + look_name + ;
  720.                    " nummers"
  721.          ?
  722.          listcount = 0
  723.          DO CASE                         && Check which database screen in use
  724.            CASE dbf = "BESTEL"
  725.               DO CASE                    && Check which field is being read
  726.                  CASE VARREAD() = "KLANT_NR"
  727.                     SCAN FOR LIKE(SUBSTR(l_target,1,matchchars)+"*",klant_nr) ;
  728.                        WHILE listcount <= 4
  729.                        ? klant_nr, klantnaam         && Display a record
  730.                        listcount = listcount + 1     && Increment list counter
  731.                        similar = .T.                 && Data found and listed
  732.                     ENDSCAN
  733.                  CASE VARREAD() = "ONDRDL_NR"
  734.                     SCAN FOR LIKE(SUBSTR(l_target,1,matchchars)+"*",ondrdl_nr) ;
  735.                        WHILE listcount <= 4
  736.                        ? ondrdl_nr, SUBSTR(artikel,1,21), ;
  737.                          SUBSTR(omschrijv,1,24)
  738.                        listcount = listcount + 1     && Increment list counter
  739.                        similar = .T.                 && Data found and listed
  740.                     ENDSCAN
  741.                  CASE VARREAD() = "PERS_NR"
  742.                     SCAN FOR LIKE(SUBSTR(l_target,1,matchchars)+"*",pers_nr) ;
  743.                        WHILE listcount <= 4
  744.                        ? pers_nr, achternaam, voornaam && Display a record
  745.                        listcount = listcount + 1     && Increment list counter
  746.                        similar = .T.                 && Data found and listed
  747.                     ENDSCAN
  748.               ENDCASE
  749.            CASE dbf = "GOEDEREN"
  750.               SCAN FOR LIKE(SUBSTR(l_target,1,matchchars)+"*",verkoop_nr) ;
  751.                  WHILE listcount <= 4
  752.                  ? verkoop_nr, verkoper                 && Display a record
  753.                  listcount = listcount + 1           && Increment list counter
  754.                  similar = .T.                       && Data found and listed
  755.               ENDSCAN
  756.            CASE dbf = "REKN_REC"
  757.               SCAN FOR LIKE(SUBSTR(l_target,1,matchchars)+"*",klant_nr) ;
  758.                  WHILE listcount <= 4
  759.                  ? klant_nr, klantnaam                && Display a record
  760.                  listcount = listcount + 1           && Increment list counter
  761.                  similar = .T.                       && Data found and listed
  762.               ENDSCAN
  763.          ENDCASE
  764.          DO Look_msg                                 && Show message in window
  765.       ENDDO
  766.       DEACTIVATE WINDOW look
  767.       SELECT 1                                       && Use original dbf
  768.    ENDIF
  769. RETURN not_valid = .NOT. FOUND((look_dbf))
  770.  
  771. PROCEDURE Net_err
  772.    PARAMETERS err_number
  773.    * Error procedure for networks
  774.    DO CASE
  775.       CASE err_number = 108        
  776.          * File is in use by another person
  777.          IF "" <> TRIM(LKSYS(2))
  778.             message = " " + dbf + " in gebruik bij: " + LKSYS(2)
  779.          ELSE
  780.             message = " " + dbf + " wordt al door iemand gebruikt"
  781.          ENDIF
  782.       CASE err_number = 109        
  783.          * Record is locked by another person
  784.          message = " Record vergrendeld door: " + LKSYS(2)
  785.       CASE err_number = 110        
  786.          * File must be in exclusive use for indexing/packing
  787.          message = "Voor bestand moet USE EXCLUSIVE gelden"
  788.       CASE err_number = 372 .OR. err_number = 373 
  789.          * File or record is in use by another
  790.          message = MESSAGE()
  791.       OTHERWISE
  792.          message = " Onbekende fout: " + MESSAGE()
  793.    ENDCASE
  794.    DO Warnbell
  795.    ACTIVATE WINDOW alert
  796.       CLEAR
  797.       ? "--------ALGEMENE- OF NETWERKFOUT----------"
  798.       ?
  799.       ? message AT 1
  800.       ? "Druk op spatiebalk voor nieuwe poging" AT 1
  801.       ? " - of druk op Esc om te stoppen" AT 1
  802.       net_choice = INKEY(0)          && Wait for user to press a key
  803.    DEACTIVATE WINDOW alert
  804.    IF net_choice <> 27               && User did not press Esc key
  805.       * Execute command again that caused network error
  806.       RETRY                          
  807.    ENDIF
  808. RETURN
  809.  
  810. PROCEDURE Printout
  811.    * Print report or label
  812.    DO CASE
  813.       CASE reportype = "LISTING"
  814.          REPORT FORM &dbf.
  815.       CASE reportype = "LABELS"
  816.          LABEL FORM &dbf.
  817.       CASE reportype = "CUSTOM"
  818.          DO &rpt_name.
  819.    ENDCASE
  820.    GO record_num
  821. RETURN
  822.  
  823. PROCEDURE Prt_menu
  824.    * Display menu of print options
  825.    msg_num   = "Typ een nummer"
  826.    msg_logic = "Typ J of N"
  827.    msg_enum  = "Druk op de spatiebalk voor andere opties"
  828.    * Set up default values to print variables for reports
  829.    loffset  = 0
  830.    lmargin  = 0
  831.    rmargin  = 80
  832.    indent   = 4
  833.    plength  = 66           && 60 - HP laserjet printer
  834.    STORE 1 TO pspacing, pbpage, pcopies
  835.    pepage   = 9999
  836.    peject   = "NONE  "
  837.    STORE .F. TO pwait, pquality
  838.    ppitch   = "PICA     "
  839.    *
  840.    ACTIVATE WINDOW lister
  841.    CLEAR
  842.    @  0, 0 SAY "------------------------- AFDRUKMENU " + ;
  843.               "---------------------------" COLOR &c_red.
  844.    @  2, 1 SAY "Pagina-instellingen:"
  845.    @  3, 1 SAY "============="
  846.    @  4, 1 SAY "Offset links      " GET loffset ;
  847.            PICTURE "99" MESSAGE msg_num
  848.    @  5, 1 SAY "Linkerkantlijn    " GET lmargin ;
  849.            PICTURE "99" MESSAGE msg_num
  850.    @  6, 1 SAY "Rechterkantlijn   " GET rmargin ;
  851.            PICTURE "99" MESSAGE msg_num
  852.    @  7, 1 SAY "Inspringing       " GET indent ;
  853.            PICTURE "99" MESSAGE msg_num
  854.    @  8, 1 SAY "Paginalengte      " GET plength ;
  855.            PICTURE "99" MESSAGE msg_num
  856.    @  9, 1 SAY "Regelafstand      " GET pspacing ;
  857.            PICTURE "9"  RANGE 1,3 MESSAGE msg_num
  858.    @  2,26 SAY "Afdrukinstellingen"
  859.    @  3,26 SAY "=============="
  860.    @  4,26 SAY "Afdrukken vanaf pagina  " GET pbpage ;
  861.            PICTURE "999"  MESSAGE msg_num
  862.    @  5,26 SAY "Laatste pagina          " GET pepage ;
  863.            PICTURE "9999" MESSAGE msg_num
  864.    @  6,26 SAY "Aantal exemplaren       " ;
  865.            GET pcopies  PICTURE "999"  MESSAGE msg_num
  866.    @  7,26 SAY "Papier doorvoeren       " GET peject ;
  867.            PICTURE "@M BEFORE,BOTH,AFTER,NONE"  MESSAGE msg_enum
  868.    @  8,26 SAY "Pauze tussen pagina's   " GET pwait ;
  869.            PICTURE "Y" MESSAGE msg_logic
  870.    @  9,26 SAY "Tekenbreedte            " GET ppitch ;
  871.            PICTURE "@M DEFAULT,PICA,ELITE,CONDENSED" MESSAGE msg_enum
  872.    @ 10,26 SAY "Kwaliteitsafdruk        " GET pquality ;
  873.            PICTURE "Y" MESSAGE msg_logic
  874.    @ 12, 1 SAY "Geef gewenste instellingen op (PgDn = afdrukken)"
  875.    READ
  876.    DEACTIVATE WINDOW lister
  877.    * Assign values to system variables
  878.    _ploffset = loffset
  879.    _lmargin  = lmargin
  880.    _rmargin  = rmargin
  881.    _indent   = indent
  882.    _plength  = plength
  883.    _pspacing = pspacing
  884.    _pbpage   = pbpage
  885.    _pepage   = pepage
  886.    _pcopies  = pcopies
  887.    _peject   = peject
  888.    _pwait    = pwait
  889.    _ppitch   = ppitch
  890.    _pquality = pquality
  891.    SET COLOR TO &c_standard.
  892. RETURN
  893.  
  894. PROCEDURE Rest_env
  895.     * Restore database environment 
  896.     SET COLOR TO &c_standard.
  897.     SET SCOREBOARD &scor.
  898.     SET DELIMITERS &deli.
  899.     SET HELP &hellp.
  900.     SET CLOCK &clock.
  901.     SET ESCAPE &esca.
  902.     SET DELETED &delee.
  903.     SET HEADING &head.
  904.     SET STATUS &stat.
  905.     SET SAFETY &safe.
  906.     SET EXACT &exac.
  907.     SET BELL &bell.
  908.     SET NEAR &near.
  909.     * Reset colors to system defaults
  910.     DO Colo_rese
  911.     SET TALK &talk.
  912. RETURN
  913.  
  914. PROCEDURE Sav_data
  915.    * If data is new: append record currently in memory to database.
  916.    * If edited/modified data: replace database record with memory fields.
  917.    choice = "J"
  918.    ACTIVATE WINDOW alert
  919.       @ 0,1 SAY "-----------GEGEVENS OPSLAAN-------------"
  920.       @ 2,1 SAY "Deze gegevens opslaan ? (J/N) " GET choice PICTURE "Y"
  921.       READ
  922.    DEACTIVATE WINDOW alert
  923.    IF choice = "J"
  924.       IF PROMPT() = " Toevoegen record"      && Add new blank record
  925.          APPEND BLANK
  926.          record_num = RECNO()
  927.       ENDIF
  928.       * Replace database file fields with contents of memory variables
  929.       DO Repl_fld     
  930.    ELSE
  931.       * Do not save data to disk, return to original record
  932.       GO record_num
  933.    ENDIF
  934. RETURN
  935.  
  936. PROCEDURE Set_env
  937.    PUBLIC talk                  && First set TALK OFF
  938.    talk         = SET("TALK")
  939.    SET TALK off
  940.  
  941.    PUBLIC c_current
  942.    c_current=SET("ATTRIBUTES")
  943.  
  944.  
  945.    PUBLIC c_standard, c_data, c_fields, c_popup, c_alert, c_list
  946.    PUBLIC c_red, c_blue, c_yellow, c_yelowhit, c_green, c_blink
  947.  
  948.    * Set color variables for applications
  949.    IF ISCOLOR()
  950.       * Color video card/monitor
  951.       c_standard = "W/B,BG+/R,B"
  952.       c_data     = "B/W,R/BG,B"
  953.       c_fields   = "B/BG"
  954.       c_popup    = "B/W,GR+/R"
  955.       c_alert    = "GR+/R,B/W,R/G"
  956.       c_list     = "W+/G,GR+/B,GR+/GR"
  957.       c_red      = "R/W"
  958.       c_blue     = "B/W"
  959.       c_yellow   = "GR+/B"
  960.       c_yelowhit = "GR+/W"
  961.       c_green    = "G/W"
  962.       c_blink    = "GR+*/B"
  963.    ELSE
  964.       * Monochrome video card/monitor
  965.       STORE "W+/N,N/W" TO c_standard, c_data, c_popup, c_alert, c_list
  966.       STORE "W" TO  c_red, c_blue, c_yellow, c_yelowhit, c_green, c_fields
  967.       c_blink = "W+*/N,N/W"
  968.    ENDIF
  969.    SET COLOR OF MESSAGES TO &c_blue.
  970.    SET COLOR TO &c_standard.
  971.  
  972.    * Configure working environment
  973.    * Store SET environment in case started from Control Center or dot prompt
  974.    PUBLIC scor, deli, hellp, clock, esca, delee, head, stat, safe
  975.    PUBLIC exac, bell, near
  976.    scor  = SET("SCOREBOARD")
  977.    deli  = SET("DELIMITERS")
  978.    hellp = SET("HELP")
  979.    clock = SET("CLOCK")
  980.    esca  = SET("ESCAPE")
  981.    delee = SET("DELETED")
  982.    head  = SET("HEADING")
  983.    stat  = SET("STATUS")
  984.    safe  = SET("SAFETY")
  985.    exac  = SET("EXACT")
  986.    bell  = SET("BELL")
  987.    near  = SET("NEAR")
  988.  
  989.    * Set database environment for applications
  990.    SET SCOREBOARD off
  991.    SET DELIMITERS off
  992.    SET HELP    off
  993.    SET CLOCK   off
  994.    SET ESCAPE  off
  995.    SET DELETED on
  996.    SET HEADING on
  997.    SET STATUS  off
  998.    SET SAFETY  off
  999.    SET TALK    off
  1000.    SET EXACT   off
  1001.    SET BELL    off
  1002.    SET NEAR    off
  1003.    PUBLIC erased, not_valid, rec_is_dup, filters_on, lookup_ok, choice
  1004.    PUBLIC record_num, net_choice
  1005.    PUBLIC target, look_dbf, matchchar, scanfield
  1006.    * Logical variables used for status flags
  1007.    STORE .F. TO  erased, not_valid, rec_is_dup, filters_on
  1008.    lookup_ok = .T.
  1009.    * Other variables
  1010.    STORE "" TO choice,subset
  1011.    STORE 0 TO record_num, net_choice
  1012.    ************************************************
  1013.    * Setup error processing if running on a network
  1014.    IF NETWORK()
  1015.       * Network programming assumes databases have been CONVERTed
  1016.       SET EXCLUSIVE off
  1017.       ON ERROR DO Net_err WITH ERROR()
  1018.       * Retry a reasonable amount of time (depends on computer)
  1019.       SET REPROCESS TO 3  
  1020.    ENDIF
  1021.    ************************************************
  1022.    * Turns off VALID failure's (PRESS SPACE)
  1023.    ON READERROR ??
  1024. RETURN
  1025.  
  1026. PROCEDURE Sho_look
  1027.    PARAMETERS db
  1028.    * Show lookup function keys on screen (if available for database)
  1029.    DO CASE
  1030.       CASE db = "PERSONEL" .OR. db = "KLNT" .OR. db = "VERKOPER"
  1031.          look_txt = "F9: zoeken naar netnummer"
  1032.       CASE db = "GOEDEREN"
  1033.          look_txt = "F9: zoeken naam+tel.nr. leverancier"
  1034.       CASE db = "BESTEL"
  1035.          look_txt = "F9: Klnt-gegevens zoeken: F10: gegevens onderdeelnr."
  1036.       CASE db = "REKN_REC"
  1037.          look_txt = "F9: zoeken naar naam+tel.nr. in Klanten"
  1038.    ENDCASE
  1039.    @ 0,0 SAY look_txt COLOR &c_blink.
  1040.    i = INKEY(1)                                  && Blink for 1 second
  1041.    @ 0,0 SAY look_txt COLOR &c_yellow.
  1042. RETURN
  1043.  
  1044. PROCEDURE Show_msg
  1045.    PARAMETERS u_message
  1046.    _wrap = .T.
  1047.    ACTIVATE WINDOW alert
  1048.       @ 1,0 SAY u_message
  1049.       ?
  1050.       WAIT " Ga verder met de spatiebalk..."
  1051.    DEACTIVATE WINDOW alert
  1052. RETURN
  1053.  
  1054. PROCEDURE Skip_rec
  1055.    PARAMETERS skipno
  1056.    * Skip forward or backward in database by one or more records
  1057.    DO CASE
  1058.    CASE skipno = 1         && Skip to next record (in active index order)
  1059.       IF .NOT. EOF()
  1060.          SKIP
  1061.       ENDIF
  1062.    CASE skipno = -1        && Skip to previous record (in active index order)
  1063.       IF .NOT. BOF()
  1064.          SKIP -1
  1065.       ENDIF
  1066.    CASE skipno = 0
  1067.       * Skip records - to goto/view records ahead of or behind current record
  1068.       numb_2skip = 0
  1069.       ACTIVATE WINDOW alert
  1070.          @ 0,0 SAY "---------- RECORDS OVERSLAAN ------------"
  1071.          @ 2,1 SAY "Hoeveel records wilt u overslaan?"
  1072.          @ 3,0 SAY "  (voorbeeld: 15 of -5)    " ;
  1073.                GET numb_2skip PICTURE "9999" ;
  1074.                MESSAGE "Positief getal: voorwaarts; " + ;
  1075.                        "negatief getal: achterwaarts"
  1076.          READ
  1077.       DEACTIVATE WINDOW alert
  1078.       IF .NOT. (BOF() .AND. numb_2skip < 0) .OR. (EOF() .AND. numb_2skip > 0)
  1079.          SKIP numb_2skip
  1080.       ENDIF
  1081.    ENDCASE
  1082.  
  1083.    * Check whether record pointer hits beginning or end of file
  1084.    DO CASE
  1085.       CASE EOF()
  1086.          GO BOTTOM                  && reset record pointer if EOF
  1087.          DO Show_msg WITH " Laatste record in database " + dbf
  1088.       CASE BOF()
  1089.          DO Show_msg WITH " Eerste record in database " + dbf
  1090.    ENDCASE
  1091. RETURN
  1092.  
  1093. PROCEDURE Warnbell
  1094.    PRIVATE mwrap
  1095.    mwrap = _wrap           && Save _wrap value
  1096.    _wrap = .F.
  1097.    * Sound unique warning for errors
  1098.    SET BELL TO 880,4
  1099.    ?? CHR(7)
  1100.    SET BELL TO 1400,4
  1101.    ?? CHR(7)
  1102.    SET BELL TO 880,4
  1103.    ?? CHR(7)
  1104.    SET BELL TO
  1105.    _wrap = mwrap
  1106. RETURN
  1107.  
  1108. **************************** END OF BIBLIO.PRG ******************************
  1109.  
  1110.  
  1111.