home *** CD-ROM | disk | FTP | other *** search
/ Media Share 13 / mediashare_13.zip / mediashare_13 / ZIPPED / NETWORK / GP25.ZIP / ASINGLCH.PRG next >
Text File  |  1993-04-13  |  3KB  |  109 lines
  1. *  Function Name:        ASinglCh()
  2. *  Written By:            George Sexton, 11/20/92
  3. *  Description:            ASinglCh() (Array Single Choice) is a popup
  4. *                        screen function designed to display an array
  5. *                        and allow the user to select one item
  6. *                        from it.  The display window auto-sizes itself
  7. *                        with an option to override the default behavior.
  8. *
  9. *  Parameters:
  10. *
  11. *        AList            This is the array to use for the display.  The
  12. *                        column to select must be of type character.
  13. *
  14. *
  15. *        <CTitle>        This is the optional title to use on the pop-up window.
  16. *                        If this option is ommitted, the default title is CHOOSE 1.
  17. *
  18. *
  19. *        <Column>        This is the column of the array to display.  You can use
  20. *                        This function to display a multiple column array.  The default
  21. *                        operation is that column 1 is displayed, but by passing
  22. *                        <Column>, you can override this behavior.
  23. *
  24. *        <NRow1>, <NCol1>    This is the optional coordinates for the upper right
  25. *        <nRow2>, <nCol2>    and lower left corners of the popup.  If you pass one
  26. *                        pair of parameters, you must pass all.
  27. *
  28. *  Returns:                The element number selected, or 0 if the user
  29. *                        pressed escape.
  30. *
  31. *
  32. *  Sample Usage:
  33. *
  34. *        Select L10, acctName+l10 from detacct into array aAccts
  35. *        nChoice=aSinglCh(@aAccts, "Select Account", 2)
  36. *        if nChoice > 0
  37. *            cAcctNo=aAccts[nChoice, 1]
  38. *        else
  39. *            wait window "user pressed escape"
  40. *        endif
  41. *
  42.  
  43. parameters aChArray , cTitle , nAColumn , nY1 , nX1 , nY2 , nX2
  44. private naWidth , lOneDimension , nWorkArea , nCounter , nAnswer , ;
  45.         nxCtr , nYCtr , nHeight , cLastConfirm , n
  46. external array aChArray
  47. nWorkArea = select()
  48. cLastConfirm = set('CONFIRM')
  49. set confirm on
  50. push key clear
  51. if empty(nAColumn)
  52.     nAColumn = 1
  53. endif
  54. if empty(cTitle)
  55.     CTitle = "Choose 1"
  56. endif
  57. nAWidth = 0
  58. lOneDimension = (alen(aChArray , 2) = 0)
  59.  
  60. for n = 1 to alen(aChArray , 1)
  61.     if lOneDimension
  62.         nAWidth = max(nAWidth , len(aChArray[n]) + 3)
  63.     else
  64.         nAWidth = max(nAWidth , len(aChArray[n , nAColumn]) + 3)
  65.     endif
  66. endfor
  67.  
  68. create cursor aPop (Field1 C(nAWidth) )
  69. if lOneDimension
  70.     for nCounter = 1 to alen(aChArray , 1)
  71.         append blank
  72.         replace field1 with aChArray[nCounter]
  73.     endfor
  74. else
  75.     for nCounter = 1 to alen(aChArray , 1)
  76.         append blank
  77.         replace field1 with aChArray[nCounter , nAColumn]
  78.     endfor
  79. endif
  80. if type('nY1') <> 'N'
  81.     *  We Need to calculate the location and size of the popup
  82.     nxCtr = scols() / 2
  83.     nYCtr = srows() / 2
  84.     nX1 = max(0 , nxCtr - nAWidth / 2)
  85.     nX2 = min(scols() - 1 , nXCtr + nAWidth / 2)
  86.     nHeight = min(srows() - 4 , reccount() + 1)
  87.     nY1 = max(1 , nYCtr - nHeight / 2)
  88.     nY2 = min(srows() - 4 , nYCtr + nHeight / 2)
  89. endif
  90. define popup ASinglCh ;
  91.         from nY1 , nX1 to nY2 , nX2 ;
  92.         prompt field Field1 ;
  93.         scroll shadow ;
  94.         color scheme 6 ;
  95.         title cTitle
  96. on selection popup ASinglCh deactivate popup aSinglCh
  97. activate popup aSingLCh
  98. if lastkey() = 27
  99.     nAnswer = 0
  100. else
  101.     nAnswer = recno()
  102. endif
  103. release popup ASinglCh
  104. set confirm &cLastConfirm
  105. use
  106. select (nWorkArea)
  107. pop key
  108. return nAnswer
  109.