home *** CD-ROM | disk | FTP | other *** search
/ C!T ROM 2 / ctrom_ii_b.zip / ctrom_ii_b / PROGRAM / CLIPPER / SCRNUZ / MEMGORD.PRG < prev    next >
Text File  |  1991-12-13  |  11KB  |  348 lines
  1. *----------------------------------------------------------------------------
  2. *
  3. *   Program Name: MEMGORD.PRG       Copyright: EDON Corporation                                         
  4. *   Date Created: 03/12/91           Language: Clipper S'87                                             
  5. *   Time Created: 16:22:32             Author: Ed Phillips                               
  6. *    Description: Memscrn Reorder GETS function
  7. *----------------------------------------------------------------------------
  8.  
  9. PRIVATE grec, oldcolor, oldscrn
  10.  
  11. oldscrn = Savescreen(1,0,24,79)
  12. oldcolor = Setcolor()
  13. SELECT Scrngets
  14. SEEK Scr_file->Scrn_name
  15. IF ! Found()
  16.    Alert()
  17. ELSE
  18.    gcount = 0
  19.    grec = Recno()
  20.    DO WHILE Scrn_name == Scr_file->Scrn_name .AND. ! Eof()
  21.       gcount = gcount + 1
  22.       SKIP
  23.    ENDDO                                         && DO WHILE Scrn_name == Scr_file->Scrn_name .AND. ! Eof()
  24.    GO grec
  25.    IF gcount <= 1
  26.       Alert()
  27.    ELSE
  28.  
  29.       *-------------------
  30.       * Build the Get_List
  31.       *-------------------
  32.       PRIVATE get_list[gcount]
  33.       SET ORDER TO 0
  34.       LOCATE FOR Scrn_name == Scr_file->Scrn_name
  35.  
  36. *----------------------------------------------------------------------------------
  37. *          1         2         3         4         5         6         7         8         9         0         1         2         3         4         5         6         7         8         9         0         1         2         3
  38. * 12345678901234567890123456789012345678901234567890123456789012345678901234567890123456789012345678901234567890123456789012345678901234567890123456789012345678901234567890123456789012345678901234567890123456789012345678901234567890123456789
  39. * g_var         r  c  g_pic                          g_valid                        g_color              g_when                         say_exp                                  say_pict                       say_color            gs_flag
  40. * ccccccccccccc nn nn cccccccccccccccccccccccccccccc cccccccccccccccccccccccccccccc cccccccccccccccccccc cccccccccccccccccccccccccccccc cccccccccccccccccccccccccccccccccccccccc cccccccccccccccccccccccccccccc cccccccccccccccccccc c
  41. *------------------------------------------------------------------------------------
  42.  
  43.       FOR i = 1 TO gcount
  44.          get_list[i] = G_var+' '+Str(g_row,2,0)+' '+Str(g_col,2,0)+' '+g_pic+' '+g_valid+' '+g_color+' '+g_when+' '+say_exp+' '+say_pict+' '+say_color+' '+gs_flag
  45.          CONTINUE
  46.       NEXT                                       && FOR i = 1 TO gcount
  47.  
  48.       mtitle = '    GET List    '
  49.       Setcolor(c_error)
  50.       @ 02,32 SAY mtitle
  51.       Setcolor(c_pop)
  52.       Orderm(get_list,3,32,22,47,13)
  53.  
  54.       LOCATE FOR Scrn_name == Scr_file->Scrn_name
  55.  
  56.       FOR i = 1 TO gcount
  57.          g_var = Subs(get_list[i],1,13)
  58.          g_row = Val(Subs(get_list[i],15,2))
  59.          g_col = Val(Subs(get_list[i],18,2))
  60.          g_pic = Subs(get_list[i],21,30)
  61.          g_valid = Subs(get_list[i],52,30)
  62.          g_color = Subs(get_list[i],83,20)
  63.          g_when = Subs(get_list[i],104,30)
  64.          say_exp = Subs(get_list[i],135,40)
  65.          say_pict = Subs(get_list[i],176,30)
  66.          say_color = Subs(get_list[i],207,20)
  67.          gs_flag = Subs(get_list[i],228,1)
  68.  
  69.          REPL G_var WITH M->g_var, G_row WITH M->g_row, G_col WITH M->g_col,;
  70.             G_pic WITH M->g_pic, G_valid WITH M->g_valid, G_color WITH M->g_color
  71.          REPL G_when WITH M->g_when, Say_exp WITH M->say_exp, Say_pict WITH M->say_pict,;
  72.             Say_color WITH M->say_color, Gs_flag WITH M->gs_flag
  73.  
  74.          CONTINUE
  75.       NEXT                                       && FOR i = 1 TO gcount
  76.       SET ORDER TO 1
  77.    ENDIF                                         && IF gcount <= 1
  78. ENDIF                                            && IF ! Found()
  79. SELECT Scr_file
  80. Setcolor(oldcolor)
  81. Restscreen(1,0,24,79,oldscrn)
  82. RestGets()
  83. Gotoxy(r,c)
  84. RETURN
  85.  
  86. * Author: Skip Tatum
  87. * Modified by Ed Phillips for use with Memscrn system
  88. FUNCTION orderm
  89.    PARAMETERS ary, t, l, b, r, width
  90.  
  91.    PRIVATE num_disp_rows, floor, ceiling, hl, width, order_on, c_work
  92.    PRIVATE msg, cur_disp_rows, prom1, resp1, recno, eoa, boa, disp_row
  93.  
  94.    msg = Chr(24) + Chr(25) +  '   PgDn   PgUp   Home / ^Home   End / ^End;   Select - <F5>'
  95.  
  96.    *------------------
  97.    * Define keystrokes
  98.    *------------------
  99.    order_on = .F.
  100.  
  101.    boa = 1
  102.    eoa = LEN(ary)
  103.    ceiling = 1
  104.    disp_row = 1
  105.  
  106.    c_arrow = '+W/G'
  107.  
  108.    SET CURSOR OFF
  109.    Setcolor(c_lista)
  110.    Scroll(t,l,b,r,0)
  111.    @ t, l TO b, r
  112.    Sayhelp(msg)
  113.    num_disp_rows = b - t - 1
  114. *   width = 13                                    && r - l - 1
  115.    hl = 1
  116.    floor = afill_box(ary, t, l, b, r)
  117.  
  118.    IF eoa > num_disp_rows
  119.       Setcolor(c_arrow)
  120.       @ b, l SAY Chr(25)
  121.       Setcolor(c_lista)
  122.    ENDIF
  123.  
  124.    *-------------------------
  125.    * Highlight active element
  126.    *-------------------------
  127.    c_work = c_field
  128.    Setcolor(c_work)
  129.  
  130.    @ t + disp_row, l + 1 SAY Lib_pad(ary[hl], width)
  131.  
  132.    Setcolor(c_lista)
  133.  
  134.    key = Inkey(0)
  135.    DO WHILE key != esc .AND. key != enter
  136.  
  137.       DO CASE
  138.          CASE key = uparrow                      && up one
  139.             IF hl # ceiling
  140.                hl = hl - 1
  141.                disp_row = disp_row - 1
  142.             ELSE
  143.                IF ceiling != boa
  144.                   hl = hl - 1
  145.                   ceiling = ceiling -1
  146.                   floor = floor - 1
  147.  
  148.                   Scroll(t + 1, l + 1, b - 1, r - 1, -1)
  149.                ENDIF
  150.             ENDIF
  151.  
  152.             IF order_on
  153.                temp = ary[hl+1]
  154.                ary[hl+1] = ary[hl]
  155.                ary[hl] = temp
  156.             ENDIF
  157.  
  158.             @ t + (disp_row+1), l + 1 SAY Lib_pad(ary[hl+1], width)
  159.  
  160.          CASE key = dnarrow                      && down one
  161.             IF hl # floor
  162.                hl = hl + 1
  163.                disp_row = disp_row + 1
  164.             ELSE
  165.                IF floor != eoa
  166.                   hl = hl + 1
  167.                   ceiling = ceiling + 1
  168.                   floor = floor + 1
  169.  
  170.                   Scroll(t + 1, l + 1, b - 1, r - 1, 1)
  171.                ENDIF
  172.             ENDIF
  173.  
  174.             IF order_on
  175.                temp = ary[hl-1]
  176.                ary[hl-1] = ary[hl]
  177.                ary[hl] = temp
  178.             ENDIF
  179.  
  180.             @ t + (disp_row-1), l + 1 SAY Lib_pad(ary[hl-1], width)
  181.  
  182.          CASE key = pgup                         && previous screen
  183.             IF order_on
  184.                temp = ary[hl]
  185.                ADEL(ary,hl)
  186.             ENDIF
  187.  
  188.             IF (ceiling - num_disp_rows) < 1
  189.                ceiling = boa
  190.                floor = Min(eoa,boa + num_disp_rows - 1)
  191.                hl = ceiling + disp_row - 1
  192.             ELSE
  193.                hl = Max(1,hl - num_disp_rows)
  194.                ceiling = Max(1,ceiling - num_disp_rows)
  195.                floor = If(floor - num_disp_rows < 1, eoa, floor-num_disp_rows)
  196.             ENDIF
  197.  
  198.             IF order_on
  199.                AINS(ary,hl)
  200.                ary[hl] = temp
  201.             ENDIF
  202.  
  203.             afill_box(ary, t, l, b, r)
  204.  
  205.          CASE key = pgdn                         && next screen
  206.             IF order_on
  207.                temp = ary[hl]
  208.                ADEL(ary,hl)
  209.             ENDIF
  210.  
  211.             IF (floor + num_disp_rows) > eoa
  212.                ceiling = Max(1,eoa - num_disp_rows + 1)
  213.                floor = eoa
  214.                hl = ceiling + disp_row - 1
  215.             ELSE
  216.                hl = hl + num_disp_rows
  217.                ceiling = ceiling + num_disp_rows
  218.                floor = floor + num_disp_rows
  219.             ENDIF
  220.  
  221.             IF order_on
  222.                AINS(ary,hl)
  223.                ary[hl] = temp
  224.             ENDIF
  225.  
  226.             afill_box(ary, t, l, b, r)
  227.  
  228.          CASE key = home                         && top of screen
  229.             IF order_on
  230.                temp = ary[hl]
  231.                ary[hl] = ary[ceiling]
  232.                ary[ceiling] = temp
  233.             ENDIF
  234.  
  235.             @ t + disp_row, l + 1  SAY  LIB_PAD(ary[hl],width)
  236.  
  237.             hl = ceiling
  238.             disp_row = 1
  239.  
  240.          CASE key = end_key                      && bottom of screen
  241.             IF order_on
  242.                temp = ary[hl]
  243.                ary[hl] = ary[floor]
  244.                ary[floor] = temp
  245.             ENDIF
  246.  
  247.             @ t + disp_row, l + 1  SAY  LIB_PAD(ary[hl],width)
  248.  
  249.             hl = floor
  250.             disp_row = Min(eoa,num_disp_rows)
  251.  
  252.          CASE key = ctrl_home                    && go to boa
  253.             IF order_on
  254.                temp = ary[hl]
  255.                ary[hl] = ary[boa]
  256.                ary[boa] = temp
  257.             ENDIF
  258.  
  259.             hl = boa
  260.             ceiling = boa
  261.             disp_row = 1
  262.  
  263.             floor = afill_box(ary, t, l, b, r)
  264.  
  265.          CASE key = ctrl_end                     && go to eoa
  266.             IF order_on
  267.                temp = ary[hl]
  268.                ary[hl] = ary[eoa]
  269.                ary[eoa] = temp
  270.             ENDIF
  271.  
  272.             hl = eoa
  273.             ceiling = eoa - num_disp_rows +1
  274.             floor = eoa
  275.             disp_row = num_disp_rows
  276.  
  277.             afill_box(ary, t, l, b, r)
  278.  
  279.          CASE key = -4                           && F5 - mode switch
  280.             order_on = !order_on
  281.             c_work = IIF(order_on,c_pop,c_field)
  282.  
  283.       ENDCASE
  284.  
  285.       *-------------------------
  286.       * Highlight active element
  287.       *-------------------------
  288.       Setcolor(c_work)
  289.       @ t + disp_row, l + 1 SAY Lib_pad(ary[hl], width)
  290.       Setcolor(c_lista)
  291.  
  292.       IF ceiling != boa
  293.          Setcolor(c_arrow)
  294.          @ t, l SAY Chr(24)
  295.          Setcolor(c_lista)
  296.       ELSE
  297.          @ t, l SAY Chr(218)
  298.       ENDIF
  299.       IF eoa > floor
  300.          Setcolor(c_arrow)
  301.          @ b, l SAY Chr(25)
  302.          Setcolor(c_lista)
  303.       ELSE
  304.          @ b, l SAY Chr(192)
  305.       ENDIF
  306.  
  307.       key = Inkey(0)
  308.  
  309.    ENDDO
  310.  
  311.    SET CURSOR ON
  312. RETURN (.T.)
  313.  
  314.  
  315. FUNCTION afill_box
  316.    PARAMETERS expr, t, l, b, r
  317.  
  318.    PRIV num_disp, num_rows, i, ele
  319.  
  320.    num_rows = b - t - 1
  321.    ele = ceiling
  322.  
  323.    num_disp = 0
  324.    DO WHILE num_disp < LEN(expr) .AND. num_disp < num_rows
  325.       @ t + num_disp + 1, l + 1 SAY Lib_pad(expr[ele], width)
  326.       num_disp = num_disp + 1
  327.       ele = ele + 1
  328.    ENDDO
  329.  
  330.    FOR i = num_disp + 1 TO num_rows
  331.       @ t + i, l + 1 SAY Space(width)
  332.    NEXT
  333.  
  334. RETURN (num_disp)
  335.  
  336.  
  337. FUNCTION Lib_pad
  338.    PARAMETERS str, width
  339.  
  340.    IF Len(str) > width
  341.       str = Subs(str, 1, width)
  342.    ELSE
  343.       str = str + Space(width - Len(str))
  344.    ENDIF
  345. RETURN (str + Space(width - Len(str)))
  346.  
  347. * EOF: Memgord.prg
  348.