home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Monster Media 1993 #2
/
Image.iso
/
clipper
/
snip0693.zip
/
POPLIST.PRG
< prev
next >
Wrap
Text File
|
1993-02-13
|
6KB
|
145 lines
*--- PopList ---------------------------------------------------------*
function PopList
*---------------------------------------------------------------------*
*- Programmer..: Angus Scott-Fleming Compuserve 75500,3223
*- GeoApplications fax 602-327-7752
*- P.O. Box 41082 BBS 602-881-5836
*- Tucson, Arizona 85717-1082
*- Date........: Mon 11-30-1992
*- Note........: display a popup constructed from up to 9 options
*- : "KEYBOARD"s the selected option, trimmed to length
*- : replaces dBase 'function "@M"' in GETs with a popup
*- Written for.: dBASE IV 1.5
*- Calls.......: AShadow
*- Called by...: Any
*- Usage.......: @..GET..valid requ PopList(<options>)
*- Example.....: @6,37 get m->cHanded picture "!" valid required;
*- poplist("Right-handed","Left-handed")
*- Returns.....: .T. when variable being read in matches any option,
*- .F. otherwise
*- Parameters..: cP1 = First parameter for list
*- ...
*- cP9 = Last for last ... number varies, should always
*- have at least two, otherwise, what's the point?
*---------------------------------------------------------------------*
parameters cP1, cP2, cP3, cP4, cP5, cP6, cP7, cP8, cP9
private nPopLen,nPop,nPopRow,nPopCol,nPopECol,nPopERow,;
nPop,cPopPar,cPopRead,cPopRet,nPopInLen,cPopInput,;
lDummy
* set some starting values
nPopLen = 0 && width of the popup
nPop = 0 && number of items
* get information about the field being validated:
cPopRead = varread() && name of the field
cPopInput = &cPopRead && current contents of the field
nPopInLen = len(cPopInput) && size of the field
* prepare popup bars & test input value against each bar
declare cPopBar[PCount()]
do while nPop < PCount()
nPop = nPop + 1
cPopPar = "cP" + ltrim(str(nPop,1,0))
cPopBar[nPop] = &cPopPar + space(nPopInLen - len(&cPopPar))
nPopLen = Max(nPopLen, len(cPopBar[nPop]))
if (cPopInput=left(cPopBar[nPop],nPopInLen)) .and. ;
(left(cPopBar[nPop],nPopInLen)=cPopInput)
return .T.
endif
enddo
* no match was achieved. Display popup
* establish popup location, test for screen edges
nPopRow = Row() && starting row
if nPopRow + PCount() + 1 > 24
nPopRow = 22 - PCount()
endif
nPopCol = Col() + nPopInLen && starting column
if nPopCol + nPopLen > 80
nPopCol = 75 - nPopLen
endif
* note: ending row and column are only required for AShadow
nPopERow = nPopRow + PCount() + 1 && ending row
nPopECol = nPopCol + nPopLen + 1 && ending column
* prepare the popup for display
define popup PopList from nPopRow,nPopCol
nPop = 0
do while nPop < PCount()
nPop = nPop + 1
define bar nPop of PopList prompt cPopBar[nPop]
enddo
on selection popup PopList deactivate popup
* display the popup list with an underlying shadow in the right color
lDummy = AShadow(nPopRow,nPopCol,nPopERow,nPopECol)
activate popup PopList
lDummy = AShadow() && clear the shadow
* trim selected value to length of field being validated
cPopRet = left(prompt(),nPopInLen)
release popup PopList && restore prev screen, free up screen memory
* KEYBOARD new value back to the program.
* " " clear dBase's bottom-of-the-screen error line.
* {CTRL-Y} empties the field out
* cPopRet the final value
* iif(set("confirm")="ON",chr(13),'') return, if needed
keyboard " {CTRL-Y}" + cPopRet + iif(set("confirm")="ON",chr(13),'')
* return .F. to stay in current GET field. KEYBOARD will force
* re-evaluation using PopList, and PopList will "return .T." above
return .F.
*--- AShadow ---------------------------------------------------------*
function AShadow
*---------------------------------------------------------------------*
*- Programmer..: Angus Scott-Fleming Compuserve 75500,3223
*- GeoApplications fax 602-327-7752
*- P.O. Box 41082 BBS 602-881-5836
*- Tucson, Arizona 85717-1082
*- Date........: Thu 12-24-1992
*-
*- Note........: save the current screen and draw a transparent shadow
*- under a window to be displayed next
*- OR
*- restore the previous screen, erasing the shadow
*-
*- based on Bytel's WShadow, which is part of Genifer
*- an Xbase-code-generator for dBase III+, dBase IV,
*- FoxBase+, FoxPro, dBXL 1.3, Quicksilver 1.3, Arago,
*- Clipper S'87, and Clipper 5.x
*- Written for.: dBASE IV 1.5+
*- Calls.......: None
*- Called by...: Any
*- Usage.......: lDummy = AShadow(3,3,7,8) to set a shadow
*- OR
*- lDummy = AShadow() to clear an existing shadow
*- Returns.....: .F.
*- Parameters..: wtop - top line of window on current screen
*- wleft - left edge of window on current screen
*- wbottom - bottom line of window on current screen
*- wright - right edge of window on current screen
*---------------------------------------------------------------------*
parameters wtop, wleft, wbottom, wright
if PCount() < 4
restore screen from A_Screen
release screen A_Screen
else
save screen to A_Screen
@ wtop + 1, wleft + 2 fill to ;
min(24, wbottom + 1), min(79, wright + 2) color w/n
endif
return .F.