home *** CD-ROM | disk | FTP | other *** search
/ Power CD-ROM!! 7 / POWERCD7.ISO / prgmming / clipper / gt_valid.prg < prev    next >
Text File  |  1993-10-14  |  5KB  |  181 lines
  1. /*
  2.  * File......: GT_VALID.PRG
  3.  * Author....: George Brennan
  4.  * BBS.......: The Dark Knight Returns
  5.  * Net/Node..: 050/069
  6.  * User Name.: George Brennan
  7.  * Date......: 23/03/93
  8.  * Revision..: 1.0
  9.  *
  10.  * This is an original work by George Brennan and is placed in the public
  11.  * domain.
  12.  *
  13.  * Modification history:
  14.  * ---------------------
  15.  *
  16.  * $Log$
  17.  *
  18.  */
  19.  
  20. // NOTE: This code has been written for and compiled with Clipper 5.01a
  21. //
  22.  
  23.  
  24. /*  $DOC$
  25.  *  $FUNCNAME$
  26.  *        GT_ISKEYVALID()
  27.  *  $CATEGORY$
  28.  *      General
  29.  *  $ONELINER$
  30.  *        Conditionally Validate a dbf index key value as UNIQUE
  31.  *  $SYNTAX$
  32.  *        IsKeyValid( <xKey>, <nMode>, <cAlias>, ;
  33.  *                            <bLookup>, <bAssign> ) -> lOk
  34.  *  $ARGUMENTS$
  35.  *        <cKey>     is a valid key value for the current index.
  36.  *
  37.  *        <nMode>  is a manifest constant to conditionally validate the key
  38.  *
  39.  *        <cAlias> is the file alias to validate against
  40.  *
  41.  *        <bLookup> is a code block to display a lookup/picklist
  42.  *
  43.  *        <bAssign> is a codeblock to assign fields to variables
  44.  *
  45.  *  $RETURNS$
  46.  *        A logical value, .T. if the key is conditionally valid
  47.  *
  48.  *    $DESCRIPTION$
  49.  *        GT_ISKEYVALID() can be used to validate a get against an indexed file,
  50.  *                   to ensure a UNIQUE key value.
  51.  *
  52.  *        to validate a new record as UNIQUE,
  53.  *        to validate an edit of an existing record as UNIQUE,
  54.  *        optionally providing a picklist codeblock on failure,
  55.  *        optionally providing an additional assign codeblock on success.
  56.  *
  57.  *  $EXAMPLES$
  58.  *
  59.  * #define NEWRECORD  1
  60.  * #define DISPEDIT   2
  61.  * #define DISPONLY   3
  62.  * #define LOOKUP      4
  63.  *
  64.  *************************
  65.  *    PROCEDURE test()
  66.  *
  67.  *       cVatId := "  "
  68.  *       nVat   := 0.0
  69.  *
  70.  *       FirstGet( NEWRECORD )
  71.  *       READ
  72.  *
  73.  *       SecondGet( LOOKUP )
  74.  *       READ
  75.  *
  76.  *    RETURN
  77.  **************************
  78.  * function FirstGet( nMode )
  79.  *
  80.  *     @ 08, 20 SAY "Input a New VAT Code   : " GET cVatId    PICTURE "@K!" ;
  81.  *       VALID ISKEYVALID( cVatId, nMode ) ;
  82.  *             when ( nMode == NEWRECORD )
  83.  *
  84.  ***************************
  85.  * function SecondGet( nMode )
  86.  *
  87.  *     @ 10, 20 SAY "Input current VAT Code : " GET cVatId PICTURE "@K!" ;
  88.  *                  VALID ISKEYVALID( cVatId, LOOKUP, "VAT", ;
  89.  *                                    {|| vat( @cVatId, @nVat ) }, ;
  90.  *                                    { || nVat := vat->Vat } )
  91.  *
  92.  *     @ 11, 20 GET nVat PICTURE "99999.99" when ( .F. )
  93.  *
  94.  *    return ( NIL )
  95.  ****************************
  96.  *    where : {|| vat( @cVatId, @nVat ) }
  97.  *           is a codeblock calling a picklist which can assign variables
  98.  *           passed by reference.
  99.  *
  100.  *    and   : { || nVat := vat->Vat } )
  101.  *           is a codeblock which will assign ALIAS->FIELD to the
  102.  *           looked up variable refered to.
  103.  *
  104.  *    $END$
  105.  */
  106.  
  107. #include "gt_lib.ch"    // used to pre-process DEFAULT TO command
  108.  
  109. #define NEWRECORD  1
  110. #define DISPEDIT   2
  111. #define DISPONLY   3
  112. #define LOOKUP       4
  113.  
  114. FUNCTION ISKEYVALID( xKeyExp, nMode, cAlias, bLookup, bAssign )
  115.    LOCAL nStartRec    :=    0
  116.    LOCAL lRecFound    := .T.
  117.    LOCAL lReturn    := .F.
  118.  
  119.    DEFAULT xKeyExp TO &(INDEXKEY( 0 ) )
  120.    DEFAULT nMode  TO DISPONLY
  121.    DEFAULT cAlias TO ALIAS()
  122.    DEFAULT bLookup to {|| .T. }
  123.    DEFAULT bAssign to {|| .T. }
  124.  
  125.    // don't process function if moving  in GETLIST
  126.    IF nMode == DISPONLY .or. lastkey() == K_UP
  127.       lReturn := .T.
  128.    ELSE
  129.        // remember where we started from
  130.       nStartRec    :=    ( cAlias )->( RECNO())
  131.  
  132.        // check to see if the key is in the file
  133.       lRecFound := ( cAlias )->(DBSEEK( xKeyExp ))
  134.       DO CASE
  135.  
  136.       // if a lookup request was made
  137.       CASE nMode == LOOKUP
  138.          if ( lReturn := lRecFound ) == .f.
  139.             if bLookup == NIL
  140.                ALERT("Undefined Value")
  141.             else
  142.                lReturn := eval( bLookup )
  143.             endif
  144.          elseif bAssign != NIL
  145.  
  146.             eval( bAssign )
  147.          endif
  148.  
  149.           // if a new record
  150.       CASE nMode == NEWRECORD
  151.          lReturn := ! lRecFound
  152.          IF ! lReturn
  153.             ALERT("Duplicate Value")
  154.          ENDIF
  155.  
  156.           // if a current record
  157.       CASE nMode == DISPEDIT
  158.          IF lRecFound
  159.             lReturn := ( nStartRec == ( cAlias )->( RECNO() ) )
  160.          ELSE
  161.             lReturn := .T.
  162.          ENDIF
  163.  
  164.          IF ! lReturn
  165.             ALERT("Duplicate Value")
  166.          ENDIF
  167.  
  168.       ENDCASE
  169.  
  170.        // return to original record to leave things tidy
  171.       ( cAlias )->( DBGOTO( nStartRec ) )
  172.  
  173.    ENDIF
  174.  
  175. RETURN ( lReturn )
  176.  
  177. function vat()
  178. dbedit( )
  179.  
  180. return ( NIL )
  181.