home *** CD-ROM | disk | FTP | other *** search
/ Source Code 1992 March / Source_Code_CD-ROM_Walnut_Creek_March_1992.iso / msdos / clipper / nannws22.arc / EDIT.PRG < prev    next >
Encoding:
Text File  |  1987-12-08  |  4.5 KB  |  211 lines
  1. **********
  2. * EDIT.prg
  3. * 16th April 1987
  4. * dPowells & fHo
  5. * - this routine somewhat simulates dBASE III's EDIT routine
  6. *
  7. * - will start on current record
  8. * - does not support multi-page FMT files
  9. * - assumes that you are GETting directly into the DBF fields 
  10. *   and for ALL fields - that is, from field 1 to field FCOUNT().
  11. *
  12. * - also demonstrates how to deactivate/activate another SET KEY 
  13. *   within a SET KEY procedure
  14. *
  15. * - syntax: DO edit
  16. *
  17. * - e.g.,
  18. *        CLEAR
  19. *        GOTO 10                  && invoke EDIT on record 10
  20. *        SET FORMAT TO fmt_file
  21. *        DO edit
  22. *        RETURN
  23. *
  24.  
  25.  
  26.  
  27. *-----
  28. * pre-set keys to procedures that simulate actions of
  29. * dBASE's following keys during EDIT mode
  30. *-----
  31. set key 5 to UKEY            && UP key
  32. set key 3 to PDKEY           && PAGE-DOWN key
  33. set key 13 to ENKEY          && ENTER key
  34. set key 18 to PUKEY          && PAGE-UP key
  35. set key 24 to DKEY           && DOWN key
  36.  
  37. set key 31 to INTMODE        && "dummy" key (^-)
  38.  
  39. *-----
  40. * main loop:
  41. * - where editing actually takes place until ESC key
  42. *   is pressed, or when file extremes are encountered
  43. *-----
  44. do while .t.
  45.     read
  46.     if lastkey() = 27        && exit if ESC is pressed
  47.          exit
  48.     endif
  49. enddo
  50.  
  51. *-----
  52. * turn OFF the assigned procedures and
  53. * return keys to native mode
  54. *-----
  55. set key 5 to
  56. set key 3 to
  57. set key 13 to
  58. set key 18 to
  59. set key 24 to
  60.  
  61. set key 31 to
  62.  
  63.  
  64. * close databases
  65. return                       && end of EDIT routine
  66. *
  67. *
  68. **********
  69.  
  70.  
  71. procedure UKEY
  72. *-----
  73. * UP key
  74. *-----
  75. parameters AA,BB,CC     && 3 dummy parameters declared to 
  76.                         ** maintain stack
  77.     if upper(trim(CC)) == upper(trim(fieldname(1)))
  78.     *-----
  79.     * if current GET is same as first field then
  80.     * save this record and go to previous one
  81.     *-----
  82.          keyboard chr(23)         && stuff keyboard with "Ctrl-W"
  83.          skip -1                  && go to previous record
  84.          if bof()                 && if beginning_of_file
  85.               keyboard chr(27)    && stuff keyboard with "Esc"
  86.          endif
  87.     else
  88.     *-----
  89.     * otherwise, disable UP-arrow's pre-assigned procedure,
  90.     * go up - chr(5), then invoke procedure that
  91.     * reassigns procedure
  92.     *-----
  93.          set key 5 to
  94.          keyboard chr(5) + chr(31)
  95.     endif
  96. return
  97.  
  98.  
  99. procedure DKEY
  100. *-----
  101. * DOWN key
  102. *-----
  103. parameters AA,BB,CC
  104.     if upper(trim(CC)) == upper(trim(fieldname(fcount())))
  105.     *-----
  106.     * if current GET is same as last field or 1st field then
  107.     * save this record and go to next one
  108.     *-----
  109.          keyboard chr(23)
  110.          RRR = recno()
  111.          skip
  112.          if eof()
  113.               go RRR
  114.               set key 13 to
  115.               keyboard chr(13) + chr(31) + chr(27)
  116.          endif
  117.     else
  118.     *-----
  119.     * otherwise, turn off assigned procedure,
  120.     * go down - chr(24), then invoke procedure that
  121.     * reassigns procedure
  122.     *-----
  123.          set key 24 to
  124.          keyboard chr(24) + chr(31)
  125.     endif
  126. return
  127.  
  128.  
  129. procedure ENKEY
  130. *-----
  131. * ENTER key
  132. *-----
  133. parameters AA,BB,CC
  134.     if upper(trim(CC)) == upper(trim(fieldname(fcount())))
  135.     *-----
  136.     * if current GET is same as last field or 1st field then
  137.     * save this record and go to next one
  138.     *-----
  139.          keyboard chr(23)
  140.          RRR = recno()
  141.          skip
  142.          if eof()
  143.               go RRR
  144.               set key 13 to
  145.               keyboard chr(13) + chr(31) + chr(27)
  146.          endif
  147.     else
  148.     *-----
  149.     * otherwise, turn off assigned procedure,
  150.     * enter - chr(13), then invoke procedure that
  151.     * reassigns procedure
  152.     *-----
  153.          set key 13 to
  154.          keyboard chr(13) + chr(31)
  155.     endif
  156. return
  157.  
  158.  
  159. procedure PUKEY
  160. *-----
  161. * PAGE-UP key
  162. *-----
  163. parameters AA,BB,CC
  164.     *-----
  165.     * save current record and
  166.     * go to previous one
  167.     *-----
  168.     keyboard chr(23)
  169.     skip -1
  170.     if bof()
  171.          keyboard chr(27)
  172.     endif
  173. return
  174.  
  175.  
  176. procedure PDKEY
  177. *-----
  178. * PAGE-DOWN key
  179. *-----
  180. parameters AA,BB,CC
  181.     *-----
  182.     * save current record and
  183.     * go to next one
  184.     *-----
  185.     keyboard chr(23)
  186.     RRR = recno()
  187.     skip
  188.     if eof()
  189.          go RRR
  190.          set key 13 to
  191.          keyboard chr(13) + chr(31) + chr(27)
  192.     endif
  193. return
  194.  
  195.  
  196. procedure INTMODE
  197. *-----
  198. * CONTROL-MINUS key
  199. * - this procedure reassigns procedures to their
  200. *   respective keys
  201. *   (inter-mode ("dummy-key"))
  202. *-----
  203. parameters AA,BB,CC
  204.     set key 5 to UKEY
  205.     set key 24 to DKEY
  206.     set key 13 to ENKEY
  207. return
  208.  
  209. * eof *
  210. *******
  211.