Currency Functions Library

[Frarth]

Searching the forum I found a great need for a variable of type currency without precision loss. Because I need it for a financial app, I wrote this small library as I could not find anything suitable here with cross platform implementation in mind. Feel free to use and adapt it to your needs. Any suggestions are welcome!

Code: Select all

;- Currency Functions Library
; written by Frarth Jan-2011

EnableExplicit

Structure CharacterType
  c.c[0]
EndStructure

; handles values up to 999 999 999 999.99 (1 trillion - 1 (en), 1 biljoen - 1 (nl))

#Currency_MPV = 99999999999999     ;maximum positive value (incl. 2 digits precision)
#Currency_MNV = -99999999999999   ;maximum negative value (incl. 2 digits precision)
#Currency_MVL = 14                        ;maximum value length (checks with positive values)

Global Currency_Error.b

Procedure.s String_Include(Text.s, Filter.s)
  Protected *ptr.CharacterType = @Text
  Protected Count.i = MemoryStringLength(*ptr) - 1
  Protected c.s{1}, i.i, r.s = ""
  ; collect characters by filter  
  For i = 0 To Count
    c = Chr(*ptr\c[i])
    If FindString(Filter, LCase(c), 1) > 0
      r + c
    EndIf
  Next
  ProcedureReturn r
EndProcedure

Procedure.i String_DECPOS(Text.s)
  ;return position of decimal sign
  Protected *ptr.CharacterType = @Text, n.i = MemoryStringLength(*ptr) - 1, i.i
  ; find decimal sign
  For i = n To 0 Step -1
    Select *ptr\c[i]
    Case '.', ','
      ProcedureReturn n - i + 1
    EndSelect
  Next
EndProcedure

Procedure.b Currency_VALIDVAL(Value.q)
  If Value >= #Currency_MNV And Value <= #Currency_MPV
    ProcedureReturn #True
  EndIf
  ProcedureReturn #False
EndProcedure

Procedure.b Currency_VALIDSTR(Text.s)
  Protected s.s = Text
  ;remove possible sign
  Select Left(s, 1)
    Case Chr(43), Chr(45)
      s = Mid(s, 2)
  EndSelect
  ; check length
  If Len(s) <= #Currency_MVL
    ;check content
    If s = String_Include(s, "0123456789.,")
      ProcedureReturn #True
    EndIf
  EndIf
  ProcedureReturn #False
EndProcedure

Procedure.q Currency_Val(Text.s)
  ; return currency in string format as integer
  Protected l.s, r.s, f.i, n.i, v.q
  ; init
  Currency_Error = #False
  ; find decimal sign position
  f = String_DECPOS(Text)
  If f > 0
    ; left part
    l = Left(Text, Len(Text) - f + 1)
    ; remove possible thousand separators
    l = ReplaceString(l, Chr(44), "")
    l = ReplaceString(l, Chr(46), "")
    ; right part
    r = Right(Text, f - 1)
    n = Len(r)
    ; make right part 3 digits
    If n < 3
      r = LSet(r, n + (3 - n), Chr(48))
    EndIf
    r = Left(r, 3)
    ; round off to 2-digit precision
    n = Val(Right(r, 1))
    If n > 4
      n = 1
    Else 
      n = 0
    EndIf
    ; build string
    Text = l + Left(r, 2)
  Else
    ; add the 2-digit precision
    Text + "00"
  EndIf
  ; check
  If Currency_VALIDSTR(Text)
    ; convert to integer
    v = Val(Text)
    ; round to nearest
    If v >= 0
      v + n
    Else
      v - n
    EndIf
    ; check value
    If Currency_VALIDVAL(v)
      ProcedureReturn v
    EndIf
  EndIf
  Currency_Error = #True
  ProcedureReturn 0
EndProcedure

Procedure.s Currency_Str(Value.q)
  ; return currency in integer format as string
  Protected n.i, l.s, r.s, s.s{1}
  ;init
  Currency_Error = #False
  ; check
  If Currency_VALIDVAL(Value)
    ; <0? make positive, save sign
    If Value < 0
      s = Chr(45)
      Value = -Value
    EndIf
    ; convert to string
    r = Str(Value)
    n = Len(r)
    ; add leading zeros
    If n < 3
      r = RSet(r, n + (3 - n), Chr(48))
      n = Len(r)
    EndIf
    ; left part
    l = Left(r, n - 2)
    ; build string
    r = s + l + Chr(46) + Right(r, 2)
  Else
    Currency_Error = #True
  EndIf
  ProcedureReturn r
