CompilerIf Defined(INCLUDE_CURRENCYLIB, #PB_Constant)=0
#INCLUDE_CURRENCYLIB=1
;/////////////////////////////////////////////////////////////////////////////////
;***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
;/////////////////////////////////////////////////////////////////////////////////


;/////////////////////////////////////////////////////////////////////////////////
;The following function divides two currency values and returns a currency 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$ + Str(cur/10000) + "." + RSet(Str(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, blnNegative, blnDecimalPointFound, numDecimalDigits
  Protected *ptrValue.CHARACTER, integer.q
  value$ = Trim(value$)
  *ptrValue = @value$
  While *ptrValue\c
    Select *ptrValue\c
      Case '-'
        If blnNegative Or *ptrValue <> @value$
          ProcedureReturn 0
        EndIf
        blnNegative = #True
      Case '.'
        If blnDecimalPointFound
          ProcedureReturn 0
        EndIf
        blnDecimalPointFound = #True
      Case '0' To '9'
        If blnDecimalPointFound = #False
          integer = integer * 10 + *ptrValue\c - '0'
        Else
          If numDecimalDigits = 4
            If *ptrValue\c >= '5'
              integer + 1
              Break
            EndIf
          Else
            numDecimalDigits + 1
            integer = integer * 10 + *ptrValue\c - '0'
          EndIf
        EndIf
      Default        
        ProcedureReturn 0
    EndSelect
    *ptrValue + SizeOf(CHARACTER)
  Wend
  numDecimalDigits = 4 - numDecimalDigits
  While numDecimalDigits
    integer * 10
    numDecimalDigits - 1
  Wend
  result = integer 
  If blnNegative
    result = - result
  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
;/////////////////////////////////////////////////////////////////////////////////

CompilerEndIf

;=================================================================================
;TEST.

;Set up two currency values, in my locale, £6.50 and £2.00.
  a.currency = ValC("6.5")
  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,-1,1)
  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)
;=================================================================================

; IDE Options = PureBasic 4.61 Beta 1 (Windows - x86)
; CursorPosition = 100
; FirstLine = 98
; Folding = --
; Markers = 95
; EnableUnicode
; EnableXP
; Executable = coffIT.exe
; CompileSourceDirectory