home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Power-Programmierung
/
CD1.mdf
/
xbase
/
library
/
dbase
/
picklist
/
picklist.prg
< prev
Wrap
Text File
|
1992-07-12
|
3KB
|
94 lines
/*
Program Name: PICKLIST.PRG Copyright: 1992, All Rights Reserved
Date Created: 03/23/92 Language: Clipper
Time Created: 14:08:10 Author: Stephen L. Woolstenhulme
Syntax:
aliasname->( PICKLIST() )
NOTE: 'aliasname' is the alias of already open database
of picklist choices.
Parameters: Uses current GET object.
Purpose:
Search a database to see if a particular value is in it.
If not, pop up the database and let user select an item.
Return value:
.t. if xText is found, or .f. if not.
Notes: The first two fields of 'pickfile' are used by this function.
If an indexkey() is set, the function dbSEEKs; otherwise it
dbEvals looking for fieldget( 1 ) to match xText. It uses
fieldname( 1 ) and fieldname( 2 ) as column headers. The first
field is expected to be the key value, the second is a description.
Example:
cCard := ' '
use CARD_DBF index CARD_NTX alias CARDS
@ 10, 10 say 'Pick a card.:' get cCard picture '!' ;
valid CARDS->( picklist( @cCard ) )
------------------------------------------------
Structure of CARD_DBF, for example:
CARDCODE C 1 0
CARDNAME C 10 0
CARDCODE CARDNAME
A Ace
J Jack
K King
Q Queen
------------------------------------------------
*/
#include 'inkey.ch'
function picklist()
local lRetVal := .t., lFound := .t., cScrn := ''
local xSeekVar := getactive():varget()
if ! empty( indexkey() )
lFound := dbseek( xSeekVar, .t. )
if ! lFound
lFound := dbseek( upper( xSeekVar ), .t. )
endif
else
dbgotop()
DBEVAL( { || .t. }, { || .t. }, { || upper( fieldget( 1 ) ) != upper( xSeekVar ) } )
lFound := ! eof()
if ! lFound
dbgotop()
endif
endif
if ! lFound
lRetVal := .f.
// modify the dimensions to fit your data, or check for the
// length of the fields to make it truly "black box."
cScrn := savescreen( 0, 36, maxrow(), maxcol() )
@ 1, 36, 23, maxcol()-1 box "╒═╕│╛═╘│ "
dbEdit( 2, 38, 22, maxcol()-2, { fieldname( 1 ), fieldname( 2 ) } )
restscreen( 0, 36, maxrow(), maxcol(), cScrn )
if lastkey() != K_ESC
getactive():varput( fieldget( 1 ) )
endif
endif
return lRetVal