EndProcedure

Procedure.s Currency_Format(Value.q)
  Protected *ptr.CharacterType, b.i, c.i, i.i, n.i, r.s, t.s, s.s{1}
  ; sign
  If Value < 0
    s = Chr(45)
    Value = -Value
  EndIf
  ; convert to text
  t = Currency_Str(Value)
  ; string address
  *ptr = @t
  n = MemoryStringLength(*ptr) - 1
  ; sep count base
  b = 7
  ; find decimal sign
  For i = n To 0 Step -1
    c + 1
    If c = b
      r = Chr(44) + r
      b + 3
    EndIf
    r = Chr(*ptr\c[i]) + r
  Next
  r = s + r
  ProcedureReturn r
EndProcedure

;- EXAMPLES
Global Text.s, Text1.s, Text2.s
Global Value.q, Value1.q, Value2.q, Value3.q

;- example 1
Text = "0.015"
Value = Currency_Val(Text)
Debug Currency_Str(Value)

;- example 2
Text1 = "3.501"
Text2 = "4.605"
Value1 = Currency_Val(Text1)
Value2 = Currency_Val(Text2)
Value3 = Value1 + Value2
Debug Currency_Str(Value3)

;- example 3
Text = "999999999999.994"
Value = Currency_Val(Text)
If Not Currency_Error
  Debug Value
  Debug Currency_Str(Value)
Else
  Debug "Overflow!"
EndIf

;- example 4
Text = "999999999999.995"
Value = Currency_Val(Text)
If Not Currency_Error
  Debug Value
  Debug Currency_Str(Value)
Else
  Debug "Overflow!"
EndIf

;- example 5
Text = "11222333444,55"
Value = Currency_Val(Text)
Debug Value
Debug Currency_Format(Value)

[JackWebb]

Frarth,

I haven't done financial software in years, but I will put this in my just in case I need it folder. It's always nice to have good readable code when and where you need it.

Thank you!
Jack

[Frarth]

Cheers Jack. I think this is just a great forum where people share their code snippets. I have already found some great examples here, so I'm just returning the favour.

Frank

[C64]

Serious question: why would I need this when I can just use doubles?

[Frarth]

Serious question: why would I need this when I can just use doubles?

Because doubles lose precision with larger numbers. Here is an easy example; consider what would happen with large numbers:

Code: Select all

a.d = 595.95
Debug a

This is what the manual says: "A floating point number is stored in a way that makes the binary point "float" around the number, so that it is possible to store very large numbers or very small numbers. However, you cannot store very large numbers with very high accuracy (big and small numbers at the same time, so to speak)."

[C64]

I understand now. You're running into the decimal point issue with currency. I don't do that. Did you know you can use currency values without decimals and have perfect accurary, and no need for a library of code like yours? Just include the cents as part of the whole number, and separate them when displaying.

Code: Select all

Procedure.s ShowMeTheMoney(amount.d)
  m$=Str(amount)
  ProcedureReturn Left(m$,Len(m$)-2)+"."+Right(m$,2)
EndProcedure

capital.d=595.95
payment.d=4.06
Debug capital+payment ;Shows 600.00999999999999

capital2.d=59595
payment2.d=406
Debug ShowMeTheMoney(capital2+payment2); Shows 600.01

[Frarth]

Did you know you can use currency values without decimals and have perfect accurary, and no need for a library of code like yours? Just include the cents as part of the whole number, and separate them when displaying.

That is exactly what I'm doing. I use quads to do the calculations. The problem is user input. You cannot expect people to always enter perfect two-digit precision. Also when calculating, and the result is 1, it is actually 0.01. My library accounts for that. Nothing more, nothing less.

Edit: I see your example. I have chosen to avoid the use of floats at all, which I believe is the save way to go.

[C64]

The problem is user input. You cannot expect people to always enter perfect two-digit precision.

Just a simple matter of removing the dot after they enter it. What they don't see, won't hurt them. Also, I work in finance and our system, and many others, require whole dollars and the cents entered as a single number. It becomes second-nature to new employees after the initial learning curve.

[Frarth]

Also, I work in finance and our system, and many others, require whole dollars and the cents entered as a single number.

That is indeed something to consider.