home *** CD-ROM | disk | FTP | other *** search
/ C!T ROM 2 / ctrom_ii_b.zip / ctrom_ii_b / PROGRAM / CLIPPER / SCRNUZ / BROWZE.PRG < prev    next >
Text File  |  1990-12-04  |  10KB  |  385 lines
  1. * Program Name: browze.prg 
  2. * Author: Ed Phillips 
  3. * Copyright (c) 1990 by EDON Corporation 
  4. *-----------------------------------------------------------------------------
  5. * Created: 4/10/1990 at 15:07
  6. * main = 
  7. * Called From:
  8. * --- Data Base Files ---   ----- Index Files -----   ----- Other Files ---- 
  9. *
  10. *
  11. *
  12. *.............................................................................
  13. * Revision: 1.0 Last Revised: 4/10/1990 at 15:07
  14. * Description: Browse of a database which may be indexed, filtered, or have
  15. *              set deleted on.
  16. * Description: Original Creation.
  17. *.............................................................................
  18. *---------------------------- ALL RIGHTS RESERVED ----------------------------
  19.  
  20. FUNCTION Browze_dbf
  21.    PARAMETERS expr, t, l, b, r, mode, bzbox
  22.  
  23.    IF Type('bzbox') = 'U'
  24.       bzbox = .t.
  25.    ENDIF                                         && IF Type('bzbox') = 'U'
  26.  
  27.    IF Type('mode') = 'U'
  28.       mode = 'SEL'
  29.    ENDIF
  30.  
  31.    PRIVATE num_disp_rows, floor, ceiling, key, highlight, width, up, bz_rec
  32.    PRIVATE prom1, cur_disp_rows, srch, first, last, current, oldcolor, disp_name
  33. *   PRIVATE bhelp_msg
  34.  
  35.    disp_name = 'BROWZE_DBF'
  36.    oldcolor = Setcolor()
  37.    up = .f.
  38.    current = Recno()
  39.    GO BOTTOM
  40.    last = Recno()
  41.  
  42.    GO TOP
  43.    first = Recno()
  44.    GO current
  45.    floor = current
  46.  
  47.    IF Eof()
  48.       GO TOP
  49.       floor = first
  50.    ENDIF
  51.  
  52.    IF Eof()
  53.       Sayerr('File is Empty')
  54.       RETURN (0)
  55.    ENDIF
  56.  
  57.    SET CURSOR OFF
  58.  
  59.    IF bzbox
  60.       @ t, l TO b, r
  61.    ENDIF                                         && IF bzbox
  62.  
  63.    num_disp_rows = b - t - 1
  64.    width = r - l - 1
  65.    highlight = 1
  66.    cur_disp_rows = Fill_box(expr, t, l, b, r, floor)
  67.  
  68.    SKIP cur_disp_rows - 1
  69.    ceiling = Recno()
  70.    SKIP -(cur_disp_rows - 1)
  71.  
  72.    IF floor != first
  73.       Setcolor(c_error)
  74.       @ t, l SAY Chr(24)
  75.       Setcolor(oldcolor)
  76.    ENDIF
  77.  
  78.    IF ceiling != last
  79.       Setcolor(c_error)
  80.       @ b, l SAY Chr(25)
  81.       Setcolor(oldcolor)
  82.    ENDIF
  83.  
  84.    Bhlight()                                     && highlight active element
  85.  
  86.    IF Type('bhelp_msg') = 'U'
  87.       IF Type('bz_find') != 'U'
  88.          bhelp_msg = Chr(24)+Chr(25)+'<PgUp><PgDn>, <Enter> to select, <F2> to jump, <Esc> when done'
  89.       ELSE
  90.          bhelp_msg = Chr(24)+Chr(25)+'<PgUp><PgDn>, <Enter> to select, <Esc> when done'
  91.       ENDIF                                         && IF Type('bz_find') != 'U'
  92.    ENDIF                                         && IF Type('bhelp_msg') = 'U'
  93.  
  94.    Sayhelp(bhelp_msg)
  95.    key = Inkey(0)
  96.    DO WHILE key != esc
  97.  
  98.       *-------------------------------------
  99.       * Remove highlight from active element
  100.       *-------------------------------------
  101.       SKIP highlight - 1
  102.       @ t + highlight, l + 1 SAY Gaspad(&expr, width)
  103.       SKIP -(highlight - 1)
  104.       
  105.       DO CASE
  106.          CASE key = enter
  107.  
  108.             IF mode = 'SEL'
  109.                SKIP highlight - 1
  110.                recno = Recno()
  111.                SKIP -(highlight - 1)
  112.                GO recno
  113.                EXIT
  114.             ELSEIF mode = 'MARK'
  115.                SKIP highlight - 1
  116.                IF Rec_lock(5)
  117.                   IF ! Empty(Marked)
  118.                      REPL Marked WITH ' '
  119.                   ELSE
  120.                      REPL Marked WITH Chr(251)
  121.                   ENDIF
  122.                   UNLOCK
  123.                ELSE
  124.                   Alert()
  125.                ENDIF                             && IF Rec_lock(5)
  126.                SKIP -(highlight - 1)
  127.                IF up
  128.                   KEYBOARD Chr(uparrow)
  129.                ELSE
  130.                   KEYBOARD Chr(dnarrow)
  131.                ENDIF
  132.  
  133.             ELSE
  134.                SKIP highlight - 1
  135.                DO &gen_get
  136.                SKIP -(highlight - 1)
  137.                IF up
  138.                   KEYBOARD Chr(uparrow)
  139.                ELSE
  140.                   KEYBOARD Chr(dnarrow)
  141.                ENDIF
  142.  
  143.             ENDIF
  144.          CASE key = f2
  145.             IF Type('bz_find') != 'U'
  146.                SET CURSOR ON
  147.                oldcolor = Setcolor(c_field)
  148.                @ 24,0 CLEAR
  149.                bz_rec = Recno()
  150.                DO &bz_find
  151.                Setcolor(oldcolor)
  152.                IF bz_rec != Recno()
  153.                   IF Eof()
  154.                      GO BOTTOM
  155.                   ENDIF                          && IF Eof()
  156.  
  157.                   highlight = 1
  158.                   floor = Recno()
  159.                   cur_disp_rows = fill_box(expr, t, l, b, r, floor)
  160.  
  161.                   SKIP cur_disp_rows - 1
  162.                   ceiling = Recno()
  163.                   SKIP -(cur_disp_rows - 1)
  164.                ENDIF                             && IF bz_rec != Recno()
  165.  
  166.                SET CURSOR OFF
  167.                Sayhelp(bhelp_msg)
  168.             ENDIF
  169.          CASE key = uparrow
  170.             up = .t.
  171.             IF highlight > 1
  172.                highlight = highlight - 1
  173.             ELSE
  174.                IF floor != first
  175.                   SKIP -1
  176.                   floor = Recno()
  177.  
  178.                   Scroll(t + 1, l + 1, b - 1, r - 1, -1)
  179.  
  180.                   IF cur_disp_rows < num_disp_rows
  181.                      cur_disp_rows = cur_disp_rows + 1
  182.                   ENDIF
  183.  
  184.                   SKIP cur_disp_rows - 1
  185.                   ceiling = Recno()
  186.                   SKIP -(cur_disp_rows - 1)
  187.                ENDIF
  188.             ENDIF
  189.  
  190.          CASE key = dnarrow
  191.             Bdnarrow()
  192.          CASE key = pgup
  193.             IF floor <> first
  194. *            IF floor > first
  195.                SKIP -num_disp_rows
  196.                floor = Recno()
  197.  
  198.                cur_disp_rows = fill_box(expr, t, l, b, r, floor)
  199.  
  200.                SKIP cur_disp_rows - 1
  201.                ceiling = Recno()
  202.                SKIP -(cur_disp_rows - 1)
  203.             ENDIF
  204.  
  205.          CASE key = pgdn
  206.             IF ceiling != last
  207.                SKIP num_disp_rows
  208.                floor = Recno()
  209.  
  210.                cur_disp_rows = fill_box(expr, t, l, b, r, floor)
  211.  
  212.                SKIP cur_disp_rows - 1
  213.                ceiling = Recno()
  214.                SKIP -(cur_disp_rows - 1)
  215.             ENDIF
  216.  
  217.          CASE key = home
  218.             highlight = 1
  219.  
  220.          CASE key = end_key
  221.             highlight = cur_disp_rows
  222.  
  223.          CASE key = ctrl_home
  224.             highlight = 1
  225.             GO TOP
  226.             floor = Recno()
  227.  
  228.             cur_disp_rows = fill_box(expr, t, l, b, r, floor)
  229.  
  230.             SKIP cur_disp_rows - 1
  231.             ceiling = Recno()
  232.             SKIP -(cur_disp_rows - 1)
  233.  
  234.          CASE key = ctrl_end
  235.             IF ceiling = last
  236.                highlight = cur_disp_rows
  237.             ELSE
  238.                GO BOTTOM
  239.                SKIP -(num_disp_rows - 1)
  240.                floor = Recno()
  241.  
  242.                cur_disp_rows = fill_box(expr, t, l, b, r, floor)
  243.  
  244.                ceiling = last
  245.                highlight = cur_disp_rows
  246.             ENDIF
  247.          CASE Isalpha(Chr(key)) .OR. Isdigit(Chr(key))
  248.             IF Type('bz_1key') = 'L' .AND. Type('ikey') != 'U' .AND. Type('bz_seek') != 'U'
  249.                btemp = Indexkey(ikey)
  250.  
  251.                highlight = highlight + 1
  252.                brec = Recno()
  253.                SKIP highlight - 1
  254.                IF Upper(Chr(key)) = Subs(&btemp.,1,1)  && treat like DnArrow
  255.                   highlight = highlight - 1
  256.                   GO brec
  257.  
  258.                   Bdnarrow()
  259.                ELSE                              && treat like first time in
  260.                   DO &bz_seek
  261.                   current = Recno()
  262.                   floor = current
  263.                   highlight = 1
  264.                   cur_disp_rows = Fill_box(expr, t, l, b, r, floor)
  265.  
  266.                   SKIP cur_disp_rows - 1
  267.                   ceiling = Recno()
  268.                   SKIP -(cur_disp_rows - 1)
  269.  
  270.                ENDIF                             && IF btest = Subs(&btemp,1,1)
  271.             ENDIF                                && IF Type('bz_1key') = 'L'
  272.       ENDCASE
  273.  
  274.       Bhlight()                         && Highlight active element
  275.  
  276.       IF floor != first
  277.          Setcolor(c_error)
  278.          @ t, l SAY Chr(24)
  279.          Setcolor(oldcolor)
  280.       ELSE
  281.          IF bzbox
  282.             @ t, l SAY Chr(218)
  283.          ELSE
  284.             @ t, l SAY Space(1)
  285.          ENDIF
  286.       ENDIF
  287.       IF ceiling != last
  288.          Setcolor(c_error)
  289.          @ b, l SAY Chr(25)
  290.          Setcolor(oldcolor)
  291.       ELSE
  292.          IF bzbox
  293.             @ b, l SAY Chr(192)
  294.          ELSE
  295.             @ b,l SAY Space(1)
  296.          ENDIF                                   && IF bzbox
  297.  
  298.       ENDIF
  299.  
  300.       key = Inkey(0)
  301.  
  302.    ENDDO
  303.  
  304.    SET CURSOR ON
  305. RETURN (.T.)
  306.  
  307.  
  308. FUNCTION Fill_box
  309.    PARAMETERS expr, t, l, b, r, floor
  310.    
  311.    PRIV num_disp, num_rows, i, width
  312.  
  313.    num_rows = b - t - 1
  314.    width = r - l - 1
  315.  
  316.    num_disp = 0
  317.    DO WHILE ! Eof() .AND. num_disp < num_rows
  318.       @ t + num_disp + 1, l + 1 SAY Gaspad(&expr, width)
  319.       SKIP
  320.       num_disp = num_disp + 1
  321.    ENDDO
  322.  
  323.    FOR i = num_disp + 1 TO num_rows
  324.       @ t + i, l + 1 SAY Space(width)
  325.    NEXT
  326.  
  327.    GO floor
  328. RETURN (num_disp)
  329.  
  330.  
  331. FUNCTION Gaspad
  332.    PARAMETERS str, width
  333.  
  334.    IF Len(str) > width
  335.       str = Subs(str, 1, width)
  336.    ELSE
  337.       str = str + Space(width - Len(str))
  338.    ENDIF
  339. RETURN (str + Space(width - Len(str)))
  340.  
  341. *----------------------------
  342. *         Author: Ed Phillips
  343. *   Date Created: 10/06/90
  344. *----------------------------
  345. PROCEDURE Bdnarrow
  346.    up = .f.
  347.    IF highlight < cur_disp_rows
  348.       highlight = highlight + 1
  349.    ELSE
  350.       IF ceiling != last   && floor != first
  351.          SKIP
  352.          floor = Recno()
  353.  
  354.          Scroll(t + 1, l + 1, b - 1, r - 1, 1)
  355.  
  356.          SKIP cur_disp_rows - 1
  357.          ceiling = Recno()
  358.          SKIP -(cur_disp_rows - 1)
  359.       ENDIF
  360.    ENDIF
  361. RETURN
  362.  
  363. *----------------------------
  364. *         Author: Ed Phillips
  365. *   Date Created: 10/06/90
  366. *    Highlight active element
  367. *----------------------------
  368. PROCEDURE Bhlight
  369.    Setcolor(c_help)
  370.    SKIP highlight - 1
  371.    @ t + highlight, l + 1 SAY Gaspad(&expr, width)
  372.    SKIP -(highlight - 1)
  373.    Setcolor(oldcolor)
  374. RETURN
  375.  
  376.  
  377. *         Author: Ed Phillips
  378. *   Date Created: 10/11/90
  379. *   Time Created: 09:27:39
  380. *
  381. FUNCTION Isdigit
  382.    PARAMETERS dummy
  383. RETURN(dummy $ '0123456789')
  384. * EOF: Browze.prg
  385.