home *** CD-ROM | disk | FTP | other *** search
/ Shareware Overload / ShartewareOverload.cdr / database / db_edit.zip / DB_DEMO.PRG < prev    next >
Text File  |  1988-07-19  |  24KB  |  1,061 lines
  1. * Program Name: db_demo.prg *
  2. * Author: Don L. Powells *
  3. * (c) 1988 by D. P. & Associates *
  4. **************************************************************************
  5. * Created: 5/5/1988 at 14:41                                             *
  6. * main =                                                                 *
  7. * Revision: ____  Last Revised: __________ @ __:__                       *
  8. * Called From:                                                           *
  9. * -- Data Base Files --   ---- Index Files ----   ----- Other Files ---- *
  10. * Customer.DBF            Cust_no.NTX  Last.NTX                          *
  11. * Serialno.DBF            Company.NTX  Zip.NTX                           *
  12. *                         State.NTX                                      *
  13. *************************** ALL RIGHTS RESERVED **************************
  14.  
  15. * Routine to demonstrate DBEDIT() with a User-defined function
  16.  
  17. * Save original DOS screen to restore upon exit
  18. SAVE SCREEN TO dosscrn
  19. CLEAR SCREEN
  20. SET WRAP ON
  21. beep_on = .T.   && Turn on Beep function
  22.  
  23. * Open the database and associated indexes
  24. USE CUSTOMER
  25. SET INDEX TO Company,Cust_no,Last,Zip,State
  26.  
  27. * Declare and initialize arrays and memory variable parameters
  28. t = 6
  29. l = 1
  30. b = 20
  31. r = 78
  32.  
  33. DECLARE fields[FCOUNT()-1],pics[FCOUNT()-1],heads[FCOUNT()-1],;
  34.    foots[FCOUNT()-1]
  35.  
  36. * Fill fields array with field names
  37. AFIELDS(fields)
  38.  
  39. udf = "Db_func"
  40.  
  41. AFILL(pics,"")
  42. pics[3] = "@R 999-999-9999"
  43. pics[9] = "99999-9999"
  44. pics[11] = "@!"
  45.  
  46. heads[1] = "Customer No."
  47. heads[2] = "Company Name"
  48. heads[3] = "Phone No."
  49. heads[4] = "Extension"
  50. heads[5] = "Address"
  51. heads[6] = "Address"
  52. heads[7] = "City"
  53. heads[8] = "State"
  54. heads[9] = "Zip code"
  55. heads[10] = "First Name"
  56. heads[11] = "MI"
  57. heads[12] = "Last Name"
  58.  
  59. headsep = CHR(205)   && CHR(205) = '═'
  60. colsep = CHR(179)    && CHR(179) = '│'
  61. footsep = CHR(196)   && CHR(196) = '─'
  62.  
  63. foots[1] = "NO EDIT Allowed"
  64. foots[5] = "Line one"
  65. foots[6] = "Line two"
  66.  
  67. * Incremental seek string for speed scroll
  68. mstring = ""
  69.  
  70. * Draw screen constants
  71. Saycenter(1,"CLIPPER TRAINING")
  72. Saycenter(2,"DBEDIT() Demo")
  73. @ 3,0 SAY REPLICATE(CHR(196),80)
  74. * Draw box to surround table
  75. @ 5,0 TO 21,79
  76.  
  77. * Draw Browse menu
  78. Saycenter(22,"<ESC>:Exit <Return>:Edit <F2>:Form Edit <F3>:Order "+;
  79.           "<Del>:Del/Recall <F4>:Pack")
  80.  
  81. * If Empty file force EOF() bang and user function call
  82. IF RECCOUNT() = 0
  83.    KEYBOARD CHR(24)
  84. ENDIF
  85.  
  86. * Call DBEDIT() and start browsing
  87. DBEDIT(t,l,b,r,fields,udf,pics,heads,headsep,colsep,footsep,foots)
  88. CLOSE DATABASES
  89. RESTORE SCREEN FROM dosscrn
  90. RETURN
  91.  
  92. *****
  93. * Db_func() - User-defined function for DBEDIT().
  94. *
  95.  
  96. FUNCTION Db_func
  97.    PARAMETERS mstatus,fld_ptr
  98.    PRIVATE request
  99.  
  100.    * Assume normal return
  101.    request = 1
  102.  
  103.    * Save last keystroke
  104.    keystroke = LASTKEY()
  105.  
  106.    * Assign current field name to memory variable
  107.    curfield = fields[fld_ptr]
  108.  
  109.    * Save current cursor position
  110.    mrow = ROW()
  111.    mcol = COL()
  112.  
  113.    IF mstatus = 0
  114.       * Idle
  115.       request = Idlestat()
  116.       
  117.    ELSEIF mstatus = 1
  118.       * Beginning-of-file
  119.       request = Pasttop()
  120.  
  121.    ELSEIF mstatus = 2
  122.       * End-of-file
  123.       request = Pastbott(curfield)
  124.  
  125.    ELSEIF mstatus = 3
  126.       * Empty database file
  127.       request = Emptydbf(curfield,fld_ptr)
  128.  
  129.    ELSEIF mstatus = 4
  130.       * Keystroke exception
  131.       request = Keyexcep(keystroke,curfield,fld_ptr,mrow,mcol)
  132.  
  133.    ELSE
  134.       request = Idlestat()
  135.  
  136.    ENDIF
  137. RETURN(request)
  138.  
  139. *****
  140. * Idlestat() - Process idle status (0) of DBEDIT().
  141. * Notes: Updates record # and deleted status
  142. *
  143.  
  144. FUNCTION Idlestat
  145.    mrecno = RECNO()
  146.    @ 1,60 SAY "Record " + ALLTRIM(TRANSFORM(mrecno,"@Z"))
  147.    IF DELETED()
  148.       @ 2,60 SAY "** DELETED **"
  149.    ELSE
  150.       @ 2,60 SAY "             "
  151.    ENDIF
  152.  
  153.    morder = INDEXORD()
  154.    @ 2,5 SAY "Order: " + UPPER(INDEXKEY(morder)) + SPACE(5)
  155.  
  156.    * Draw Incremental Seek Prompt
  157.    @ 23,0 SAY "Enter " + TRIM(INDEXKEY(0)) + ":   "
  158.  
  159.    @ 4,0
  160.    Saycenter(4,"BROWSE MODE")
  161. RETURN(1)
  162.  
  163. *****
  164. * Pasttop() - Process status (1) of DBEDIT().
  165. *
  166.  
  167. FUNCTION Pasttop
  168.    Beep("NORM")
  169.    @ 0,0
  170.    @ 0,0 SAY "** Beginning of File **"
  171.    INKEY(.5)
  172.    @ 0,0
  173. RETURN(1)
  174.  
  175. *****
  176. * Pastbott() - Process status (2) of DBEDIT().
  177. *
  178.  
  179. FUNCTION Pastbott
  180.    PRIVATE curfield,retval
  181.    PARAMETERS curfield
  182.    @ 0,0
  183.    @ 0,0 SAY "** End of File **"
  184.    Beep("NORM")
  185.    retval = Apendrec(curfield,fld_ptr)
  186.    @ 0,0
  187. RETURN(retval)
  188.  
  189. *****
  190. * Apendrec() - Append a blank record to the file.
  191. *
  192.  
  193. FUNCTION Apendrec
  194.    PRIVATE curfield,fld_ptr,retval
  195.    PARAMETERS curfield, fld_ptr
  196.    retval = 1
  197.    @ 4,0
  198.    Saycenter(4,"BROWSE MODE")
  199.    resp = "N"
  200.    @ 24,0
  201.    @ 24,0 SAY "Do you want to add a new record (Y/N)? ";
  202.           GET resp PICTURE "@!"
  203.    READ
  204.    @ 24,0
  205.    IF resp = "Y"
  206.       APPEND BLANK
  207.       * Get the next unique serial number from the serial number file
  208.       currarea = SELECT()
  209.       SELECT 0
  210.       USE Serialno
  211.       mCust_no = Ser_num + 1
  212.       REPLACE Ser_num WITH mCust_no
  213.       USE
  214.       SELECT (currarea)
  215.       REPLACE Cust_no WITH mCust_no
  216.       Idlestat()
  217.       retval = 2
  218.    ENDIF
  219. RETURN(retval)
  220.  
  221. *****
  222. * Emptydbf() - Process status (3) of DBEDIT().
  223. *
  224.  
  225. FUNCTION Emptydbf
  226.    PRIVATE curfield,fld_ptr,retval
  227.    PARAMETERS curfield, fld_ptr
  228.    * Enter append mode
  229.    request = Apendrec(curfield,fld_ptr)
  230.    * Display status
  231.    Idlestat()
  232. RETURN(retval)
  233.  
  234. *****
  235. * Keyexcep() - Process keystroke exceptions.
  236. *
  237.  
  238. FUNCTION Keyexcep
  239.    PRIVATE request,keystroke,curfield,fld_ptr,mrow,mcol
  240.    PARAMETERS keystroke,curfield,fld_ptr,mrow,mcol
  241.    IF keystroke = 27    && <ESC>
  242.       * Exit
  243.       request = 0
  244.  
  245.    ELSEIF keystroke = 13
  246.       * Edit current cell
  247.       request = Fld_edit(curfield,fld_ptr)
  248.  
  249.    ELSEIF keystroke = 7    && <Del>
  250.       * Delete/Recall current record
  251.       request = Delrecall()
  252.  
  253.    ELSEIF keystroke = -1   && <F2>
  254.       * Form Edit
  255.       request = Formedit(mrow,mcol)
  256.  
  257.    ELSEIF keystroke = -2   && <F3>
  258.       * Select index order
  259.       request = Pickordr()
  260.       
  261.  
  262.    ELSEIF keystroke = -3   && <F4>
  263.       * Pack the file
  264.       request = Fil_pack()
  265.  
  266.    ELSEIF ASC(CHR(keystroke)) >= 32 .AND.;
  267.        ASC(CHR(keystroke)) <= 126   && Alphanumerics
  268.       * Speed Scroll/Incremental Seek
  269.       request = Incseek(curfield,keystroke,fld_ptr)
  270.  
  271.    ELSEIF keystroke = 8    && <Backspace>
  272.       * Decremental Seek
  273.       request = Decseek()
  274.  
  275.  
  276.    ELSE
  277.       Not_yet()
  278.       request = 1
  279.    ENDIF
  280.  
  281. RETURN(request)
  282.  
  283. *****
  284. * Delrecall() - Delete/Recall records toggle
  285. *
  286.  
  287. FUNCTION Delrecall
  288.    IF DELETED()
  289.       RECALL
  290.    ELSE
  291.       DELETE
  292.    ENDIF
  293.    * Update Deleted status
  294.    Idlestat()
  295. RETURN(1)
  296.  
  297. *****
  298. * Pickordr() - Select the index order for file
  299. *
  300.  
  301. FUNCTION Pickordr
  302.    PRIVATE retval,ntxcnt,ntxkey,maxntx,subscrpt,tr,lc,br,rc,ordscrn
  303.    retval = 1
  304.    * Count the number of indexes
  305.    ntxcnt = 0
  306.    ntxkey = INDEXKEY(ntxcnt)
  307.    IF "" != ntxkey
  308.       DO WHILE "" != ntxkey
  309.          ntxcnt = ntxcnt + 1
  310.          ntxkey = INDEXKEY(ntxcnt)
  311.       ENDDO
  312.       * Display menu of keys
  313.       DECLARE ntxarray[ntxcnt]
  314.       maxntx = 0
  315.       FOR i = 1 TO ntxcnt
  316.          ntxarray[i] = INDEXKEY(i)
  317.          maxntx = MAX(LEN(ntxarray[i]),maxntx)
  318.       NEXT
  319.       tr = 8
  320.       lc = (80 - maxntx)/2
  321.       br = 15
  322.       rc = lc + maxntx
  323.       ordscrn = SAVESCREEN((tr - 2),(lc - 1),(br + 1), (rc + 1))
  324.       @ 4,0
  325.       Saycenter(4,"Select Order")
  326.       @ (tr - 1),(lc - 1) TO (br + 1), (rc + 1)
  327.       SCROLL(tr,lc,br,rc,0)
  328.       subscrpt = ACHOICE(tr,lc,br,rc,ntxarray)
  329.       IF subscrpt != 0
  330.          SET ORDER TO subscrpt
  331.          @ 23,0
  332.          mstring = ""
  333.       ENDIF
  334.       RESTSCREEN((tr - 2),(lc - 1),(br + 1), (rc + 1),ordscrn)
  335.       retval = 2
  336.    ELSE
  337.       Beep("BOZO")
  338.       Err_msg("No index files are available.")
  339.    ENDIF
  340.    Idlestat()
  341. RETURN(retval)
  342.  
  343.  
  344.  
  345. *****
  346. * Fil_pack() - Remove deleted records from the file
  347. *
  348.  
  349. FUNCTION Fil_pack
  350.    Beep("NORM")
  351.    retval = 1
  352.    resp = "N"
  353.    @ 0,0
  354.    @ 0,0 SAY "Record removal is permanent. Continue?(Y/N) ";
  355.          GET resp PICTURE "@!" VALID(resp $ "Y/N")
  356.    READ
  357.    @ 0,0
  358.    IF resp = "Y"
  359.       @ 24,0
  360.       @ 24,0 SAY "Removing deleted records..."
  361.       PACK
  362.       retval =2
  363.       @ 24,0
  364.       Idlestat()
  365.    ENDIF
  366. RETURN(retval)
  367.  
  368.  
  369. *****
  370. * Fld_edit() - Edit cell contents in table using memory variable
  371. *
  372.  
  373. FUNCTION Fld_edit
  374.    PRIVATE curfield,fld_ptr
  375.    PARAMETERS curfield,fld_ptr
  376.    @ 4,0
  377.    Saycenter(4,"EDIT MODE")
  378.    * Assume no screen refresh
  379.    retval = 1
  380.  
  381.    ntx_expr = INDEXKEY(0)  && Get controlling index key
  382.    ntx_eval = &ntx_expr    && Expand for comparison after edit
  383.                            *  to determine if screen refresh is needed
  384.    SET CURSOR ON  && DBEDIT() turns cursor off by default
  385.    
  386.    * Store field contents to memory variable
  387.    get_data = &curfield
  388.  
  389.    * Allow up and down arrows to exit READ
  390.    READEXIT(.T.)
  391.  
  392.    * Prevent edits on Customer number field
  393.    IF curfield != "CUST_NO"
  394.       @ mrow,mcol GET get_data PICTURE get_pic(curfield,fld_ptr)
  395.       READ
  396.  
  397.       * Turn off up, down arrow key exiting
  398.       READEXIT(.F.)
  399.       keystroke = LASTKEY()        && save exit key
  400.  
  401.       IF keystroke != 27 .AND. UPDATED()
  402.          * Store changes to database
  403.          REPLACE &curfield WITH get_data
  404.  
  405.          IF !EMPTY(ntx_expr)
  406.              * File indexed..check for altered key field
  407.  
  408.              IF ntx_eval != (&ntx_expr)
  409.                  * key field altered..re-draw screen
  410.                  retval = 2
  411.  
  412.              ENDIF
  413.          ENDIF
  414.  
  415.            IF retval <> 2
  416.                * certain keys move cursor after edit if no refresh
  417.  
  418.             IF keystroke = 5
  419.                * Up arrow
  420.                KEYBOARD CHR(5)
  421.  
  422.             ELSEIF keystroke = 18
  423.                * PgUp
  424.                KEYBOARD CHR(5)
  425.  
  426.             ELSEIF keystroke = 24
  427.                * Down arrow
  428.                KEYBOARD CHR(24)
  429.  
  430.             ELSEIF keystroke = 3
  431.                * PgDn
  432.                KEYBOARD CHR(24)
  433.  
  434.             ELSEIF keystroke = 13 .OR. keystroke > 32
  435.                * Return or Typed past end..move right
  436.                KEYBOARD CHR(4)
  437.  
  438.             ENDIF
  439.          ENDIF
  440.       ENDIF
  441.    ELSE
  442.       @ 0,0
  443.       Beep("BOZO")
  444.       @ 0,0 SAY "No Edits allowed on this field!"
  445.       INKEY(1)
  446.       @ 0,0
  447.    ENDIF
  448.    SET CURSOR OFF
  449. RETURN(retval)
  450.  
  451. ******
  452. *    Get_pic() - Return matching picture string for specified field
  453. *
  454.  
  455. FUNCTION Get_pic
  456.  
  457. PRIVATE pstring, s,field,fld_ptr
  458. PARAMETERS field,fld_ptr
  459.  
  460. DO CASE
  461.  
  462.    CASE !EMPTY(pics[fld_ptr])
  463.       * Check picture array for a picture string
  464.       pstring = pics[fld_ptr]
  465.  
  466.     CASE TYPE(field) = "C"
  467.         * character field is bounded by window width
  468.         pstring = "@KS" + LTRIM(STR(MIN(LEN(&field), 78)))
  469.  
  470.     CASE TYPE(field) = "N"
  471.         * convert to character to help format picture string
  472.         s = STR(&field)
  473.  
  474.         IF "." $ s
  475.             * decimals in numeric...use the form "9999.99"
  476.             pstring = REPLICATE("9", AT(".", s) - 1) + "."
  477.             pstring = pstring + REPLICATE("9", LEN(s) - LEN(pstring))
  478.  
  479.         ELSE
  480.             * no decimals...only need the correct length
  481.             pstring = REPLICATE("9", LEN(s))
  482.  
  483.         ENDIF
  484.  
  485.     OTHERWISE
  486.         * no picture
  487.         pstring = ""
  488.  
  489. ENDCASE
  490.  
  491. RETURN(pstring)
  492.  
  493. *****
  494. * Formedit() - Edit the current record using a full-screen form
  495. *
  496.  
  497. FUNCTION Formedit
  498.    PRIVATE retval,mrow,mcol
  499.    PARAMETERS mrow,mcol
  500.    SAVE SCREEN
  501.    retval = Editview()
  502.    RESTORE SCREEN
  503. RETURN(retval)
  504.  
  505. *****
  506. * Editview() - Routine to change customer records
  507. *
  508.  
  509. FUNCTION Editview
  510.  
  511.   SET CURSOR ON  && DBEDIT() turns cursor off by default
  512.  
  513.   CLEAR SCREEN
  514.  
  515.   * Draw screen header
  516.   Saycenter(1,"CLIPPER TRAINING DEMO")
  517.   Saycenter(2,"DBEDIT() FORM EDIT MODE")
  518.   @ 3,0 SAY REPLICATE("_",79)
  519.   @ 23,0 SAY REPLICATE("_",79)
  520.  
  521.   * Draw screen prompts
  522.   Cusprompt()
  523.  
  524.   * Initialize memory variables
  525.   retval = 2
  526.   FOR i=1 TO FCOUNT()
  527.      fieldvar = "m" + FIELDNAME(i)
  528.      &fieldvar = .T.
  529.   NEXT
  530.  
  531.  
  532.   * Do editing/viewing until user exits
  533.   evexit = .F.
  534.   DO WHILE !evexit
  535.      BEGIN SEQUENCE
  536.      * Update Deleted and record number status
  537.      IF DELETED()
  538.         @ 1,0 SAY "** DELETED **"
  539.      ELSE
  540.         @ 1,0 SAY "             "
  541.      ENDIF
  542.      @ 1,60 SAY "Record " + ALLTRIM(TRANSFORM(RECNO(),"@Z"))
  543.      @ 2,60 SAY "Cust. # " + ALLTRIM(TRANSFORM(Cust_no,"@Z"))
  544.  
  545.      * Move fields to memory vars
  546.      IF RECCOUNT() >= 1
  547.         Fld2mem()    && Empty the field variables
  548.      ELSE
  549.         Mempty()
  550.      ENDIF
  551.  
  552.  
  553.      * Display the current record
  554.      Sayrec()
  555.  
  556.      * Display edit menu and execute choices
  557.      @ 24,0
  558.      @ 24,0 PROMPT "Edit"
  559.      @ 24,9 PROMPT "Next"
  560.      @ 24,17 PROMPT "Previous"
  561.      @ 24,29 PROMPT "Find"
  562.      @ 24,37 PROMPT "Locate"
  563.      @ 24,47 PROMPT "Goto"
  564.      @ 24,55 PROMPT "Del"
  565.      @ 24,62 PROMPT "Exit-<ESC>"
  566.      MENU TO evchoice
  567.  
  568.      IF evchoice = 0 .OR. evchoice = 8
  569.         evexit = .T.
  570.  
  571.      ELSEIF evchoice = 1
  572.         Cus_gets()
  573.         IF LASTKEY() != 27   && <ESC>
  574.            Mem2fld()
  575.         ENDIF
  576.  
  577.  
  578.      ELSEIF evchoice = 2
  579.         SKIP
  580.         IF EOF()
  581.            Beep("NORM")
  582.            User_msg("End of file...")
  583.            SKIP -1
  584.         ENDIF
  585.  
  586.      ELSEIF evchoice = 3
  587.         SKIP -1
  588.         IF BOF()
  589.            Beep("NORM")
  590.            User_msg("Beginning of file...")
  591.         ENDIF
  592.  
  593.      ELSEIF evchoice = 4
  594.         Findrec()
  595.  
  596.      ELSEIF evchoice = 5
  597.         Loc_rec()
  598.  
  599.      ELSEIF evchoice = 6
  600.         Go_rec()
  601.  
  602.      ELSEIF evchoice = 7
  603.         Del_rec()
  604.  
  605.      ENDIF
  606.   END
  607.  
  608.   * End editing/viewing
  609.   ENDDO
  610.   @ 24,0
  611. RETURN(2)
  612.  
  613.  
  614. *****
  615. * Findrec() - Seek a record by its index key
  616. *
  617.  
  618. FUNCTION Findrec
  619.    BEGIN SEQUENCE
  620.    curr_rec = RECNO()
  621.    @ 24,0
  622.    resp = "C"
  623.    @ 24,0 SAY "Find by: Customer <N>o  <C>ompany  <L>ast Name  "+;
  624.               "<Z>ip  <S>tate  <ESC>-Abort";
  625.           GET resp PICTURE "@!" VALID resp $ "NCLZS"
  626.    READ
  627.    * Allow user to <ESC>ape
  628.    IF LASTKEY() = 27
  629.       BREAK
  630.    ENDIF
  631.  
  632.    IF resp = "N"
  633.       SET ORDER TO 2
  634.       sought = 00001
  635.       mprompt = "Customer Number"
  636.    ELSEIF resp = "C"
  637.       SET ORDER TO 1
  638.       sought = SPACE(30)
  639.       mprompt = "Company Name"
  640.    ELSEIF resp = "L"
  641.       SET ORDER TO 3
  642.       sought = SPACE(20)
  643.       mprompt = "Last Name"
  644.    ELSEIF resp = "Z"
  645.       SET ORDER TO 4
  646.       sought = "00000-0000"
  647.       mprompt = "Zip Code"
  648.    ELSEIF resp = "S"
  649.       SET ORDER TO 5
  650.       sought = SPACE(2)
  651.       mprompt = "State"
  652.    ENDIF
  653.    @ 24,0
  654.    @ 24,0 SAY "Enter " + mprompt + ": " GET sought
  655.    READ
  656.    IF TYPE("sought") != "N"
  657.       SEEK TRIM(sought)
  658.    ELSE
  659.       SEEK sought
  660.    ENDIF
  661.  
  662.    IF !FOUND()
  663.       Beep("BOZO")
  664.       Err_msg("Record not found.")
  665.       GO curr_rec
  666.    ENDIF
  667.    END
  668.    @ 24,0
  669. RETURN(.T.)
  670.  
  671. *****
  672. * Loc_rec() - Locate a record using a filter string
  673. *
  674.  
  675. FUNCTION Loc_rec
  676.    curr_rec = RECNO()
  677.    SET KEY -9 TO Shofield()
  678.    SAVE SCREEN TO loc_scrn
  679.    SCROLL(4,0,24,79,0)  && Clear specified portion of the screen
  680.    locstrng = SPACE(100)
  681.    Saycenter(4,"LOCATE BY CRITERIA")
  682.    KEYBOARD CHR(27) && Display the fields box
  683.    Shofield()
  684.    Saycenter(20,"F10: Select Field Name    <ESC>: Abort")
  685.    Saycenter(22,"Enter a Search Criteria "+;
  686.          "(i.e., STATE = 'CA' .AND. COMPANY = 'El Carne Loco')")
  687.    @ 24,0 GET locstrng PICTURE "@S79"
  688.    READ
  689.    IF TYPE(locstrng) != "U" .AND. TYPE(locstrng) != "UE" .AND.;
  690.       TYPE(locstrng) != "UI"
  691.       LOCATE FOR &locstrng
  692.       IF FOUND()
  693.          SCROLL(4,0,24,79,0)
  694.          Cusprompt()
  695.          cont = "Y"
  696.          DO WHILE cont = "Y"
  697.             Fld2mem()
  698.             Sayrec()
  699.             @ 24,0
  700.             @ 24,0 SAY "Continue (Y/N)? " GET cont PICTURE "@!"
  701.             READ
  702.             IF cont = "Y"
  703.                CONTINUE
  704.                IF !FOUND()
  705.                   Beep("NORM")
  706.                   User_msg("No further matches found.")
  707.                   cont = "N"
  708.                ENDIF
  709.             ENDIF
  710.          ENDDO
  711.       ELSE
  712.          Beep("BOZO")
  713.          Err_msg("Record not found.")
  714.       ENDIF
  715.    ELSE
  716.       Beep("BOZO")
  717.       Err_msg("There is an error in the search string.")
  718.    ENDIF
  719.    @ 24,0
  720.    RESTORE SCREEN FROM loc_scrn
  721. RETURN(.T.)
  722.  
  723. *****
  724. * Go_rec() - Go to the top or bottom of file, or a record number 
  725. *
  726.  
  727. FUNCTION Go_rec
  728.    @ 24,0
  729.    resp = " "
  730.    @ 24,0 SAY "<T>op  <B>ottom  <R>ecord number " GET resp PICTURE "@!";
  731.           VALID(resp $ "TBR")
  732.    READ
  733.    IF resp = "T"
  734.       GO TOP
  735.    ELSEIF resp = "B"
  736.       GO BOTTOM
  737.    ELSEIF resp = "R"
  738.       @ 24,0
  739.       resp = RECCOUNT()
  740.       @ 24,0 SAY "Enter Record Number: " GET resp PICTURE "@9";
  741.              VALID(resp >= 0)
  742.       READ
  743.       GO resp
  744.    ENDIF
  745.    @ 24,0
  746. RETURN(.T.)
  747.  
  748. *****
  749. * Del_rec() - Mark a record for deletion or recall it
  750. *
  751.  
  752. FUNCTION Del_rec
  753.    IF DELETED()
  754.       RECALL
  755.    ELSE
  756.       DELETE
  757.    ENDIF
  758. RETURN(.T.)
  759.  
  760. *****
  761. * Shofield() - Display a light bar menu of the database fields
  762. *
  763.  
  764. FUNCTION Shofield
  765.    DECLARE farray[FCOUNT()]
  766.    AFIELDS(farray)
  767.    @ 5,32 TO 19,48
  768.    subscrpt = ACHOICE(6,34,18,46,farray)
  769. RETURN(.T.)
  770.  
  771.  
  772.  
  773. *****
  774. * Cusprompt() - Display prompts for Customer.DBF data entry screen
  775. *
  776.  
  777. FUNCTION Cusprompt
  778.    @ 5,0 SAY "Company Name: "
  779.    @ 5,47 SAY "Phone Number: "
  780.    @ 6,56 SAY "Ext: "
  781.    @ 7,6 SAY "Address: "
  782.    @ 8,13 SAY ": "
  783.    @ 9,9 SAY "City: "
  784.    @ 9,42 SAY "State: "
  785.    @ 9,53 SAY "Zip: "
  786.    Saycenter(12,"Contact Person")
  787.    @ 14,3 SAY "First Name: "
  788.    @ 14,32 SAY "MI: "
  789.    @ 14,39 SAY "Last Name: "
  790.    Saycenter(16,"Contact Notes")
  791.    @ 17,13 TO 20,61
  792.    Saycenter(21,"<F2>: Edit Contact Notes     <ESC>: Abort Edits and Exit")
  793.    Saycenter(22,"Ctrl-W: Finished Editing")
  794. RETURN(.T.)
  795.  
  796. *****
  797. * Mempty() - Initialize field variables with empty value
  798. *
  799.  
  800. FUNCTION Mempty
  801.    IF LEN(ALIAS()) !=0
  802.       FOR i = 1 TO FCOUNT()
  803.          mfield = FIELDNAME(i)
  804.          fieldvar = "m" + mfield
  805.          IF type("&mfield") = "C"
  806.             &fieldvar = SPACE(LEN(&mfield))
  807.          ELSEIF type("&mfield") = "N"
  808.             &fieldvar = 0
  809.          ELSEIF type("&mfield") = "D"
  810.             &fieldvar = CTOD("  /  /  ")
  811.          ELSEIF type("&mfield") = "L"
  812.             &fieldvar = .F.
  813.          ELSEIF type("&mfield") = "M"
  814.             &fieldvar = SPACE(512)
  815.          ENDIF
  816.       NEXT
  817.    ELSE
  818.       BEEP("BOZO")
  819.       Err_msg("No database file is open. ")
  820.       BREAK && Abort Add routine
  821.    ENDIF
  822. RETURN(.T.)
  823.  
  824. *****
  825. * Cus_gets() - GET data for customer data entry screen
  826. *
  827.  
  828. FUNCTION Cus_gets
  829.    SET KEY -1 TO Memedit()    && F2 assigned to edit mNotes
  830.    MEMOEDIT(mNotes,18,14,19,60,.F.,.F.)
  831.    @ 5,15 GET mCompany
  832.    @ 5,61 GET mPhone PICTURE "@R 999-999-9999"
  833.    @ 6,61 GET mExt
  834.    @ 7,15 GET mAddress1
  835.    @ 8,15 GET mAddress2
  836.    @ 9,15 GET mCity
  837.    @ 9,49 GET mState PICTURE "@!" VALID Isstate(mState)
  838.    @ 9,58 GET mZip PICTURE "@R 99999-9999"
  839.    @ 14,15 GET mFirst
  840.    @ 14,36 GET mMi PICTURE "@!"
  841.    @ 14,50 GET mLast
  842.    READ
  843.    SET KEY -1 TO  && F2 unassigned
  844. RETURN(.T.)
  845.  
  846. *****
  847. * Mem2fld() - Replace fields with field memory variables
  848. *
  849.  
  850. FUNCTION Mem2fld
  851.    PRIVATE retval
  852.    retval = 1
  853.    IF LEN(ALIAS()) !=0
  854.       FOR i = 1 TO FCOUNT()
  855.          mfield = FIELDNAME(i)
  856.          fieldvar = "m" + mfield
  857.          REPLACE &mfield WITH &fieldvar
  858.       NEXT
  859.    ELSE
  860.       BEEP("BOZO")
  861.       Err_msg("No database file is open. ")
  862.    ENDIF
  863. RETURN(.T.)
  864.  
  865. *****
  866. * Isstate() - Verifies that the state entered is really a state
  867. * Usage: Isstate("State name")
  868. * Returns: Logical True (.T.) or False (.T.)
  869. * Notes: The States.DBF file is indexed on State and a Seek will
  870. *           find the entered state or it won't.
  871. *
  872.  
  873. FUNCTION Isstate
  874.    PARAMETERS sought
  875.    IF !FILE("States.DBF")
  876.       Beep("BOZO")
  877.       Err_msg("The States.DBF file is missing.")
  878.       retval = .T.
  879.    ELSE
  880.       currarea = SELECT()  && Save the current work area #
  881.       SELECT 0    && Go to next available work area
  882.       USE States
  883.       IF !FILE("St_abbre.NTX")
  884.          INDEX ON St_abbrev to St_abbre
  885.       ELSE
  886.          SET INDEX TO St_abbre
  887.       ENDIF
  888.       SEEK TRIM(sought)
  889.       IF FOUND()
  890.          retval = .T.
  891.       ELSE
  892.          Beep("BOZO")
  893.          Err_msg("This state isn't in the union yet.")
  894.          retval = .F.
  895.       ENDIF
  896.       USE
  897.       SELECT (currarea)    && Return to the original work area
  898.    ENDIF
  899. RETURN(retval)
  900.  
  901. *****
  902. * Memedit() - Edits the Notes field of the Customer.DBF
  903. *
  904.  
  905. FUNCTION Memedit
  906.    mNotes = MEMOEDIT(mNotes,18,14,19,60,.T.)
  907. RETURN(.T.)
  908.  
  909. *****
  910. * Fld2mem() - Assign fields to field memory variables
  911. *
  912.  
  913. FUNCTION Fld2mem
  914.    IF LEN(ALIAS()) !=0
  915.       FOR i = 1 TO FCOUNT()
  916.          mfield = FIELDNAME(i)
  917.          fieldvar = "m" + mfield
  918.          &fieldvar = &mfield
  919.       NEXT
  920.    ELSE
  921.       BEEP("BOZO")
  922.       Err_msg("No database file is open. ")
  923.    ENDIF
  924. RETURN(.T.)
  925.  
  926. *****
  927. * Sayrec() - Display record contents but allow no edit
  928. *
  929.  
  930. FUNCTION Sayrec
  931.    MEMOEDIT(mNotes,18,14,19,60,.F.,.F.)
  932.    @ 5,15 SAY mCompany
  933.    @ 5,61 SAY mPhone PICTURE "@R 999-999-9999"
  934.    @ 6,61 SAY mExt
  935.    @ 7,15 SAY mAddress1
  936.    @ 8,15 SAY mAddress2
  937.    @ 9,15 SAY mCity
  938.    @ 9,49 SAY mState PICTURE "@!" 
  939.    @ 9,58 SAY mZip
  940.    @ 14,15 SAY mFirst
  941.    @ 14,36 SAY mMi PICTURE "@!"
  942.    @ 14,50 SAY mLast
  943. RETURN(.T.)
  944.  
  945. *****
  946. * Incseek() - Incremental seek of records
  947. *
  948.  
  949. FUNCTION Incseek
  950.    PRIVATE curfield,retval,keystroke
  951.    PARAMETERS curfield,keystroke
  952.    old_recnum = recno()
  953.    mstring = mstring + chr(keystroke)
  954.    @ 23,16
  955.    @ 23,16 SAY mstring
  956.    IF UPPER(INDEXKEY(0)) != "CUST_NO"
  957.       SEEK TRIM(mstring)
  958.    ELSE
  959.       SEEK VAL(TRIM(mstring))
  960.    ENDIF
  961.  
  962.    IF !FOUND()
  963.       Beep("BOZO")
  964.       Err_msg("Entry does not exist.")
  965.       GO old_recnum
  966.    ENDIF
  967. RETURN(2)
  968.  
  969. *****
  970. * Decseek() - Decremental seek when <Backspace> is pressed
  971. *
  972.  
  973. FUNCTION Decseek
  974.    mstring = SUBSTR(mstring,1,(LEN(mstring)-1))   
  975.    IF UPPER(INDEXKEY(0)) != "CUST_NO"
  976.       SEEK TRIM(mstring)
  977.    ELSE
  978.       SEEK VAL(TRIM(mstring))
  979.    ENDIF
  980.    @ 23,16   
  981.    @ 23,16 SAY mstring   
  982. RETURN(2)
  983.  
  984.  
  985.  
  986. ********************
  987. * Saycenter() - Function to center a string on a given row.
  988. * Usage: Saycenter(row#,expC)
  989. *
  990.  
  991. FUNCTION Saycenter
  992.    PARAMETERS trow,in_string
  993.    IF LEN(in_string)>=80
  994.       @ trow,0 SAY in_string
  995.    ELSE
  996.       @ trow,(80 - LEN(in_string))/2 SAY in_string
  997.    ENDIF
  998.  
  999. RETURN (.T.)
  1000.  
  1001. *****
  1002. * Not_yet() - Prints option not available message
  1003. *
  1004.  
  1005. FUNCTION Not_yet
  1006.    @ 0,0
  1007.    Beep("NORM")
  1008.    @ 0,0 SAY "This option is not available yet." +;
  1009.              " Press any key to continue."
  1010.    INKEY(0)
  1011.    @ 0,0
  1012. RETURN(.T.)
  1013.  
  1014. *****
  1015. * Beep() - Sounds a tone to get user's attention
  1016. * Usage: Beep("NORM") && Informative information or warning
  1017. *        Beep("BOZO") && Error beep
  1018. *
  1019.  
  1020. FUNCTION Beep
  1021.    PARAMETER beeptype
  1022.    IF beep_on
  1023.       IF UPPER(beeptype) = "BOZO"
  1024.          TONE(87.3,1)
  1025.          TONE(40,3.5)
  1026.       ELSE
  1027.          TONE(261.7,1)
  1028.          TONE(392,3.5)
  1029.       ENDIF
  1030.    ENDIF
  1031. RETURN(.T.)
  1032.  
  1033. *****
  1034. * Err_msg() - Prints an error message or warning on row 0
  1035. * Usage: Err_msg("Error or warning message")
  1036. *
  1037. FUNCTION Err_msg
  1038.    PARAMETER e_msg
  1039.    @ 0,0
  1040.    err_scrn = SAVESCREEN(0,0,1,79)
  1041.    @ 0,0 SAY e_msg + " Press a key to continue."
  1042.    INKEY(0)
  1043.    @ 0,0
  1044.    RESTSCREEN(0,0,1,79,err_scrn)
  1045. RETURN(.T.)
  1046.  
  1047. *****
  1048. * User_msg() - Prints user messages on row 24 and waits for a key press
  1049. * Usage: User_msg("Message string")
  1050. *
  1051.  
  1052. FUNCTION User_msg
  1053.    PARAMETERS msg
  1054.    @ 24,0
  1055.    userscrn = SAVESCREEN(23,0,24,79)
  1056.    @ 24,0 SAY msg + " Press a key to continue."
  1057.    INKEY(0)
  1058.    @ 24,0
  1059.    RESTSCREEN(23,0,24,79,userscrn)
  1060. RETURN(.T.)
  1061.