ValC() didn't check that the given value was a valid number! Doh!
Updated code is below.
=======================================
Update - 25th April 2008.
Have altered the (Windows only) FormatCurrency() function to allow the user to over-ride a couple of the user's default locale currency format settings. You can now specify the number of digits to be displayed after the decimal point, so, for example, you can opt to display all 4 fractional digits etc. Also, you can opt to remove the currency symbol from the formatted string; £, $ etc.
Updated code is below.
=======================================
Hi,
in need of a simple mechanism for using 'currency' type variables I quickly hacked up the following little library. All the existing solutions I found in these forums didn't quite give me what I needed.
The advantage of having a currency type is that there is no reliance whatsoever on floating point arithmetic and so there will be no rounding errors. This is essential when dealing with financial calculations.
My implementation simply utilises 64-bit signed integers (quads) in which the least significant 4 digits represent the fractional part. (I chose 4 digits because this should cover just about every kind of currency).
The point is that all calculations using the currency types are exact up to an accuracy of 4 decimal places, i.e. there will be no rounding errors.
List of functions :
- ValC(value$) - Converts a string representation of a currency value to a true currency type.
- StrC(cur.currency) - Converts a true currency type to a string.
- MultC(a.currency, b.currency) - Multiplys two currency values and returns the result in currency form.
- DivC(a.currency, b.currency) - Divides two currency values and returns the result in currency form (it doesn't really make sense to do this!)
- FormatCurrency(cur.currency) - WINDOWS ONLY! Returns a string in which the given currency value has been formatted depending on the computer's locale etc.
Code: Select all
;/////////////////////////////////////////////////////////////////////////////////
;***Currency***
;
;©nxSoftWare 2008.
;=================
; Stephen Rodriguez (srod)
; Created with Purebasic 4.2 for Windows.
;
; Platforms: ALL.
; Only the FormatCurrency() function is Windows specific, but is only included
; in the compilation under Windows platforms.
;
; Fully Unicode compliant and threadsafe.
;/////////////////////////////////////////////////////////////////////////////////
;/////////////////////////////////////////////////////////////////////////////////
;-NOTES.
;
; i) A currency type variable is a signed quad type in which the least significant 4 digits
; represent the fractional part of the value.
; Basic arithmetic operations are thus not subject to rounding.
;
; ii) All operations on currency values (including conversion to/from strings) operate
; on all 4 decimal digits. That is, no account is taken of the currency format specified
; in the underlying locale etc. The (Windows only) function FormatCurrency() can be used
; for this purpose.
;
; iii) The following operations can be performed on currency values directly, with the result
; being another valid currency value :
; -addition of two currency values (use the + operator as usual)
; -subtraction of two currency values (use the - operator as usual)
; -multiplication/division of a currency value by an INTEGER (use the usual * and / operators)
;
; iv) Multiplying two currency values requires the use of the MultC() function, which
; returns another currency value.
;
; v) Division of two currency values - there are 2 cases to consider.
; --------------------------------
; a) Use of the normal / operator upon two currency values will return an INTEGER quotient.
; E.g. £6.50 / £2 will return the integer value 3.
; b) The function DivC() will return a currency value. Such a division is actually
; quite meaningless, but is included for completeness!
; E.g. DivC(6.50, 2) will return the currency value 3.25.
;/////////////////////////////////////////////////////////////////////////////////
;/////////////////////////////////////////////////////////////////////////////////
;-MACROS.
;Set up a currency type.
Macro currency
q
EndMacro
;/////////////////////////////////////////////////////////////////////////////////
EnableExplicit
;/////////////////////////////////////////////////////////////////////////////////
;The following function divides two currency values and returns an integer result.
;E.g. DivC(6.50, 2) will return the currency value of 3.25.
Procedure.currency DivC(a.currency, b.currency)
If b
a*10000
a/b
ProcedureReturn a
EndIf
ProcedureReturn 0
EndProcedure
;/////////////////////////////////////////////////////////////////////////////////
;/////////////////////////////////////////////////////////////////////////////////
;The following function multiplies two currency values and returns a third currency value.
Procedure.currency MultC(a.currency, b.currency)
Protected result.currency = a*b/10000
ProcedureReturn result
EndProcedure
;/////////////////////////////////////////////////////////////////////////////////
;/////////////////////////////////////////////////////////////////////////////////
;The following function converts a currency value to a string.
Procedure.s StrC(cur.currency)
Protected result$
If cur<0
result$="-"
cur=-cur
EndIf
result$ + StrQ(cur/10000) + "." + RSet(StrQ(cur%10000),4,"0")
ProcedureReturn result$
EndProcedure
;/////////////////////////////////////////////////////////////////////////////////
;/////////////////////////////////////////////////////////////////////////////////
;The following function converts a string representation of a currency value to a
;currency type.
;Any string with more than 4 places of decimals is rounded.
Procedure.currency ValC(value$)
Protected result.currency, i, char
Protected blnNegative, posDec, len, count, int$, dec$
value$ = Trim(value$)
count = CountString(value$,".")
If value$ And count<=1
len = Len(value$)
;Check a valid decimal number.
For i = 1 To len
char = Asc(Mid(value$,i,1))
If char<>'.' And (char<'0' Or char>'9') And (char<>'-' Or i > 1)
ProcedureReturn 0
EndIf
Next
If count = 0
result = ValQ(value$)*10000
Else
If Left(value$,1)="-"
blnNegative = #True
value$ = Right(value$,len-1)
len-1
EndIf
posDec = FindString(value$,".", 1)
int$ = Left(value$, posDec-1)
dec$ = Right(value$, len-posDec)
result = ValQ(int$)*10000 + ValQ(LSet(dec$,4,"0"))
If Asc(Mid(dec$,5,1)) >= '5'
result+1
EndIf
If blnNegative
result=-result
EndIf
EndIf
EndIf
ProcedureReturn result
EndProcedure
;/////////////////////////////////////////////////////////////////////////////////
;/////////////////////////////////////////////////////////////////////////////////
;The following (Windows only) function formats the given currency value depending on
;the computer's locale etc. We allow certain fields to be over-ridden with the optional parameters.
;Leave the optional parameters blank in order to use the user's defaults.
;Otherwise, numDecimals specifies how many digits will appear after the decimal point,
;and blnShowCurrencySymbol specifies whether the currency symbol will appear or not?
CompilerIf #PB_Compiler_OS = #PB_OS_Windows
Procedure.s FormatCurrency(cur.currency, numDecimals=-1, blnShowCurrencySymbol=-1)
Protected val$, numChars, buffer$
Protected currency.CURRENCYFMT
Protected decimal$, thousands$, currency$
val$ = StrC(cur)
If numDecimals = -1 And blnShowCurrencySymbol = -1
numChars = GetCurrencyFormat_(0,0,val$,0,0,0)
buffer$ = Space(numChars+1)
GetCurrencyFormat_(0,0,val$,0,@buffer$,numChars)
ProcedureReturn buffer$
Else ;First load the defaults.
currency\Grouping = 3
;LOCALE_IDIGITS
currency\NumDigits = numDecimals
If numDecimals = -1
numChars = GetLocaleInfo_(#LOCALE_USER_DEFAULT,#LOCALE_IDIGITS,buffer$,0)
buffer$ = Space(numChars+1)
GetLocaleInfo_(#LOCALE_USER_DEFAULT,#LOCALE_IDIGITS,buffer$,numChars)
currency\NumDigits = Val(buffer$)
EndIf
;LOCALE_ILZERO
numChars = GetLocaleInfo_(#LOCALE_USER_DEFAULT,#LOCALE_ILZERO,buffer$,0)
buffer$ = Space(numChars+1)
GetLocaleInfo_(#LOCALE_USER_DEFAULT,#LOCALE_ILZERO,buffer$,numChars)
currency\LeadingZero = Val(buffer$)
;LOCALE_SDECIMAL
numChars = GetLocaleInfo_(#LOCALE_USER_DEFAULT,#LOCALE_SDECIMAL,decimal$,0)
decimal$ = Space(numChars+1)
GetLocaleInfo_(#LOCALE_USER_DEFAULT,#LOCALE_SDECIMAL,decimal$,numChars)
currency\lpDecimalSep = @decimal$
;LOCALE_STHOUSAND
numChars = GetLocaleInfo_(#LOCALE_USER_DEFAULT,#LOCALE_STHOUSAND,thousands$,0)
thousands$ = Space(numChars+1)
GetLocaleInfo_(#LOCALE_USER_DEFAULT,#LOCALE_STHOUSAND,thousands$,numChars)
currency\lpThousandSep = @thousands$
;LOCALE_INEGCURR
numChars = GetLocaleInfo_(#LOCALE_USER_DEFAULT,#LOCALE_INEGCURR,buffer$,0)
buffer$ = Space(numChars+1)
GetLocaleInfo_(#LOCALE_USER_DEFAULT,#LOCALE_INEGCURR,buffer$,numChars)
currency\NegativeOrder = Val(buffer$)
;LOCALE_ICURRENCY
numChars = GetLocaleInfo_(#LOCALE_USER_DEFAULT,#LOCALE_ICURRENCY,buffer$,0)
buffer$ = Space(numChars+1)
GetLocaleInfo_(#LOCALE_USER_DEFAULT,#LOCALE_ICURRENCY,buffer$,numChars)
currency\PositiveOrder = Val(buffer$)
;LOCALE_SCURRENCY
If blnShowCurrencySymbol = 0
currency\lpCurrencySymbol = @""
Else
numChars = GetLocaleInfo_(#LOCALE_USER_DEFAULT,#LOCALE_SCURRENCY,currency$,0)
currency$ = Space(numChars+1)
GetLocaleInfo_(#LOCALE_USER_DEFAULT,#LOCALE_SCURRENCY,currency$,numChars)
currency\lpCurrencySymbol = @currency$
EndIf
;Format the string.
numChars = GetCurrencyFormat_(0,0,val$,currency,0,0)
buffer$ = Space(numChars+1)
GetCurrencyFormat_(0,0,val$,currency,@buffer$,numChars)
ProcedureReturn buffer$
EndIf
EndProcedure
CompilerEndIf
;/////////////////////////////////////////////////////////////////////////////////
DisableExplicit
;=================================================================================
;TEST.
;Set up two currency values, in my locale, £6.50 and £2.00.
a.currency = ValC("6.5005")
b.currency = ValC("2")
;A couple of simple manipulations using our standard operators.
Debug "Half of £6.50 (unformatted) = " + StrC(a/2)
CompilerIf #PB_Compiler_OS = #PB_OS_Windows
Debug "Half of £6.50 (formatted) = " + FormatCurrency(a/2)
CompilerEndIf
;Some binary currency operations.
c.currency = a+b
Debug "The sum of £6.50 and £2 (unformatted) = " + StrC(c)
c = a-b
Debug "The difference of £6.50 and £2 (unformatted) = " + StrC(c)
c = MultC(a, b)
Debug "£6.50 and £2 multiplied as currencies (unformatted) = " + StrC(c)
c = DivC(a, b)
Debug "£6.50 and £2 divided as currencies (unformatted) = " + StrC(c)
x.l = a/b
Debug "£6.50 and £2 divided NOT as currencies (INTEGER return) = " + Str(x)
;=================================================================================
The library will always use 4 places of decimals regardless of what format the local currency is and so it will be suitable for MSDB etc.
