home *** CD-ROM | disk | FTP | other *** search
/ Monster Media 1993 #2 / Image.iso / clipper / snip0693.zip / POPLIST.PRG < prev    next >
Text File  |  1993-02-13  |  6KB  |  145 lines
  1. *--- PopList ---------------------------------------------------------*    
  2. function PopList  
  3. *---------------------------------------------------------------------*   
  4. *- Programmer..: Angus Scott-Fleming             Compuserve 75500,3223
  5. *-               GeoApplications                      fax 602-327-7752
  6. *-               P.O. Box 41082                       BBS 602-881-5836
  7. *-               Tucson, Arizona 85717-1082
  8. *- Date........: Mon  11-30-1992
  9. *- Note........: display a popup constructed from up to 9 options
  10. *-             : "KEYBOARD"s the selected option, trimmed to length
  11. *-             : replaces dBase 'function "@M"' in GETs with a popup
  12. *- Written for.: dBASE IV 1.5
  13. *- Calls.......: AShadow
  14. *- Called by...: Any
  15. *- Usage.......: @..GET..valid requ PopList(<options>)
  16. *- Example.....: @6,37 get m->cHanded picture "!" valid required;
  17. *-                     poplist("Right-handed","Left-handed")
  18. *- Returns.....: .T. when variable being read in matches any option,
  19. *-               .F. otherwise
  20. *- Parameters..: cP1 = First parameter for list
  21. *-               ...
  22. *-               cP9 = Last for last ... number varies, should always
  23. *-                     have at least two, otherwise, what's the point?
  24. *---------------------------------------------------------------------*
  25.  
  26.   parameters cP1, cP2, cP3, cP4, cP5, cP6, cP7, cP8, cP9
  27.  
  28.   private nPopLen,nPop,nPopRow,nPopCol,nPopECol,nPopERow,;
  29.           nPop,cPopPar,cPopRead,cPopRet,nPopInLen,cPopInput,;
  30.           lDummy
  31.  
  32.   * set some starting values
  33.   nPopLen = 0                        && width of the popup
  34.   nPop = 0                           && number of items
  35.  
  36.   * get information about the field being validated:
  37.   cPopRead = varread()               && name of the field
  38.   cPopInput = &cPopRead              && current contents of the field
  39.   nPopInLen = len(cPopInput)         && size of the field
  40.  
  41.   * prepare popup bars & test input value against each bar
  42.   declare cPopBar[PCount()]
  43.   do while nPop < PCount()
  44.     nPop = nPop + 1
  45.     cPopPar = "cP" + ltrim(str(nPop,1,0))
  46.     cPopBar[nPop] = &cPopPar + space(nPopInLen - len(&cPopPar))
  47.     nPopLen = Max(nPopLen, len(cPopBar[nPop]))
  48.     if (cPopInput=left(cPopBar[nPop],nPopInLen)) .and. ;
  49.        (left(cPopBar[nPop],nPopInLen)=cPopInput)
  50.       return .T.
  51.     endif
  52.   enddo
  53.  
  54.   * no match was achieved. Display popup
  55.  
  56.   * establish popup location, test for screen edges
  57.   nPopRow = Row()                         && starting row
  58.   if nPopRow + PCount() + 1 > 24
  59.     nPopRow = 22 - PCount()
  60.   endif
  61.   nPopCol = Col() + nPopInLen             && starting column
  62.   if nPopCol + nPopLen > 80
  63.     nPopCol = 75 - nPopLen
  64.   endif
  65.  
  66.   * note: ending row and column are only required for AShadow
  67.   nPopERow = nPopRow + PCount() + 1       && ending row
  68.   nPopECol = nPopCol + nPopLen + 1        && ending column
  69.  
  70.   * prepare the popup for display
  71.   define popup PopList from nPopRow,nPopCol
  72.   nPop = 0
  73.   do while nPop < PCount()
  74.     nPop = nPop + 1
  75.     define bar nPop of PopList prompt cPopBar[nPop]
  76.   enddo
  77.   on selection popup PopList deactivate popup
  78.  
  79.   * display the popup list with an underlying shadow in the right color
  80.   lDummy = AShadow(nPopRow,nPopCol,nPopERow,nPopECol)
  81.   activate popup PopList
  82.   lDummy = AShadow()                               && clear the shadow
  83.  
  84.   * trim selected value to length of field being validated
  85.   cPopRet = left(prompt(),nPopInLen)
  86.  
  87.   release popup PopList   && restore prev screen, free up screen memory
  88.  
  89.   * KEYBOARD new value back to the program.
  90.   *   " "             clear dBase's bottom-of-the-screen error line.
  91.   *   {CTRL-Y}        empties the field out
  92.   *   cPopRet         the final value
  93.   *   iif(set("confirm")="ON",chr(13),'')    return, if needed
  94.  
  95.   keyboard " {CTRL-Y}" + cPopRet + iif(set("confirm")="ON",chr(13),'')
  96.  
  97.   * return .F. to stay in current GET field.  KEYBOARD will force
  98.   * re-evaluation using PopList, and PopList will "return .T." above
  99. return .F.
  100.  
  101. *--- AShadow ---------------------------------------------------------*   
  102. function AShadow
  103. *---------------------------------------------------------------------*
  104. *- Programmer..: Angus Scott-Fleming             Compuserve 75500,3223
  105. *-               GeoApplications                      fax 602-327-7752
  106. *-               P.O. Box 41082                       BBS 602-881-5836
  107. *-               Tucson, Arizona 85717-1082
  108. *- Date........: Thu  12-24-1992
  109. *-
  110. *- Note........: save the current screen and draw a transparent shadow
  111. *-                  under a window to be displayed next
  112. *-                                  OR
  113. *-               restore the previous screen, erasing the shadow
  114. *-
  115. *-               based on Bytel's WShadow, which is part of Genifer
  116. *-               an Xbase-code-generator for dBase III+, dBase IV,
  117. *-               FoxBase+, FoxPro, dBXL 1.3, Quicksilver 1.3, Arago,
  118. *-               Clipper S'87, and Clipper 5.x
  119. *- Written for.: dBASE IV 1.5+
  120. *- Calls.......: None
  121. *- Called by...: Any
  122. *- Usage.......: lDummy = AShadow(3,3,7,8) to set a shadow
  123. *-                OR
  124. *-               lDummy = AShadow() to clear an existing shadow
  125. *- Returns.....: .F.
  126. *- Parameters..: wtop    - top line of window on current screen
  127. *-               wleft   - left edge of window on current screen
  128. *-               wbottom - bottom line of window on current screen
  129. *-               wright  - right edge of window on current screen
  130. *---------------------------------------------------------------------*
  131.  
  132.   parameters wtop, wleft, wbottom, wright
  133.  
  134.   if PCount() < 4
  135.     restore screen from A_Screen
  136.     release screen A_Screen
  137.   else
  138.     save screen to A_Screen
  139.     @ wtop + 1, wleft + 2 fill to ;
  140.       min(24, wbottom + 1), min(79, wright + 2) color w/n
  141.   endif
  142.  
  143. return .F.
  144.  
  145.