home *** CD-ROM | disk | FTP | other *** search
/ Media Share 9 / MEDIASHARE_09.ISO / progmisc / nfsrc21.zip / ANY2ANY.PRG < prev    next >
Text File  |  1991-08-16  |  7KB  |  173 lines
  1. /*
  2.  * File......: Any2Any.Prg
  3.  * Author....: David Husnian
  4.  * Date......: $Date:   15 Aug 1991 23:02:46  $
  5.  * Revision..: $Revision:   1.2  $
  6.  * Log file..: $Logfile:   E:/nanfor/src/any2any.prv  $
  7.  * 
  8.  * This is an original work by David Husnian and is placed in the
  9.  * public domain.
  10.  *
  11.  * Modification history:
  12.  * ---------------------
  13.  *
  14.  * $Log:   E:/nanfor/src/any2any.prv  $
  15.  * 
  16.  *    Rev 1.2   15 Aug 1991 23:02:46   GLENN
  17.  * Forest Belt proofread/edited/cleaned up doc
  18.  * 
  19.  *    Rev 1.1   14 Jun 1991 19:50:54   GLENN
  20.  * Minor edit to file header
  21.  * 
  22.  *    Rev 1.0   01 Apr 1991 01:00:34   GLENN
  23.  * Nanforum Toolkit
  24.  *
  25.  */
  26.  
  27.  
  28. /*  $DOC$
  29.  *  $FUNCNAME$
  30.  *     FT_XTOY()
  31.  *  $CATEGORY$
  32.  *     Conversion
  33.  *  $ONELINER$
  34.  *     Convert from any data type to any other data type
  35.  *  $SYNTAX$
  36.  *     FT_XTOY( <xValueToConvert>, <cTypeToConvertTo> ;
  37.  *              [, <lWantYesNo> ] ) -> xResult
  38.  *  $ARGUMENTS$
  39.  *     <xValueToConvert> is the value to convert.
  40.  *
  41.  *     <cTypeToConvertTo> is the type of value to convert to
  42.  *     ("C","D","L","N","A" or "B").
  43.  *
  44.  *     <lWantYesNo> is a logical to signal if 'Y' or 'N' is to be returned
  45.  *     if Converting a logical, otherwise '.T.' or '.F.' will be returned
  46.  *     for logicals.
  47.  *  $RETURNS$
  48.  *     The original value converted to the new type.
  49.  *  $DESCRIPTION$
  50.  *     This function converts a value of character, date, numeric, logical,
  51.  *     array or code block type to any of the other type.  While it is
  52.  *     guaranteed to return a value of the correct type, that value may not
  53.  *     be meaningful (i.e., converting from a code block returns an EMPTY()
  54.  *     value of the desired type).
  55.  *  $EXAMPLES$
  56.  *     nNumericValue := FT_XTOY(cInputValue, "N")
  57.  *     IF (FT_XTOY(nInputValue, "L"))
  58.  *  $END$
  59.  */
  60.  
  61.  
  62. #define BLOCKIFY(x)                  { || x }
  63. #define IS_CHAR(x)                   (VALTYPE(x) == "C")
  64. #define IS_DATE(x)                   (VALTYPE(x) == "D")
  65. #define IS_LOGICAL(x)                (VALTYPE(x) == "L")
  66. #define IS_NUMERIC(x)                (VALTYPE(x) == "N")
  67. #define CASE_AT(x,y,z)               z[AT(x,y)+1]
  68. #define TRIM_NUMBER(x)               LTRIM(STR(x))
  69. #define NULL                         ""
  70. #define IS_NOT_CHAR(x)               (VALTYPE(x) != "C")
  71. #define IS_NOT_DATE(x)               (VALTYPE(x) != "D")
  72. #define EARLIEST_DATE                CTOD("01/01/0100")
  73. #define BLANK_DATE                   CTOD(NULL)
  74. #define IS_NOT_ARRAY(x)              (VALTYPE(x) != "A")
  75. #define IS_NOT_LOGICAL(x)            (VALTYPE(x) != "L")
  76. #define IS_NOT_NUMERIC(x)            (VALTYPE(x) != "N")
  77. #define IS_NOT_CODE_BLOCK(x)         (VALTYPE(x) != "B")
  78. #define TRUE                         (.t.)
  79. #define FALSE                        (.f.)
  80.  
  81. #Define XTOC(x)           CASE_AT(VALTYPE(x), "CNDLM", ;
  82.                              { NULL, ;
  83.                                x, ;
  84.                                IF(IS_NUMERIC(x),;
  85.                                   TRIM_NUMBER(x), ;
  86.                                   NULL), ;
  87.                                IF(IS_DATE(x),DTOC(x),NULL),;
  88.                                IF(IS_LOGICAL(x),;
  89.                                   IF(x,".T.",".F."), ;
  90.                                   NULL), ;
  91.                                x })
  92.  
  93. #command    DEFAULT <Param1> TO <Def1> [, <ParamN> TO <DefN> ] ;
  94.             => ;
  95.             <Param1> := IF(<Param1> == NIL,<Def1>,<Param1>) ;
  96.          [; <ParamN> := IF(<ParamN> == NIL,<DefN>,<ParamN>)]
  97.  
  98.  
  99. FUNCTION FT_XTOY(xValueToConvert, cTypeToConvertTo, lWantYesNo)
  100.  
  101.    DEFAULT lWantYesNo TO FALSE
  102.  
  103.    DO CASE
  104.  
  105.       CASE cTypeToConvertTo == "C" .AND.; // They Want a Character String
  106.            IS_NOT_CHAR(xValueToConvert)
  107.  
  108.          xValueToConvert := XTOC(xValueToConvert)
  109.  
  110.       CASE cTypeToConvertTo == "D" .AND.; // They Want a Date
  111.            IS_NOT_DATE(xValueToConvert)
  112.  
  113.  
  114.          xValueToConvert := IF(IS_CHAR(xValueToConvert), ;
  115.                                       ; // Convert from a Character
  116.                                CTOD(xValueToConvert), ;
  117.                                IF(IS_NUMERIC(xValueToConvert), ;
  118.                                       ; // Convert from a Number
  119.                                   xValueToConvert + EARLIEST_DATE, ;
  120.                                   IF(IS_LOGICAL(xValueToConvert), ;
  121.                                       ; // Convert from a Logical
  122.                                      IF(xValueToConvert, DATE(), BLANK_DATE), ;
  123.                                       ; // Unsupported Type
  124.                                      BLANK_DATE)))
  125.  
  126.       CASE cTypeToConvertTo == "N" .AND.; // They Want a Number
  127.            IS_NOT_NUMERIC(xValueToConvert)
  128.  
  129.  
  130.          xValueToConvert := IF(IS_CHAR(xValueToConvert), ;
  131.                                       ; // Convert from a Character
  132.                                VAL(xValueToConvert), ;
  133.                                IF(IS_DATE(xValueToConvert), ;
  134.                                       ; // Convert from a Date
  135.                                   xValueToConvert - EARLIEST_DATE, ;
  136.                                   IF(IS_LOGICAL(xValueToConvert), ;
  137.                                       ; // Convert from a Logical
  138.                                      IF(xValueToConvert, 1, 0), ;
  139.                                       ; // Unsupported Type
  140.                                      0)))
  141.  
  142.       CASE cTypeToConvertTo == "L" .AND.; // They Want a Logical
  143.            IS_NOT_LOGICAL(xValueToConvert)
  144.  
  145.  
  146.          xValueToConvert := IF(IS_CHAR(xValueToConvert), ;
  147.                                       ; // Convert from a Character
  148.                                UPPER(xValueToConvert) == IF(lWantYesNo,"Y",".T."), ;
  149.                                IF(IS_DATE(xValueToConvert), ;
  150.                                       ; // Convert from a Date
  151.                                   ! EMPTY(xValueToConvert), ;
  152.                                   IF(IS_NUMERIC(xValueToConvert), ;
  153.                                       ; // Convert from a Number
  154.                                      xValueToConvert != 0, ;
  155.                                       ; // Unsupported Type
  156.                                      FALSE)))
  157.  
  158.       CASE cTypeToConvertTo == "A" .AND.; // They Want an Array
  159.            IS_NOT_ARRAY(xValueToConvert)
  160.  
  161.  
  162.          xValueToConvert := { xValueToConvert }
  163.  
  164.       CASE cTypeToConvertTo == "B" .AND.; // They Want a Code Block
  165.            IS_NOT_CODE_BLOCK(xValueToConvert)
  166.  
  167.  
  168.          xValueToConvert := BLOCKIFY(xValueToConvert)
  169.  
  170.    ENDCASE
  171.  
  172.    RETURN (xValueToConvert)             // XToY
  173.