home *** CD-ROM | disk | FTP | other *** search
/ Programming Languages Suite / ProgramD2.iso / Database / CLIPR502.DOS / SOURCE / DBU / DBUCOPY.PRG < prev    next >
Encoding:
Text File  |  1993-02-15  |  16.9 KB  |  848 lines
  1. /***
  2. *
  3. *  Dbucopy.prg
  4. *
  5. *  DBU Copy and Append Module
  6. *
  7. *  Copyright (c) 1990-1993, Computer Associates International, Inc.
  8. *  All rights reserved.
  9. *
  10. */
  11.  
  12.  
  13. ******
  14. *    capprep
  15. *
  16. *    copy/append/replace
  17. *
  18. *    note: see multibox in DBUUTIL.PRG
  19. ******
  20. PROCEDURE capprep
  21.  
  22. PRIVATE filename, files, fi_disp, okee_dokee, cur_el, rel_row, def_ext, mode,;
  23.         fi_done, for_cond, while_cond, how_many, bcur, for_row, height,;
  24.         field_mvar, with_what
  25.  
  26. IF M->func_sel = 3
  27.     * replace command
  28.     help_code = 22
  29.  
  30.     * select current work area
  31.     SELECT (M->cur_area)
  32.  
  33.     * initialize variables to contain fieldname and replace expression
  34.     field_mvar = ""
  35.     with_what = ""
  36.  
  37.     * get master field list into local array for selection
  38.     DECLARE field_m[FCOUNT()]
  39.     all_fields(M->cur_area, M->field_m)
  40.  
  41.     * set up for multi-box
  42.     DECLARE boxarray[9]
  43.     boxarray[1] = "repl_title(sysparam)"
  44.     boxarray[2] = "repl_field(sysparam)"
  45.     boxarray[3] = "with_exp(sysparam)"
  46.     boxarray[4] = "for_exp(sysparam)"
  47.     boxarray[5] = "while_exp(sysparam)"
  48.     boxarray[6] = "scope_num(sysparam)"
  49.     boxarray[7] = "ok_button(sysparam)"
  50.     boxarray[8] = "can_button(sysparam)"
  51.     boxarray[9] = "fieldlist(sysparam)"
  52.  
  53.     * size and configuration
  54.     bcur = 9            && beginning cursor on field list
  55.     for_row = 6
  56.     height = 10
  57.     okee_dokee = "do_replace()"
  58.     fi_disp = "repl_field(3)"
  59.  
  60. ELSE
  61.     * initialize filename variable
  62.     filename = ""
  63.  
  64.     * only copy and append use a list of text files
  65.     DECLARE txt_list[adir("*.TXT") + 20]        && directory of text files
  66.     array_dir("*.TXT",txt_list)                    && fill array with filenames
  67.  
  68.     * set up for multi-box
  69.     DECLARE boxarray[10]
  70.  
  71.     IF M->func_sel = 1
  72.         * copy command
  73.         help_code = 12
  74.         bcur = 2            && beginning cursor on filename entry field
  75.         boxarray[1] = "copy_title(sysparam)"
  76.         boxarray[2] = "trg_getfil(sysparam)"
  77.         fi_disp = "trg_getfil(3)"
  78.         okee_dokee = "do_copy()"
  79.  
  80.     ELSE
  81.         * append command
  82.         help_code = 15
  83.         bcur = 10            && beginning cursor on selection list
  84.         boxarray[1] = "appe_title(sysparam)"
  85.         boxarray[2] = "src_getfil(sysparam)"
  86.         fi_disp = "src_getfil(3)"
  87.         okee_dokee = "do_append()"
  88.  
  89.     ENDIF
  90.  
  91.     * remainder of setup common to copy and append
  92.     boxarray[3] = "for_exp(sysparam)"
  93.     boxarray[4] = "while_exp(sysparam)"
  94.     boxarray[5] = "scope_num(sysparam)"
  95.     boxarray[6] = "tog_sdf(sysparam)"
  96.     boxarray[7] = "ok_button(sysparam)"
  97.     boxarray[8] = "tog_delim(sysparam)"
  98.     boxarray[9] = "can_button(sysparam)"
  99.     boxarray[10] = "filelist(sysparam)"
  100.  
  101.     * size and configuration
  102.     for_row = 5
  103.     height = 11
  104.  
  105.     * DBF for normal mode
  106.     files = "dbf_list"
  107.     def_ext = ".DBF"
  108.  
  109.     * when is a filename acceptable?
  110.     fi_done = "not_empty('filename')"
  111.  
  112. ENDIF
  113.  
  114. * initialize local variables
  115. STORE "" TO for_cond, while_cond
  116.  
  117. * normal mode, scope = ALL, top of selection list
  118. STORE 1 TO mode,cur_el
  119. rel_row = 0
  120. how_many = 0
  121.  
  122. * do it with the all-purpose switchbox
  123. multibox(8, 17, M->height, M->bcur, M->boxarray)
  124. RETURN
  125.  
  126.  
  127. ******************************
  128. * functions specific to COPY *
  129. ******************************
  130.  
  131. ******
  132. *    copy_title()
  133. *
  134. *    display title for "copy"
  135. ******
  136. FUNCTION copy_title
  137.  
  138. PARAMETERS sysparam
  139.  
  140. RETURN box_title(M->sysparam, "Copy " +;
  141.                               SUBSTR(M->cur_dbf, RAT("\", M->cur_dbf) + 1) +;
  142.                               " to...")
  143.  
  144.  
  145. ******
  146. *    trg_getfil()
  147. *
  148. *    get target filename for "copy"
  149. ******
  150. FUNCTION trg_getfil
  151.  
  152. PARAMETERS sysparam
  153.  
  154. help_code = M->prime_help
  155. RETURN getfile(M->sysparam, 3)
  156.  
  157.  
  158. ******
  159. *    do_copy()
  160. *
  161. *    do the copy command
  162. *
  163. *    note: this function is called when <enter> is pressed
  164. *          while the cursor is on the "Ok" button
  165. ******
  166. FUNCTION do_copy
  167.  
  168. PRIVATE done, add_name, new_el
  169.  
  170. * assume incomplete
  171. done = .F.
  172.  
  173. DO CASE
  174.  
  175.     CASE EMPTY(M->filename)
  176.         error_msg("Target not selected")
  177.  
  178.     CASE M->filename == M->cur_dbf
  179.         error_msg("File cannot be coppied onto itself")
  180.  
  181.     CASE .NOT. EMPTY(M->for_cond) .AND. TYPE(M->for_cond) <> "L"
  182.         error_msg("FOR condition must be a Logical expression")
  183.  
  184.     CASE .NOT. EMPTY(M->while_cond) .AND. TYPE(M->while_cond) <> "L"
  185.         error_msg("WHILE condition must be a Logical expression")
  186.  
  187.     OTHERWISE
  188.         * ok to copy file
  189.  
  190.         IF FILE(M->filename)
  191.  
  192.             IF rsvp("Target File " + IF(aseek(M->dbf, M->filename) > 0,;
  193.                     "Is Open", "Exists") + "...Overwrite? (Y/N)") <> "Y"
  194.                 RETURN .F.
  195.  
  196.             ENDIF
  197.         ENDIF
  198.  
  199.         stat_msg("Copying")
  200.  
  201.         IF aseek(M->dbf, M->filename) > 0
  202.             * copying to an open file...good luck!
  203.             SELECT (aseek(M->dbf, M->filename))
  204.             USE
  205.             STORE .T. TO need_field,need_ntx,need_relat,need_filtr
  206.  
  207.         ENDIF
  208.  
  209.         SELECT (M->cur_area)
  210.  
  211.         IF RAT(M->def_ext, M->filename) = LEN(M->filename) - 3
  212.             * target has default extension..does it exists in current dir?
  213.             add_name = .NOT. FILE(name(M->filename) + M->def_ext)
  214.  
  215.         ELSE
  216.             add_name = .F.
  217.  
  218.         ENDIF
  219.  
  220.         IF EMPTY(M->for_cond)
  221.             * literal true is the same as no FOR condition
  222.             for_cond = ".T."
  223.  
  224.         ENDIF
  225.  
  226.         IF EMPTY(M->while_cond)
  227.             * literal true is correct only from top of file
  228.             while_cond = ".T."
  229.  
  230.             IF M->how_many = 0
  231.                 * unless a scope has been entered
  232.                 GO TOP
  233.  
  234.             ENDIF
  235.         ENDIF
  236.  
  237.         DO CASE
  238.  
  239.             CASE M->mode = 1 .AND. M->how_many = 0
  240.                 COPY TO &filename WHILE &while_cond FOR &for_cond
  241.  
  242.             CASE M->mode = 1 .AND. M->how_many > 0
  243.                 COPY TO &filename NEXT M->how_many WHILE &while_cond;
  244.                         FOR &for_cond
  245.  
  246.             CASE M->mode = 2 .AND. M->how_many = 0
  247.                 COPY TO &filename WHILE &while_cond FOR &for_cond;
  248.                         SDF
  249.  
  250.             CASE M->mode = 2 .AND. M->how_many > 0
  251.                 COPY TO &filename NEXT M->how_many WHILE &while_cond;
  252.                         FOR &for_cond SDF
  253.  
  254.             CASE M->mode = 3 .AND. M->how_many = 0
  255.                 COPY TO &filename WHILE &while_cond FOR &for_cond;
  256.                         DELIMITED
  257.  
  258.             CASE M->mode = 3 .AND. M->how_many > 0
  259.                 COPY TO &filename NEXT M->how_many WHILE &while_cond;
  260.                         FOR &for_cond DELIMITED
  261.  
  262.         ENDCASE
  263.  
  264.         IF aseek(M->dbf, M->filename) > 0
  265.             * copying to an open file...good luck again!
  266.             SELECT (aseek(M->dbf, M->filename))
  267.             USE &filename
  268.  
  269.         ENDIF
  270.  
  271.         IF FILE(name(M->filename) + M->def_ext) .AND. M->add_name
  272.             * add only .dbf files in the current directory
  273.             new_el = afull(&files) + 1
  274.  
  275.             IF M->new_el <= LEN(&files)
  276.                 &files[M->new_el] = M->filename
  277.                 array_sort(&files)
  278.  
  279.             ENDIF
  280.         ENDIF
  281.  
  282.         stat_msg("File copied")
  283.         done = .T.
  284.  
  285. ENDCASE
  286.  
  287. RETURN M->done
  288.  
  289.  
  290. ********************************
  291. * functions specific to APPEND *
  292. ********************************
  293.  
  294. ******
  295. *    appe_title()
  296. *
  297. *    display title for "append"
  298. ******
  299. FUNCTION appe_title
  300.  
  301. PARAMETERS sysparam
  302.  
  303. RETURN box_title(M->sysparam, "Append to " +;
  304.                               SUBSTR(M->cur_dbf, RAT("\", M->cur_dbf) + 1) +;
  305.                               " from")
  306.  
  307.  
  308. ******
  309. *    src_getfil()
  310. *
  311. *    get source filename for "append"
  312. ******
  313. FUNCTION src_getfil
  314.  
  315. PARAMETERS sysparam
  316.  
  317. help_code = M->prime_help
  318. RETURN getfile(M->sysparam, 3)
  319.  
  320.  
  321. ******
  322. *    do_append()
  323. *
  324. *    do the append command
  325. *
  326. *    note: this function is called when <enter> is pressed
  327. *          while the cursor is on the "Ok" button
  328. ******
  329. FUNCTION do_append
  330.  
  331. PRIVATE done
  332.  
  333. * assume incomplete
  334. done = .F.
  335.  
  336. DO CASE
  337.  
  338.     CASE EMPTY(M->filename)
  339.         error_msg("Source not selected")
  340.  
  341.     CASE M->filename == M->cur_dbf
  342.         error_msg("File cannot be appended from itself")
  343.  
  344.     CASE .NOT. FILE(M->filename)
  345.         error_msg("Can't open " + M->filename)
  346.  
  347.     CASE .NOT. EMPTY(M->for_cond) .AND. TYPE(M->for_cond) <> "L"
  348.         error_msg("FOR condition must be a Logical expression")
  349.  
  350.     CASE .NOT. EMPTY(M->while_cond) .AND. TYPE(M->while_cond) <> "L"
  351.         error_msg("WHILE condition must be a Logical expression")
  352.  
  353.     OTHERWISE
  354.         * ok to append
  355.  
  356.         IF aseek(M->dbf, M->filename) > 0
  357.             * appending from an open file
  358.             SELECT (aseek(M->dbf, M->filename))
  359.             USE
  360.             STORE .T. TO need_field,need_ntx,need_relat,need_filtr
  361.  
  362.         ENDIF
  363.  
  364.         stat_msg("Appending")
  365.         SELECT (M->cur_area)
  366.  
  367.         IF EMPTY(M->for_cond)
  368.             * literal true is the same as no FOR condition
  369.             for_cond = ".T."
  370.  
  371.         ENDIF
  372.  
  373.         IF EMPTY(M->while_cond)
  374.             * literal true is the same as no WHILE condition
  375.             while_cond = ".T."
  376.  
  377.         ENDIF
  378.  
  379.         DO CASE
  380.  
  381.             CASE M->mode = 1 .AND. M->how_many = 0
  382.                 APPEND FROM &filename WHILE &while_cond FOR;
  383.                             &for_cond
  384.  
  385.             CASE M->mode = 1 .AND. M->how_many > 0
  386.                 APPEND FROM &filename NEXT M->how_many WHILE;
  387.                             &while_cond FOR &for_cond
  388.  
  389.             CASE M->mode = 2 .AND. M->how_many = 0
  390.                 APPEND FROM &filename WHILE &while_cond FOR;
  391.                             &for_cond SDF
  392.  
  393.             CASE M->mode = 2 .AND. M->how_many > 0
  394.                 APPEND FROM &filename NEXT M->how_many WHILE;
  395.                             &while_cond FOR &for_cond SDF
  396.  
  397.             CASE M->mode = 3 .AND. M->how_many = 0
  398.                 APPEND FROM &filename WHILE &while_cond FOR;
  399.                             &for_cond DELIMITED
  400.  
  401.             CASE M->mode = 3 .AND. M->how_many > 0
  402.                 APPEND FROM &filename NEXT M->how_many WHILE;
  403.                             &while_cond FOR &for_cond DELIMITED
  404.  
  405.         ENDCASE
  406.  
  407.         IF aseek(M->dbf, M->filename) > 0
  408.             * appending from an open file
  409.             SELECT (aseek(M->dbf, M->filename))
  410.             USE &filename
  411.  
  412.         ENDIF
  413.  
  414.         stat_msg("Append completed")
  415.         done = .T.
  416.  
  417. ENDCASE
  418.  
  419. RETURN M->done
  420.  
  421.  
  422. *********************************
  423. * functions specific to REPLACE *
  424. *********************************
  425.  
  426. ******
  427. *    repl_title()
  428. *
  429. *    display title for "replace"
  430. ******
  431. FUNCTION repl_title
  432.  
  433. PARAMETERS sysparam
  434.  
  435. RETURN box_title(M->sysparam, "Replace in " +;
  436.                               SUBSTR(M->cur_dbf, RAT("\", M->cur_dbf) + 1) +;
  437.                               "...")
  438.  
  439.  
  440. ******
  441. *    repl_field()
  442. *
  443. *    get fieldname for replace (only one field can be replaced at a time)
  444. ******
  445. FUNCTION repl_field
  446.  
  447. PARAMETERS sysparam
  448.  
  449. help_code = M->prime_help
  450. RETURN genfield(M->sysparam, .T.)
  451.  
  452.  
  453. ******
  454. *    with_exp()
  455. *
  456. *    get "with" expression for replace
  457. ******
  458. FUNCTION with_exp
  459.  
  460. PARAMETERS sysparam
  461. PRIVATE rval
  462.  
  463. help_code = M->prime_help
  464. rval = get_exp(M->sysparam, "WITH   ", 4, "with_what")
  465.  
  466. IF M->sysparam = 4 .AND. LASTKEY() = 13 .AND. .NOT. EMPTY(M->with_what)
  467.     * expression just entered..dehilite and jump to 'Ok'
  468.     get_exp(3, "WITH   ", 4, "with_what")
  469.     to_ok()
  470.  
  471. ENDIF
  472.  
  473. RETURN M->rval
  474.  
  475.  
  476. ******
  477. *    do_replace()
  478. *
  479. *    do the replace command
  480. *
  481. *    note: this function is called when <enter> is pressed
  482. *          while the cursor is on the "Ok" button
  483. ******
  484. FUNCTION do_replace
  485.  
  486. PRIVATE done
  487.  
  488. * assume incomplete
  489. done = .F.
  490.  
  491. DO CASE
  492.  
  493.     CASE EMPTY(M->field_mvar)
  494.         error_msg("Field not selected")
  495.  
  496.     CASE EMPTY(M->with_what)
  497.         error_msg("Replace expression not entered")
  498.  
  499.     CASE TYPE(M->with_what) <> TYPE(M->field_mvar) .and. ;
  500.         !(TYPE(M->field_mvar) == "M") .and. ;
  501.         !(TYPE(M->with_what) == "UI")
  502.         error_msg("Type mismatch between replace expression and field")
  503.  
  504.     CASE .NOT. EMPTY(M->for_cond) .AND. TYPE(M->for_cond) <> "L"
  505.         error_msg("FOR condition must be a Logical expression")
  506.  
  507.     CASE .NOT. EMPTY(M->while_cond) .AND. TYPE(M->while_cond) <> "L"
  508.         error_msg("WHILE condition must be a Logical expression")
  509.  
  510.     OTHERWISE
  511.         * ok to replace
  512.         stat_msg("Replacing data")
  513.  
  514.         IF EMPTY(M->for_cond)
  515.             * literal true is the same as no FOR condition
  516.             for_cond = ".T."
  517.  
  518.         ENDIF
  519.  
  520.         IF EMPTY(M->while_cond)
  521.             * literal true is the same as no WHILE condition
  522.             while_cond = ".T."
  523.  
  524.             IF M->how_many = 0
  525.                 * unless a scope has been entered
  526.                 GO TOP
  527.  
  528.             ENDIF
  529.         ENDIF
  530.  
  531.         IF M->how_many = 0
  532.             REPLACE &field_mvar WITH &with_what;
  533.                     WHILE &while_cond FOR &for_cond
  534.  
  535.         ELSE
  536.             REPLACE NEXT M->how_many &field_mvar WITH &with_what;
  537.                     WHILE &while_cond FOR &for_cond
  538.  
  539.         ENDIF
  540.  
  541.         stat_msg("Replace completed")
  542.         done = .T.
  543.  
  544. ENDCASE
  545.  
  546. RETURN M->done
  547.  
  548.  
  549. *************************************************
  550. * functions common to COPY, APPEND, and REPLACE *
  551. *************************************************
  552.  
  553. ******
  554. *    for_exp()
  555. *
  556. *    get "for" expression
  557. ******
  558. FUNCTION for_exp
  559.  
  560. PARAMETERS sysparam
  561.  
  562. help_code = 16
  563. RETURN get_exp(M->sysparam, "FOR    ", M->for_row, "for_cond")
  564.  
  565.  
  566. ******
  567. *    while_exp()
  568. *
  569. *    get "while" expression
  570. ******
  571. FUNCTION while_exp
  572.  
  573. PARAMETERS sysparam
  574.  
  575. help_code = 16
  576. RETURN get_exp(M->sysparam, "WHILE  ", M->for_row + 1, "while_cond")
  577.  
  578.  
  579. ******
  580. *    scope_num()
  581. *
  582. *    get scope
  583. ******
  584. FUNCTION scope_num
  585.  
  586. PARAMETERS sysparam
  587. local saveColor
  588. PRIVATE old_scope
  589.  
  590. help_code = 17
  591. saveColor := SetColor(M->colorNorm)
  592.  
  593. DO CASE
  594.  
  595.     CASE M->sysparam = 1 .OR. M->sysparam = 3
  596.         * normal display
  597.         @ M->wt + M->for_row + 2, M->wl + 2;
  598.         SAY "SCOPE  " + pad(IF(M->how_many = 0, "ALL",;
  599.                             "NEXT " + LTRIM(STR(M->how_many))), 20)
  600.  
  601.         IF M->sysparam = 1
  602.             * report position
  603.             @ M->wt + M->for_row + 2, M->wl + 9 SAY ""
  604.  
  605.         ENDIF
  606.  
  607.     CASE M->sysparam = 2
  608.         * hi-lite
  609.         SetColor(M->colorHilite)
  610.         @ M->wt + M->for_row + 2, M->wl + 9;
  611.         SAY pad(IF(M->how_many = 0,;
  612.                    "ALL", "NEXT " + LTRIM(STR(M->how_many))), 20)
  613.  
  614.     CASE M->sysparam = 4
  615.         * selected
  616.  
  617.         IF CHR(M->keystroke) $ "0123456789" + CHR(13)
  618.             * numeric digit or <enter>
  619.  
  620.             IF M->keystroke <> 13
  621.                 * include initial digit in entry
  622.                 KEYBOARD CHR(M->keystroke)
  623.  
  624.             ENDIF
  625.  
  626.             old_scope = M->how_many        && in case of abort
  627.  
  628.             * set certain keys to exit the READ
  629.             SET KEY 5 TO clear_gets
  630.             SET KEY 24 TO clear_gets
  631.             xkey_clear()
  632.  
  633.             * image is important
  634.             SetColor(M->colorHilite)
  635.             @ M->wt + M->for_row + 2, M->wl + 9 SAY pad("NEXT",20)
  636.  
  637.             SetColor(M->colorNorm)
  638.             @ M->wt + M->for_row + 2, M->wl + 14;
  639.             GET M->how_many PICTURE "99999999"
  640.  
  641.             SET CURSOR ON
  642.             READ
  643.             SET CURSOR OFF
  644.  
  645.             * remember the exit key
  646.             keystroke = LASTKEY()
  647.  
  648.             * restore keys to normal
  649.             SET KEY 5 TO
  650.             SET KEY 24 TO
  651.             xkey_norm()
  652.  
  653.             IF M->keystroke = 13
  654.                 * jump to "Ok" button
  655.                 to_ok()
  656.                 @ M->wt + M->for_row + 2, M->wl + 9;
  657.                 SAY pad(IF(M->how_many = 0, "ALL", "NEXT " +;
  658.                         LTRIM(STR(M->how_many))), 20)
  659.  
  660.             ELSE
  661.  
  662.                 IF menu_key() <> 0
  663.                     * menu request
  664.                     how_many = M->old_scope
  665.  
  666.                 ENDIF
  667.  
  668.                 IF M->keystroke <> 27 .AND. .NOT. isdata(M->keystroke)
  669.                     * forward the request
  670.                     KEYBOARD CHR(M->keystroke)
  671.  
  672.                 ENDIF
  673.             ENDIF
  674.  
  675.         ELSE
  676.             * character key..scope = 0 = ALL
  677.             how_many = 0
  678.  
  679.         ENDIF
  680. ENDCASE
  681.  
  682. SetColor(saveColor)
  683. RETURN 2
  684.  
  685.  
  686. ***************************************
  687. * functions common to COPY and APPEND *
  688. ***************************************
  689.  
  690. ******
  691. *    tog_sdf()
  692. *
  693. *    toggle sdf mode
  694. ******
  695. FUNCTION tog_sdf
  696.  
  697. PARAMETERS sysparam
  698. local saveColor
  699.  
  700. help_code = 11
  701. saveColor := SetColor(M->colorNorm)
  702.  
  703. DO CASE
  704.  
  705.     CASE M->sysparam = 1 .OR. M->sysparam = 3
  706.         * normal display
  707.         @ M->wt + 9, M->wl + 8 SAY " SDF "
  708.  
  709.         IF M->mode = 2
  710.             * SDF is current mode
  711.             @ M->wt + 8, M->wl + 7, M->wt + 10, M->wl + 13 BOX sframe
  712.  
  713.         ENDIF
  714.  
  715.         IF M->sysparam = 1
  716.             * report position
  717.             @ M->wt + 9, M->wl + 9 SAY ""
  718.  
  719.         ENDIF
  720.  
  721.     CASE M->sysparam = 2
  722.         * hi-lite
  723.         SetColor(M->colorHilite)
  724.         @ M->wt + 9, M->wl + 8 SAY " SDF "
  725.  
  726.     CASE M->sysparam = 4 .AND. M->keystroke = 13
  727.         * selected..no character keys accepted here
  728.  
  729.         IF M->mode = 2
  730.             * SDF...toggle off
  731.             @ M->wt + 8, M->wl + 7, M->wt + 10, M->wl + 13 BOX "        "
  732.             mode = 1
  733.  
  734.             * change from .TXT to .DBF
  735.             cur_el = 1
  736.             rel_row = 0
  737.             files = "dbf_list"
  738.             def_ext = ".DBF"
  739.             filelist(1)            && display new list
  740.  
  741.         ELSE
  742.             * toggle SDF on
  743.  
  744.             IF M->mode = 3
  745.                 * toggle DELIMITED off
  746.                 @ M->wt + 8, M->wl + 16, M->wt + 10, M->wl + 28 BOX "        "
  747.  
  748.             ELSE
  749.                 * normal mode..change from .DBF to .TXT
  750.                 cur_el = 1
  751.                 rel_row = 0
  752.                 files = "txt_list"
  753.                 def_ext = ".TXT"
  754.                 filelist(1)        && display new list
  755.  
  756.             ENDIF
  757.  
  758.             * indicate SDF on
  759.             @ M->wt + 8, M->wl + 7, M->wt + 10, M->wl + 13 BOX sframe
  760.             mode = 2
  761.  
  762.         ENDIF
  763. ENDCASE
  764.  
  765. SetColor(saveColor)
  766. RETURN 2
  767.  
  768.  
  769. ******
  770. *    tog_delim
  771. *
  772. *    toggle delimited mode
  773. ******
  774. FUNCTION tog_delim
  775.  
  776. PARAMETERS sysparam
  777. local saveColor
  778.  
  779. help_code = 11
  780. saveColor := SetColor(M->colorNorm)
  781. DO CASE
  782.  
  783.     CASE M->sysparam = 1 .OR. M->sysparam = 3
  784.         * normal display
  785.         @ M->wt + 9, M->wl + 17 SAY " DELIMITED "
  786.  
  787.         IF M->mode = 3
  788.             * DELIMITED is current mode
  789.             @ M->wt + 8, M->wl + 16, M->wt + 10, M->wl + 28 BOX sframe
  790.  
  791.         ENDIF
  792.  
  793.         IF M->sysparam = 1
  794.             * report position
  795.             @ M->wt + 9, M->wl + 17 SAY ""
  796.  
  797.         ENDIF
  798.  
  799.     CASE M->sysparam = 2
  800.         * hi-lite
  801.         SetColor(M->colorHilite)
  802.         @ M->wt + 9, M->wl + 17 SAY " DELIMITED "
  803.  
  804.     CASE M->sysparam = 4 .AND. M->keystroke = 13
  805.         * selected..no character keys accepted here
  806.  
  807.         IF M->mode = 3
  808.             * DELIMITED...toggle off
  809.             @ M->wt + 8, M->wl + 16, M->wt + 10, M->wl + 28 BOX "        "
  810.             mode = 1
  811.  
  812.             * change from .TXT to .DBF
  813.             cur_el = 1
  814.             rel_row = 0
  815.             files = "dbf_list"
  816.             def_ext = ".DBF"
  817.             filelist(1)            && display new list
  818.  
  819.         ELSE
  820.             * toggle DELIMITED on
  821.  
  822.             IF M->mode = 2
  823.                 * toggle SDF off
  824.                 @ M->wt + 8, M->wl + 7, M->wt + 10, M->wl + 13 BOX "        "
  825.  
  826.             ELSE
  827.                 * normal mode..change from .DBF to .TXT
  828.                 cur_el = 1
  829.                 rel_row = 0
  830.                 files = "txt_list"
  831.                 def_ext = ".TXT"
  832.                 filelist(1)        && display new list
  833.  
  834.             ENDIF
  835.  
  836.             * indicate DELIMITED on
  837.             @ M->wt + 8, M->wl + 16, M->wt + 10, M->wl + 28 BOX sframe
  838.             mode = 3
  839.  
  840.         ENDIF
  841. ENDCASE
  842.  
  843. SetColor(saveColor)
  844. RETURN 2
  845.  
  846.  
  847. * EOF DBUCOPY.PRG
  848.