home *** CD-ROM | disk | FTP | other *** search
/ Programmer 7500 / MAX_PROGRAMMERS.iso / INFO / CLIPPER / NFSRC.ZIP / SQZN.PRG < prev    next >
Encoding:
Text File  |  1991-08-16  |  3.9 KB  |  140 lines
  1. /*
  2.  * File......: SQZN.PRG
  3.  * Author....: Joseph D. Booth, Sr.
  4.  * CIS ID....: 72040,2112
  5.  * Date......: $Date:   15 Aug 1991 23:04:38  $
  6.  * Revision..: $Revision:   1.1  $
  7.  * Log file..: $Logfile:   E:/nanfor/src/sqzn.prv  $
  8.  * 
  9.  * This is an original work by Joseph D. Booth Sr. and is placed in the
  10.  * public domain.
  11.  *
  12.  * Modification history:
  13.  * ---------------------
  14.  *
  15.  * $Log:   E:/nanfor/src/sqzn.prv  $
  16.  * 
  17.  *    Rev 1.1   15 Aug 1991 23:04:38   GLENN
  18.  * Forest Belt proofread/edited/cleaned up doc
  19.  * 
  20.  *    Rev 1.0   13 Jun 1991 15:21:36   GLENN
  21.  * Initial revision.
  22.  *
  23.  */
  24.  
  25.  
  26. /*  $DOC$
  27.  *  $FUNCNAME$
  28.  *     FT_SQZN()
  29.  *  $CATEGORY$
  30.  *     Conversion
  31.  *  $ONELINER$
  32.  *     Compress a numeric value into a character string
  33.  *  $SYNTAX$
  34.  *     FT_SQZN( <nValue> [, <nSize> [, <nDecimals> ] ] ) -> cCompressed
  35.  *  $ARGUMENTS$
  36.  *     nValue       - The numeric value to be compressed
  37.  *     nSize        - Optional size of numeric field, defaults to 10
  38.  *     nDecimals    - Optional number of decimal places, defaults to 0
  39.  *  $RETURNS$
  40.  *     cCompressed  - Compressed string, 50% the size of nSize
  41.  *  $DESCRIPTION$
  42.  *
  43.  *    The FT_SQZN function allows a numeric value to be compressed when
  44.  *    stored in the database.  The compression is 50% the storage space
  45.  *    of the original number.  The companion function, FT_UNSQZN returns
  46.  *    the original number from the compressed string.
  47.  *
  48.  *  $EXAMPLES$
  49.  *
  50.  *  replace TRANS->cust_id with FT_SQZN(mcust_id,8),;
  51.  *          TRANS->amount  with FT_SQZN(mamount,12,2)
  52.  *
  53.  *  $SEEALSO$
  54.  *      FT_UNSQZN()
  55.  *  $INCLUDE$
  56.  *
  57.  *  $END$
  58.  */
  59.  
  60. function ft_sqzn(nValue,nSize,nDecimals)
  61.   local tmpstr,cCompressed,k
  62.  
  63.   nSize       := if(nSize    ==NIL,10,nSize )
  64.   nDecimals   := if(nDecimals==NIL, 0,nDecimals )
  65.   nValue      := nValue * (10**nDecimals)
  66.   nSize       := if(nSize/2<>int(nSize/2),nSize+1,nSize)
  67.   tmpstr      := str( abs(nValue),nSize )
  68.   tmpstr      := strtran(tmpstr," ","0")
  69.   cCompressed := chr( val(substr(tmpstr,1,2))+if(nValue<0,128,0) )
  70.  
  71.   for k := 3 to len(tmpstr) step 2
  72.      cCompressed += chr(val(substr(tmpstr,k,2)))
  73.   next
  74.   return cCompressed
  75.  
  76.  
  77.  
  78. /*  $DOC$
  79.  *  $FUNCNAME$
  80.  *     FT_UNSQZN()
  81.  *  $CATEGORY$
  82.  *     Conversion
  83.  *  $ONELINER$
  84.  *     Uncompress a numeric compressed by FT_SQZN()
  85.  *  $SYNTAX$
  86.  *     FT_UNSQZN( <cCompressed>, <nSize> [, <nDecimals> ] ) -> nValue
  87.  *  $ARGUMENTS$
  88.  *     <cCompressed>  - Compressed string, obtained from FT_SQZN()
  89.  *
  90.  *     <nSize>        - Size of numeric field
  91.  *
  92.  *     <nDecimals>    - Optional number of decimal places
  93.  *  $RETURNS$
  94.  *     nValue       - Uncompressed numeric value
  95.  *  $DESCRIPTION$
  96.  *
  97.  *    The FT_UNSQZN function returns the numeric value from the compressed
  98.  *    string.  The compression is 50% the storage space of the original
  99.  *    number.  The original number must have been compressed using the
  100.  *    FT_SQZN() function.
  101.  *
  102.  *    This function, along with FT_SQZN() can be used to reduce disk storage
  103.  *    requirements for numeric fields in a database file.
  104.  *
  105.  *  $EXAMPLES$
  106.  *
  107.  *    mcust_id := FT_UNSQZN(TRANS->cust_id,8),;
  108.  *    mamount  := FT_UNSQZN(TRANS->amount,12,2)
  109.  *
  110.  *  $SEEALSO$
  111.  *    FT_SQZN()
  112.  *  $INCLUDE$
  113.  *
  114.  *  $END$
  115.  */
  116.  
  117.  
  118. function ft_unsqzn(cCompressed,nSize,nDecimals)
  119.   local tmp:="",k,cValue,multi:=1
  120.  
  121.   nSize       := if(nSize    ==NIL,10,nSize )
  122.   nDecimals   := if(nDecimals==NIL, 0,nDecimals)
  123.   cCompressed := if(multi    ==-1,substr(cCompressed,2),cCompressed)
  124.   nSize       := if(nSize/2<>int(nSize/2),nSize+1,nSize)
  125.   if asc(cCompressed) > 127
  126.      tmp         := str(asc(cCompressed)-128,2)
  127.      multi       := -1
  128.   else
  129.      tmp         := str(asc(cCompressed),2)
  130.   endif
  131.  
  132.   for k := 2 to len(cCompressed)
  133.      tmp += str(asc(substr(cCompressed,k,1)),2)
  134.   next
  135.  
  136.   tmp    := strtran(tmp," ","0")
  137.   cValue := substr(tmp,1,nSize-nDecimals)+"."+substr(tmp,nSize-nDecimals+1)
  138.  
  139.   return val(cValue) * multi
  140.