home *** CD-ROM | disk | FTP | other *** search
/ Liren Large Software Subsidy 5 / 05.iso / a / a013 / 1.ddi / SOURCE.EXE / F_PICKIT.PRG < prev    next >
Encoding:
Text File  |  1991-01-25  |  2.7 KB  |  112 lines
  1. *****************************************************************
  2. FUNCTION PICKIT (top, left, bottom, right, in_array, ;
  3.                  out_array, new_color)
  4. *****************************************************************
  5.  
  6. * Allow selection of elements from an array
  7.  
  8. * Copyright(c) 1991 - James Occhiogrosso
  9.  
  10. #include "box.ch"
  11.  
  12. LOCAL   choice :=1, counter :=1, new_array[0],             ;
  13.         num_elems := LEN(in_array), old_screen, old_color, ;
  14.         pad_len := (right-1) - (left+1)
  15.  
  16. * Check the display array for all character elements
  17. IF .NOT. ARTYPE(in_array, 'C')
  18.     RETURN(-1)
  19. ENDIF
  20.  
  21. * Save old screen
  22. old_screen = SCRNSAVE(top, left, bottom, right)
  23.  
  24. * Test the color argument
  25. IF VALTYPE(new_color) = 'C' .AND. .NOT. EMPTY(new_color)
  26.     * Color was passed, use it
  27.     old_color = SETCOLOR(new_color)
  28.  
  29. ELSEIF new_color = NIL
  30.     * No argument passed, use default color
  31.     old_color = SETCOLOR(colwindow)
  32.  
  33. ELSE
  34.     * Use current color
  35.     old_color = SETCOLOR()
  36.  
  37. ENDIF
  38.  
  39. * Box display area
  40. @ top, left, bottom, right BOX B_SINGLE + SPACE(1)
  41.  
  42. FOR counter = 1 TO num_elems
  43.  
  44.      * Pad elements of in_array to same length for viewing
  45.      in_array[counter]  = ;
  46.      PADR('   ' + in_array[counter], pad_len)
  47.  
  48.      * Pad return array for marking
  49.      out_array[counter] = SPACE(1) + out_array[counter]
  50.  
  51. NEXT
  52.  
  53.  
  54. DO WHILE choice != 0
  55.  
  56.     * Wait in ACHOICE for an operator selection
  57.     choice = ACHOICE(top+1, left+1, bottom-1, right-1,;
  58.              in_array, '', '', choice)
  59.  
  60.     IF choice > 0
  61.         * Mark/unmark array elements
  62.  
  63.         IF SUBSTR(in_array[choice],2,1) = '√'
  64.  
  65.             * If element is already marked, unmark it
  66.             in_array[choice] = '   ' + ;
  67.                      SUBSTR(in_array[choice],4)
  68.             out_array[choice] = ' '  + ;
  69.                      SUBSTR(out_array[choice],2)
  70.         ELSE
  71.  
  72.             * Otherwise, mark selected element
  73.             in_array[choice] = ' √ ' + ;
  74.                      SUBSTR(in_array[choice],4)
  75.             out_array[choice] = '√'  + ;
  76.                      SUBSTR(out_array[choice],2)
  77.         ENDIF
  78.     ENDIF
  79. ENDDO
  80.  
  81.  
  82.  
  83. FOR counter = 1 TO num_elems
  84.  
  85.    IF SUBSTR(out_array[counter],1,1) = '√'
  86.  
  87.        * If element is marked, strip mark
  88.        * and add the element to new_array
  89.  
  90.        AADD(new_array, SUBSTR(out_array[counter],2))
  91.  
  92.    ENDIF
  93.  
  94.    * Restore input array to original state
  95.    in_array[counter] = SUBSTR(in_array[counter],4)
  96.  
  97. NEXT
  98.  
  99. * Copy new array to return array.
  100.  
  101. ASIZE(out_array, LEN(new_array))
  102. ACOPY(new_array, out_array)
  103.  
  104. * Clean up and return number of selections
  105.  
  106. SETCOLOR(old_color)
  107. SCRNREST(old_screen)
  108.  
  109. RETURN LEN(new_array)
  110.  
  111.  
  112.