home *** CD-ROM | disk | FTP | other *** search
/ C!T ROM 2 / ctrom_ii_b.zip / ctrom_ii_b / PROGRAM / CLIPPER / SCRNUZ / ALIST.PRG next >
Text File  |  1991-12-13  |  5KB  |  161 lines
  1. *.............................................................................
  2. *
  3. *   Program Name: ALIST.PRG         Copyright: EDON Corporation                                        
  4. *   Date Created: 10/03/90           Language: Clipper S'87                                             
  5. *   Time Created: 07:07:44             Author: Ed Phillips                               
  6. *
  7. *.............................................................................
  8.  
  9. *** Syntax: Alist(listname, mtitle, menuwidth, top_row, left_corner)
  10.  
  11. PARA listname, mtitle, menuwidth, trow, lc
  12.  
  13. *---------------------------
  14. *   declare local variables
  15. *---------------------------
  16. PRIV oldcolor, brow, rc, j
  17. PRIV save_scr
  18. selection = 0
  19. oldcolor = Setcolor(c_norm)
  20.  
  21. *-----------------------------------------------------------------------
  22. *   build selection list window parameters and center title
  23. *-----------------------------------------------------------------------
  24. tlen = (menuwidth-Len(mtitle))/2
  25. mtitle = Space(tlen)+mtitle+Space(tlen)
  26. IF Len(mtitle) % 2 != 0
  27.    mtitle = mtitle+' '
  28. ENDIF
  29.  
  30. rc = 2+menuwidth+2+lc
  31. brow = trow + 4 + Len(&listname.)
  32.  
  33. IF brow > 22
  34.    brow = 22
  35. ENDIF
  36.  
  37. *-----------------------------------------------------------------------
  38. *   save screen & build the window box, with title
  39. *-----------------------------------------------------------------------
  40.  
  41. SAVE SCREEN TO save_scr
  42. Setcolor(c_fielda) 
  43. Scroll(trow,lc,brow,rc,0)
  44. @ trow,lc TO brow,rc DOUBLE
  45. Setcolor(c_list)
  46. @ trow+1, lc + 2 say mtitle
  47. Setcolor(c_fielda) 
  48. @ trow+2, lc say '╟'
  49.  
  50. @ trow+2, lc+1 say Drawline(rc-lc)
  51. @ trow+2, rc say '╢'
  52.  
  53. *-----------------------------------------------------------------------
  54. *   pop-up selection menu and get choice
  55. *-----------------------------------------------------------------------
  56.  
  57. Sayhelp('<F9> = Mark/Unmark All, <Enter> = Mark/Unmark Selection, <ESC> = done.')
  58.  
  59. STORE 1 TO oel, ore
  60. selection = 0
  61. num_mark = 0
  62. DO WHILE .t.
  63.    Setcolor(c_fielda)
  64.    selection = Achoice(trow+4,lc+2,brow-1,rc-2,&listname,.t.,"getofield",oel,ore)
  65.    DO CASE
  66.  
  67.       CASE Lastkey() = enter   && <enter>
  68.          IF Chr(251) $ &listname[selection]      && toggle mark off
  69.             &listname[selection] = ' '+Subs(&listname[selection],2)
  70.             num_mark = num_mark-1
  71.          ELSE                                    && toggle mark on
  72.             &listname[selection] = Chr(251) + Subs(&listname[selection],2)
  73.             num_mark = num_mark+1
  74.          ENDIF   && chr 251, check mark
  75.  
  76.       CASE Lastkey() = f9
  77.          IF Chr(251) $ &listname[selection]      && toggle mark off
  78.             num_mark = 0
  79.             FOR j = 1 TO Len(&listname.)
  80.                &listname[j] = ' '+Subs(&listname[j],2)
  81.             NEXT                                 && FOR j = 1 TO Len(&listname.)
  82.          ELSE
  83.             num_mark = Len(&listname.)
  84.             FOR j = 1 TO num_mark
  85.                &listname[j] = Chr(251) + Subs(&listname[j],2)
  86.             NEXT                                    && FOR j = 1 TO num_mark
  87.          ENDIF                                   && IF Chr(251) $ &listname[selection]      && toggle mark off
  88.  
  89.       CASE Lastkey() = esc   && <esc>
  90.          EXIT
  91.    ENDCASE
  92. ENDDO
  93. Setcolor(oldcolor)
  94. RETURN
  95.  
  96. *         Author: Ed Phillips
  97. *   Date Created: 10/03/90
  98. *   Time Created: 07:23:48
  99. *
  100. FUNCTION Getofield
  101. PARA mode,element,relative
  102.    oel = element
  103.    ore = relative
  104. RETU (1)
  105.  
  106.  
  107. FUNC PickList
  108.    *** Syntax: PickList(listname, mtitle, menuwidth, top_row, left_corner)
  109.  
  110.    PARA listname, mtitle, menuwidth, trow, lc
  111.  
  112.    *---------------------------
  113.    *   declare local variables
  114.    *---------------------------
  115.    PRIV brow, rc, j
  116.    PRIV save_scr
  117.    selection = 0
  118.  
  119.    *-----------------------------------------------------------------------
  120.    *   build selection list window parameters and center title
  121.    *-----------------------------------------------------------------------
  122.    tlen = (menuwidth-Len(mtitle))/2
  123.    mtitle = Space(tlen)+mtitle+Space(tlen)
  124.    IF Len(mtitle) % 2 != 0
  125.       mtitle = mtitle+' '
  126.    ENDIF
  127.  
  128.    rc = 2+menuwidth+2+lc
  129.    brow = trow + 4 + Len(&listname.)
  130.  
  131.    IF brow > 22
  132.       brow = 22
  133.    ENDIF
  134.  
  135.    *-----------------------------------------------------------------------
  136.    *   save screen & build the window box, with title
  137.    *-----------------------------------------------------------------------
  138.  
  139.    SAVE SCREEN TO save_scr
  140.    Scroll(trow,lc,brow,rc,0)
  141.    @ trow,lc TO brow,rc DOUBLE
  142.    @ trow+1, lc + 2 say mtitle
  143.    @ trow+2, lc say '╟'
  144.  
  145.    @ trow+2, lc+1 say Drawline(rc-lc)
  146.    @ trow+2, rc say '╢'
  147.  
  148.    *-----------------------------------------------------------------------
  149.    *   pop-up selection menu and get choice
  150.    *-----------------------------------------------------------------------
  151.  
  152.    Sayhelp('<Enter> = Select, <ESC> = Cancel')
  153.  
  154.    selection = 0
  155.    selection = Achoice(trow+4,lc+2,brow-1,rc-2,&listname,.t.)
  156.    RESTORE SCREEN FROM save_scr
  157. RETURN (selection)
  158.  
  159. * EOF: Alist.prg
  160.  
  161.