home *** CD-ROM | disk | FTP | other *** search
/ C!T ROM 2 / ctrom_ii_b.zip / ctrom_ii_b / PROGRAM / CLIPPER / SCRNUZ / ORDMENU.PRG < prev    next >
Text File  |  1991-03-26  |  8KB  |  288 lines
  1. ***************************************************************
  2. * Program Name: ordmenu.prg
  3. * Author: Skip Tatum
  4. *-----------------------------------------------------------------------------
  5. * Created: 3/25/1991
  6. * main =
  7. * Called From:
  8. * --- Data Base Files ---   ----- Index Files -----   ----- Other Files ----
  9. *
  10. *
  11. *
  12. *.............................................................................
  13. * Revision: 1.0 Last Revised: 7/11/1989 at 13:59
  14. * Description: Browse of a database which may be indexed, filtered, or have
  15. *              set deleted on.
  16. *.............................................................................
  17. *---------------------------- ALL RIGHTS RESERVED ----------------------------
  18. FUNCTION orderm
  19.    PARAMETERS ary, t, l, b, r
  20.  
  21.    PRIVATE num_disp_rows, floor, ceiling, hl, width, order_on
  22.    PRIVATE msg, cur_disp_rows, prom1, resp1, recno, eoa, boa, disp_row
  23.  
  24.    msg = Chr(24) + Chr(25) +  '   PgDn   PgUp   Home / ^Home   End / ^End;   Select - Enter '
  25.  
  26.    *------------------
  27.    * Define keystrokes
  28.    *------------------
  29.    esc = 27
  30.    enter = 13
  31.    uparrow = 5
  32.    dnarrow = 24
  33.    pgup = 18
  34.    pgdn = 3
  35.    home = 1
  36.    end_key = 6
  37.    ctrl_home = 29
  38.    ctrl_end = 23
  39.    order_on = .F.
  40.  
  41.    boa = 1
  42.    eoa = LEN(ary)
  43.    ceiling = 1
  44.    disp_row = 1
  45.  
  46.    c_lista = '+W/N'
  47.    c_field = '+W/BG'
  48.    c_arrow = '+W/G'
  49.  
  50.    SET CURSOR OFF
  51.    Setcolor(c_lista)
  52.    @ t, l TO b, r
  53.    @ 24,40-LEN(msg)/2 SAY msg
  54.    num_disp_rows = b - t - 1
  55.    width = r - l - 1
  56.    hl = 1
  57.    floor = fill_box(ary, t, l, b, r)
  58.  
  59.    IF ceiling != eoa
  60.       Setcolor(c_arrow)
  61.       @ b, l SAY Chr(25)
  62.       Setcolor(c_lista)
  63.    ENDIF
  64.  
  65.    *-------------------------
  66.    * Highlight active element
  67.    *-------------------------
  68.    Setcolor(c_field)
  69.  
  70.    @ t + disp_row, l + 1 SAY Lib_pad(ary[hl], width)
  71.  
  72.    Setcolor(c_lista)
  73.  
  74.    key = Inkey(0)
  75.    DO WHILE key != esc .AND. key != enter
  76.  
  77.       DO CASE
  78.          CASE key = uparrow                      && up one
  79.             IF hl # ceiling
  80.                hl = hl - 1
  81.                disp_row = disp_row - 1
  82.             ELSE
  83.                IF ceiling != boa
  84.                   hl = hl - 1
  85.                   ceiling = ceiling -1
  86.                   floor = floor - 1
  87.  
  88.                   Scroll(t + 1, l + 1, b - 1, r - 1, -1)
  89.                ENDIF
  90.             ENDIF
  91.  
  92.             IF order_on
  93.                temp = ary[hl+1]
  94.                ary[hl+1] = ary[hl]
  95.                ary[hl] = temp
  96.             ENDIF
  97.  
  98.             @ t + (disp_row+1), l + 1 SAY Lib_pad(ary[hl+1], width)
  99.  
  100.          CASE key = dnarrow                      && down one
  101.             IF hl # floor
  102.                hl = hl + 1
  103.                disp_row = disp_row + 1
  104.             ELSE
  105.                IF floor != eoa
  106.                   hl = hl + 1
  107.                   ceiling = ceiling + 1
  108.                   floor = floor + 1
  109.  
  110.                   Scroll(t + 1, l + 1, b - 1, r - 1, 1)
  111.                ENDIF
  112.             ENDIF
  113.  
  114.             IF order_on
  115.                temp = ary[hl-1]
  116.                ary[hl-1] = ary[hl]
  117.                ary[hl] = temp
  118.             ENDIF
  119.  
  120.             @ t + (disp_row-1), l + 1 SAY Lib_pad(ary[hl-1], width)
  121.  
  122.          CASE key = pgup                         && previous screen
  123.                IF order_on
  124.                   temp = ary[hl]
  125.                   ADEL(ary,hl)
  126.                ENDIF
  127.  
  128.                IF (ceiling - num_disp_rows) < 1
  129.                   ceiling = boa
  130.                   floor = boa + num_disp_rows - 1
  131.                   hl = ceiling + disp_row - 1
  132.                ELSE
  133.                   hl = hl - num_disp_rows
  134.                   ceiling = ceiling - num_disp_rows
  135.                   floor = floor - num_disp_rows
  136.                ENDIF
  137.  
  138.                IF order_on
  139.                   AINS(ary,hl)
  140.                   ary[hl] = temp
  141.                ENDIF
  142.  
  143.                fill_box(ary, t, l, b, r)
  144.  
  145.          CASE key = pgdn                         && next screen
  146.             IF order_on
  147.                temp = ary[hl]
  148.                ADEL(ary,hl)
  149.             ENDIF
  150.  
  151.             IF (floor + num_disp_rows) > eoa
  152.                ceiling = eoa - num_disp_rows + 1
  153.                floor = eoa
  154.                hl = ceiling + disp_row - 1
  155.             ELSE
  156.                hl = hl + num_disp_rows
  157.                ceiling = ceiling + num_disp_rows
  158.                floor = floor + num_disp_rows
  159.             ENDIF
  160.  
  161.             IF order_on
  162.                AINS(ary,hl)
  163.                ary[hl] = temp
  164.             ENDIF
  165.  
  166.             fill_box(ary, t, l, b, r)
  167.  
  168.          CASE key = home                         && top of screen
  169.             IF order_on
  170.                temp = ary[hl]
  171.                ary[hl] = ary[ceiling]
  172.                ary[ceiling] = temp
  173.             ENDIF
  174.  
  175.             @ t + disp_row, l + 1  SAY  LIB_PAD(ary[hl],width)
  176.  
  177.             hl = ceiling
  178.             disp_row = 1
  179.  
  180.          CASE key = end_key                      && bottom of screen
  181.             IF order_on
  182.                temp = ary[hl]
  183.                ary[hl] = ary[floor]
  184.                ary[floor] = temp
  185.             ENDIF
  186.  
  187.             @ t + disp_row, l + 1  SAY  LIB_PAD(ary[hl],width)
  188.  
  189.             hl = floor
  190.             disp_row = num_disp_rows
  191.  
  192.          CASE key = ctrl_home                    && go to boa
  193.             IF order_on
  194.                temp = ary[hl]
  195.                ary[hl] = ary[boa]
  196.                ary[boa] = temp
  197.             ENDIF
  198.  
  199.             hl = boa
  200.             ceiling = boa
  201.             disp_row = 1
  202.  
  203.             floor = fill_box(ary, t, l, b, r)
  204.  
  205.          CASE key = ctrl_end                     && go to eoa
  206.             IF order_on
  207.                temp = ary[hl]
  208.                ary[hl] = ary[eoa]
  209.                ary[eoa] = temp
  210.             ENDIF
  211.  
  212.             hl = eoa
  213.             ceiling = eoa - num_disp_rows +1
  214.             floor = eoa
  215.             disp_row = num_disp_rows
  216.  
  217.             fill_box(ary, t, l, b, r)
  218.  
  219.           CASE key = -4                            && F5 - mode switch
  220.              order_on = !order_on
  221.              c_field = IIF(order_on,'+W/G','+W/BG')
  222.  
  223.       ENDCASE
  224.  
  225.       *-------------------------
  226.       * Highlight active element
  227.       *-------------------------
  228.       Setcolor(c_field)
  229.       @ t + disp_row, l + 1 SAY Lib_pad(ary[hl], width)
  230.       Setcolor(c_lista)
  231.  
  232.       IF ceiling != boa
  233.          Setcolor(c_arrow)
  234.          @ t, l SAY Chr(24)
  235.          Setcolor(c_lista)
  236.       ELSE
  237.          @ t, l SAY Chr(218)
  238.       ENDIF
  239.       IF floor != eoa
  240.          Setcolor(c_arrow)
  241.          @ b, l SAY Chr(25)
  242.          Setcolor(c_lista)
  243.       ELSE
  244.          @ b, l SAY Chr(192)
  245.       ENDIF
  246.  
  247.       key = Inkey(0)
  248.  
  249.    ENDDO
  250.  
  251.    SET CURSOR ON
  252. RETURN (.T.)
  253.  
  254.  
  255. FUNCTION Fill_box
  256.    PARAMETERS expr, t, l, b, r
  257.  
  258.    PRIV num_disp, num_rows, i, width, ele
  259.  
  260.    num_rows = b - t - 1
  261.    width = r - l - 1
  262.    ele = ceiling
  263.  
  264.    num_disp = 0
  265.    DO WHILE num_disp < LEN(expr) .AND. num_disp < num_rows
  266.       @ t + num_disp + 1, l + 1 SAY Lib_pad(expr[ele], width)
  267.       num_disp = num_disp + 1
  268.       ele = ele + 1
  269.    ENDDO
  270.  
  271.    FOR i = num_disp + 1 TO num_rows
  272.       @ t + i, l + 1 SAY Space(width)
  273.    NEXT
  274.  
  275. RETURN (num_disp)
  276.  
  277.  
  278. FUNCTION Lib_pad
  279.    PARAMETERS str, width
  280.  
  281.    IF Len(str) > width
  282.       str = Subs(str, 1, width)
  283.    ELSE
  284.       str = str + Space(width - Len(str))
  285.    ENDIF
  286. RETURN (str + Space(width - Len(str)))
  287. * EOF: Browze.prg
  288.