*!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!* *!* Program: CurrToText *!* Author: Jared M Anderson (expanded from code by Paul Vlad Tatavu!!) *!* Uses: No2WordE by Paul Vlad Tatavu *!* Description: Transforms a decimal monetary amount (WITHOUT currency symbol such as "$") *!* into its equivalent in English words, in the "text amount" style of a check. *!* (Ex: "255.73" into "Two Hundred Fifty-Five and 73/100 Dollars") *!* Parameters: 1) Number to be transformed *!* 2) String to represent form of currency (default is "Dollars") *!* 3) Number to note number of subdivisions into currency form (default is 100) *!* [ex: 100 cents to dollar, 100 pence to pound] *!* 4) Logical; currency form name is ignored/omitted when true (default is .F.) *!* 5) Logical; fractional part is ignored/omitted when true (default is .F.) *!* 6) Number, minus length of final "text amount", of stars to display following *!* text [in other words, if this number is greater than the length of the text, *!* the number will then represent the length of the entire text including the *!* stars] (default is 0) *!* 7) Logical; the decimal is used as an "and" when true [in other words, the *!* figures following the decimal are used "as-is", no matter what the number *!* of subdivisions] (default is .F.) *!* Syntax/Examples:? CurrToText(1034.23) yields "One Thousand Thirty-Four and 23/100 Dollars" *!* ? CurrToText(1004.23,"Pounds") yields "One Thousand Four and 23/100 Pounds" *!* ? CurrToText(1230.23,,,.T.) yields "One Thousand Two Hundred Thirty and 23/100" *!* ? CurrToText(1234.23,,,.T.,.T.) yields "One Thousand Two Hundred Thirty-Four" *!* ? CurrToText(1032.23,"Pesos",,,.T.) yields "One Thousand Thirty-Two Pesos" *!* ? CurrToText(2.0,"Francs",,,.T.,20) yields "Two Francs *********" *!* ? CurrToText(25.24,,,,,40) yields "Twenty-Five and 24/100 Dollars *********" *!* ? CurrToText(804.003,"Money-os",2000) yields "Eight Hundred Four and 0006/2000 Money-os" *!* ? CurrToText(5.1455,"Money-os",1000) yields "Five and 146/1000 Money-os" *!* ? CurrToText(5.1455,"Money-os",1000,,,,.T.) yields "Six and 455/1000 Money-os" *!* [ The defaults can always be changed to suit ... ] *!* Any bug-finds, comments, or questions, please direct to: janderson@idevgroup.com *!* CurrToText "copyright" 2000 Interactive Data Systems, Inc. & "Paul Vlad Tatavu" *!* NO COST FOR PUBLIC USE, BUT PLEASE GIVE DUE CREDIT IN SOURCE CODE *!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!* PARAMETERS pnNumber, pcCurrency, pnSubD, plOmitCurr, plOmitFrac, pnStars, plSubAsIs *!* Check for empty parameters, set to defaults IF PARAMETERS()<7 or EMPTY(plSubAsIs) plSubAsIs = .F. ENDIF IF PARAMETERS()<6 OR EMPTY(pnStars) pnStars = 0 ENDIF IF PARAMETERS()<5 OR EMPTY(plOmitFrac) plOmitFrac = .F. ENDIF IF PARAMETERS()<4 OR EMPTY(plOmitCurr) plOmitCurr = .F. ENDIF IF PARAMETERS()<3 OR EMPTY(pnSubD) pnSubD = 100 ENDIF IF PARAMETERS()<2 OR EMPTY(pcCurrency) pcCurrency = "Dollars" ENDIF IF PARAMETERS()<1 OR EMPTY(pnNumber) pnNumber = 0.0 ENDIF PRIVATE nSubs, nCurrs, cTextAmount, nLength, nStar, cNumber, nDecPlaces, nGetDecPlaces *!* If the portion following the decimal is to be used as-is IF plSubAsIs nDecPlaces = 0 nGetDecPlaces = pnNumber *!* Find the number of decimal places to read past decimal for string DO WHILE nGetDecPlaces % 1 <> 0 nGetDecPlaces = nGetDecPlaces * 10 nDecPlaces = nDecPlaces + 1 ENDDO *!* Put number in string cNumber = ALLTRIM(STR(pnNumber,25,nDecPlaces)) *!* If there is a decimal in the string IF '.' $ cNumber *!* Grab what follows as-is nSubs = INT(VAL(SUBSTR(cNumber,RAT('.',cNumber)+1,LEN(cNumber)-RAT('.',cNumber)))) ELSE *!* Otherwise set to zero nSubs = 0 ENDIF ELSE *!* Otherwise, get fractional numerator (pnSubD is the denominator) nSubs = ROUND(((pnNumber - FLOOR(pnNumber)) * pnSubD),0) ENDIF *!* If the numerator >= the denominator, this is at least One IF nSubs >= pnSubD nCurrs = pnNumber DO WHILE nSubs >= pnSubD *!* Store the whole number plus appropriate amount and update the numerator nCurrs = nCurrs + 1 nSubs = nSubs - pnSubD ENDDO ELSE *!* Otherwise, store the whole number, leaving it and the numerator alone nCurrs = pnNumber ENDIF *!* Tatavu's No2WordE program!! cTextAmount = No2WordE(nCurrs) *!* *!* If we are including the fractional IF !plOmitFrac *!* Append cTextAmount with result of SubsForCurr (the fractional portion) cTextAmount = cTextAmount + " and " + SubsForCurr(nSubs,pnSubD) ENDIF *!* If we are including the currency name IF !plOmitCurr *!* Append cTextAmount with the currency name cTextAmount = cTextAmount + " " + PROPER(pcCurrency) ENDIF *!* If stars were specified to be included IF pnStars > 0 nLength = LEN(cTextAmount) *!* If number of stars is greater than length of text (plus a padding space) IF pnStars > nLength + 1 *!* Add padding space cTextAmount = cTextAmount + " " *!* Increase length accordingly nLength = nLength + 1 *!* Add appropriate number of stars to make total length equal to pnStars FOR nStar = pnStars TO nLength+1 STEP -1 cTextAmount = cTextAmount + "*" ENDFOR ENDIF ENDIF *!* Return the finalized text amount RETURN cTextAmount && END program CurrToText *!!!!!!!!* FUNCTION SubsForCurr LPARAMETERS nSubs, nSubD PRIVATE cSubs, nShrink, nSubTemp, nCutOff, nGrow *!* Initialize cSubs = "" nSubTemp = nSubD nShrink = 0 *!* Find out how many places there are in front of the decimal in nSubD DO WHILE nSubTemp > 1 nSubTemp = nSubTemp / 10 nShrink = nShrink + 1 ENDDO *!* Determine the number of leading zeros needed for the numerator and add them nCutOff = 1 FOR nGrow = 1 TO nShrink-1 nCutOff = nCutOff * 10 IF nSubs < nCutOff cSubs = cSubs + "0" ENDIF ENDFOR *!* Add the actual numerator value, the dividing line, and the denominator cSubs = cSubs + ALLTRIM(STR(nSubs)) + "/" + ALLTRIM(STR(nSubD)) *!* Return the finalized fractional text RETURN cSubs ENDFUNC && SubsForCurr *!!!!!!!!* *!* Following line added by Jared M Anderson for insertion into CurrToText.prg FUNCTION No2WordE && by Paul Vlad Tatavu *!* * Program...........: No2WordE * Author............: Paul Vlad Tatavu * Description.......: Transforms a number into its equivalent in words in * : English. It drops any fractional part. * : * : It works with negative numbers. * : * Calling Samples...: ? No2WordE( 1234.23) * : * Parameters........: 1. The number to be transformed PARAMETERS pnNumber PRIVATE lcNumber, lnLen, lcReturn, lnI, lcHundred, lcTens, lcSign *-- Get the sign IF pnNumber < 0 lcSign="Minus " pnNumber=-pnNumber ELSE lcSign="" ENDIF IF INT( pnNumber) = 0 RETURN "Zero" ENDIF *-- Transform the number to string and pad it to the left with zeros up to *-- the first length multiple of 3 lcNumber=LTRIM( STR( INT( pnNumber), 18)) lnLen=LEN( lcNumber) lnLen=INT( lnLen/3+1)*3 lcNumber=PADL( lcNumber, lnLen, "0") lcReturn="" *-- Parse the string and transform each group of 3 digits *-- It starts from the end of the string, so lnI=1 is the right most group FOR lnI=1 TO lnLen/3 *-- The string for hundreds lcHundred=Digit( SUBSTR( lcNumber, lnLen-lnI*3+1, 1)) IF NOT EMPTY( lcHundred) lcHundred=lcHundred+" Hundred" ENDIF *-- The string for tens lcTens=Tens( SUBSTR( lcNumber, lnLen-lnI*3+2, 2)) *-- Add tens string to hundreds string IF NOT EMPTY( lcTens) IF NOT EMPTY( lcHundred) lcHundred=lcHundred+" "+lcTens ELSE lcHundred=lcTens ENDIF ENDIF *-- Add the group type string: Thousand, Million, Billion or Trillion IF NOT EMPTY( lcHundred) DO CASE CASE lnI = 2 lcReturn=lcHundred+" Thousand"+; IIF( EMPTY( lcReturn), "", " ")+lcReturn CASE lnI = 3 lcReturn=lcHundred+" Million"+; IIF( EMPTY( lcReturn), "", " ")+lcReturn CASE lnI = 4 lcReturn=lcHundred+" Billion"+; IIF( EMPTY( lcReturn), "", " ")+lcReturn CASE lnI = 5 lcReturn=lcHundred+" Trillion"+; IIF( EMPTY( lcReturn), "", " ")+lcReturn OTHERWISE lcReturn=lcHundred ENDCASE ENDIF ENDFOR RETURN lcSign+lcReturn && No2WordE *!* Following line added by Jared M Anderson for insertion into CurrToText.prg ENDFUNC *!* *====================================================================== FUNCTION Tens PARAMETERS pcNumber PRIVATE lcTens, lcUnits, lcReturn lcTens=LEFT( pcNumber, 1) lcUnits=RIGHT( pcNumber, 1) DO CASE CASE lcTens = "0" && >= 0 and <= 9 lcReturn=Digit( lcUnits) CASE lcTens = "1" && >= 10 and <= 19 DO CASE CASE lcUnits = "0" lcReturn="Ten" CASE lcUnits = "1" lcReturn="Eleven" CASE lcUnits = "2" lcReturn="Twelve" CASE lcUnits = "3" lcReturn="Thirteen" CASE lcUnits = "4" lcReturn="Fourteen" CASE lcUnits = "5" lcReturn="Fifteen" CASE lcUnits = "6" lcReturn="Sixteen" CASE lcUnits = "7" lcReturn="Seventeen" CASE lcUnits = "8" lcReturn="Eighteen" CASE lcUnits = "9" lcReturn="Nineteen" ENDCASE OTHERWISE && >= 20 and <= 99 DO CASE CASE lcTens = "2" lcReturn="Twenty" CASE lcTens = "3" lcReturn="Thirty" CASE lcTens = "4" lcReturn="Forty" CASE lcTens = "5" lcReturn="Fifty" CASE lcTens = "6" lcReturn="Sixty" CASE lcTens = "7" lcReturn="Seventy" CASE lcTens = "8" lcReturn="Eighty" CASE lcTens = "9" lcReturn="Ninety" ENDCASE lcUnits=Digit( lcUnits) IF NOT EMPTY( lcUnits) lcReturn=lcReturn+"-"+lcUnits ENDIF ENDCASE RETURN lcReturn && Tens ENDFUNC *====================================================================== FUNCTION Digit PARAMETERS pcDigit PRIVATE lcReturn DO CASE CASE pcDigit = "0" lcReturn="" CASE pcDigit = "1" lcReturn="One" CASE pcDigit = "2" lcReturn="Two" CASE pcDigit = "3" lcReturn="Three" CASE pcDigit = "4" lcReturn="Four" CASE pcDigit = "5" lcReturn="Five" CASE pcDigit = "6" lcReturn="Six" CASE pcDigit = "7" lcReturn="Seven" CASE pcDigit = "8" lcReturn="Eight" CASE pcDigit = "9" lcReturn="Nine" ENDCASE RETURN lcReturn && Digit ENDFUNC