home *** CD-ROM | disk | FTP | other *** search
/ Power-Programmierung / CD1.mdf / xbase / library / dbase / picklist / picklist.prg < prev   
Encoding:
Text File  |  1992-07-12  |  2.7 KB  |  94 lines
  1. /*
  2.  
  3.     Program Name: PICKLIST.PRG     Copyright: 1992, All Rights Reserved                                                
  4.     Date Created: 03/23/92         Language: Clipper                                             
  5.     Time Created: 14:08:10         Author: Stephen L. Woolstenhulme
  6.  
  7. Syntax:
  8.  
  9.             aliasname->( PICKLIST() )
  10.  
  11.             NOTE:  'aliasname' is the alias of already open database
  12.                    of picklist choices.
  13.  
  14.  Parameters:  Uses current GET object.
  15.  
  16.  Purpose:  
  17.             Search a database to see if a particular value is in it.
  18.             If not, pop up the database and let user select an item.
  19.  
  20.  
  21.  Return value:  
  22.             .t. if xText is found, or .f. if not.
  23.  
  24.  Notes:  The first two fields of 'pickfile' are used by this function.
  25.          If an indexkey() is set, the function dbSEEKs; otherwise it
  26.          dbEvals looking for fieldget( 1 ) to match xText.  It uses
  27.          fieldname( 1 ) and fieldname( 2 ) as column headers.  The first
  28.          field is expected to be the key value, the second is a description.
  29.  
  30.  Example:
  31.         cCard := ' '
  32.         use CARD_DBF index CARD_NTX alias CARDS
  33.  
  34.         @ 10, 10 say 'Pick a card.:' get cCard picture '!' ;
  35.                  valid CARDS->( picklist( @cCard ) )
  36.  
  37.         ------------------------------------------------
  38.         Structure of CARD_DBF, for example:
  39.  
  40.                   CARDCODE  C   1  0
  41.                   CARDNAME  C  10  0
  42.  
  43.                   CARDCODE  CARDNAME
  44.                          A  Ace
  45.                          J  Jack
  46.                          K  King
  47.                          Q  Queen
  48.         ------------------------------------------------
  49. */
  50.  
  51. #include 'inkey.ch'
  52.  
  53. function picklist()
  54.     local lRetVal := .t., lFound := .t., cScrn := ''
  55.  
  56.     local xSeekVar := getactive():varget()
  57.  
  58.     if ! empty( indexkey() )
  59.        lFound := dbseek( xSeekVar, .t. )
  60.  
  61.        if ! lFound
  62.            lFound := dbseek( upper( xSeekVar ), .t. )
  63.        endif
  64.  
  65.     else
  66.        dbgotop()
  67.        DBEVAL( { || .t. }, { || .t. }, { || upper( fieldget( 1 ) ) != upper( xSeekVar ) } )
  68.        lFound := ! eof()
  69.        
  70.        if ! lFound
  71.            dbgotop()
  72.        endif
  73.  
  74.     endif
  75.  
  76.     if ! lFound
  77.         lRetVal := .f.
  78.  
  79.         // modify the dimensions to fit your data, or check for the
  80.         // length of the fields to make it truly "black box."
  81.  
  82.         cScrn := savescreen( 0, 36, maxrow(), maxcol() )
  83.         @ 1, 36, 23, maxcol()-1 box "╒═╕│╛═╘│ "
  84.         dbEdit( 2, 38, 22, maxcol()-2, { fieldname( 1 ), fieldname( 2 ) } )
  85.         restscreen( 0, 36, maxrow(), maxcol(), cScrn )
  86.         
  87.         if lastkey() != K_ESC
  88.             getactive():varput( fieldget( 1 ) )
  89.         endif
  90.  
  91.     endif
  92.  
  93. return lRetVal
  94.