PureBasic Forums - English

http://www.purebasic.com
https://www.purebasic.fr/english/

Currency "type"

https://www.purebasic.fr/english/viewtopic.php?t=30625

Page 1 of 1

Currency "type"

Posted: Wed Jan 16, 2008 11:35 pm
by Trond
I don't know how well this works, but at least you get back the value you store. For add and subtract, just use the normal + and -.

Code: Select all

; Convert an integer to currency
Procedure.q CurrencyI(Number.q)
  ProcedureReturn Number.q * 100
EndProcedure

; Convert a double to currency
Procedure.q CurrencyD(Number.d)
  ProcedureReturn Number.d*100
EndProcedure

; Convert currency to string
Procedure.s StrCur(V.q)
  Protected N.s = StrQ(V)
  ProcedureReturn Left(N, Len(N)-2) + "." + Right(N, 2)
EndProcedure

Procedure.q ValCur(C.s)
  Protected P = FindString(C, ".", 0)
  ProcedureReturn ValQ(Left(C, P)) + ValQ(Right(C, 2))*10
EndProcedure

Procedure.q MulCur(A.q, B.q)
  ProcedureReturn A*B/100
EndProcedure

Procedure.q DivCur(A.q, B.q)
  ProcedureReturn A*100/B
EndProcedure

Code: Select all

Debug 256.61 / 45.98
V.q = CurrencyD(67.8)
Debug StrCur(DivCur(CurrencyD(256.61), CurrencyD(45.98)))

A.q = ValCur("9.99")
Debug StrCur(A)

Posted: Thu Jan 17, 2008 7:09 am
by DarkDragon
I once made this for currencies:

Code: Select all

; Author:   Daniel Brall
; Date:     25.02.2007
; Descr.:   Money class for formatting and calculating money

EnableExplicit

Interface IMoney
  setValue.l(*money.IMoney)
  
  ; set it to a string value:
  setValueString.l(String.s, SymbolCents.s = ",", SymbolThousands.s = ".")
  
  ; Convert to string:
  getValueString.s(SymbolCents.s = ",", SymbolThousands.s = ".")
  
  ; set it to null:
  null.l()
  
  ; Mathematicsfunctions source (subtract or divide from) = *this, dest = *money
  add.l(*money.IMoney)
  sub.l(*money.IMoney)
  mul.l(*money.IMoney)
  div.l(*money.IMoney)
  percentage.l(percent.f)
  
  ; Set and get the amount of numbers before comma:
  setCommaPosition.l(index.l)
  getCommaPosition.l()
  
  ; Release
  release.l()
EndInterface

Structure SMoney
  *VTable
  
  ; Functions:
  *Functions[SizeOf(IMoney)/4]
  
  ; Variables:
  Value.q
  Comma.l
EndStructure

; Private functions
Procedure.s IMoneyPrivate_InsertString(String.s, Index.l, Insert.s)
  Protected Result.s
  
  Result = Left(String, Index) + Insert + Right(String, Len(String) - Index)
  
  ProcedureReturn Result
EndProcedure

Procedure.s IMoneyPrivate_MakeString(qValue.q, Comma.l, SymbolCents.s = ",", SymbolThousands.s = ".")
  Protected Result.s, Value.s, k.l
  
  Value.s = StrQ(qValue)
  
  If Len(Value) <= Comma
    Value = RSet(Value, Comma+1, "0")
  EndIf
  
  Result = Value
  
  For k = 1 To Len(Value) - Comma - 1
    If k % 3 = 0
      Result = IMoneyPrivate_InsertString(Result, Len(Value) - (k + Comma), SymbolThousands)
    EndIf
  Next k
  
  If Comma > 0
    Result = IMoneyPrivate_InsertString(Result, Len(Result) - Comma, SymbolCents)
  EndIf
  
  Value = Result
  For k = Len(Value) - Comma + 1 To Len(Value) - 1
    If Int(k - (Len(Value) - Comma)) % 3 = 0
      Result = IMoneyPrivate_InsertString(Result, k + (k / 3) - 1, SymbolThousands)
    EndIf
  Next k
  
  ProcedureReturn Result
EndProcedure

; Public functions
Procedure.l IMoney_setValue(*IThis.IMoney, *money.IMoney)
  Protected *SThis.SMoney, *SMoney.SMoney
  *SThis  = *IThis
  *SMoney = *money
  
  If *money
    
    *SThis\Value = *SMoney\Value
    ProcedureReturn 1
    
  Else
    
    ProcedureReturn 0
    
  EndIf
EndProcedure

Procedure.l IMoney_setValueString(*IThis.IMoney, String.s, SymbolCents.s = ",", SymbolThousands.s = ".")
  Protected *SThis.SMoney
  *SThis  = *IThis
  
  String = RemoveString(String, SymbolCents)
  String = RemoveString(String, SymbolThousands)
  
  *SThis\Value = ValQ(String)
  
  ProcedureReturn 1
EndProcedure

Procedure.s IMoney_getValueString(*IThis.IMoney, SymbolCents.s = ",", SymbolThousands.s = ".")
  Protected *SThis.SMoney
  
  *SThis  = *IThis
  
  ProcedureReturn IMoneyPrivate_MakeString(*SThis\Value, *SThis\Comma, SymbolCents, SymbolThousands)
EndProcedure

Procedure.l IMoney_setValueQuad(*IThis.IMoney, value.q)
  Protected *SThis.SMoney
  *SThis  = *IThis
  
  *SThis\Value = value
EndProcedure

Procedure.q IMoney_getValueQuad(*IThis.IMoney)
  Protected *SThis.SMoney
  *SThis  = *IThis
  
  ProcedureReturn *SThis\Value
EndProcedure

Procedure.l IMoney_null(*IThis.IMoney)
  Protected *SThis.SMoney
  *SThis  = *IThis
  
  *SThis\Value = 0
  
  ProcedureReturn 1
EndProcedure

Procedure.l IMoney_add(*IThis.IMoney, *money.IMoney)
  Protected *SThis.SMoney, *SMoney.SMoney
  *SThis  = *IThis
  *SMoney = *money
  
  If *money
    
    *SThis\Value + *SMoney\Value
    ProcedureReturn 1
    
  Else
    
    ProcedureReturn 0
    
  EndIf
EndProcedure

Procedure.l IMoney_sub(*IThis.IMoney, *money.IMoney)
  Protected *SThis.SMoney, *SMoney.SMoney
  *SThis  = *IThis
  *SMoney = *money
  
  If *money
    
    *SThis\Value - *SMoney\Value
    ProcedureReturn 1
    
  Else
    
    ProcedureReturn 0
    
  EndIf
EndProcedure

Procedure.l IMoney_mul(*IThis.IMoney, *money.IMoney)
  Protected *SThis.SMoney, *SMoney.SMoney
  *SThis  = *IThis
  *SMoney = *money
  
  If *money
    
    *SThis\Value * *SMoney\Value
    ProcedureReturn 1
    
  Else
    
    ProcedureReturn 0
    
  EndIf
EndProcedure

Procedure.l IMoney_div(*IThis.IMoney, *money.IMoney)
  Protected *SThis.SMoney, *SMoney.SMoney
  *SThis  = *IThis
  *SMoney = *money
  
  If *money
    
    *SThis\Value / *SMoney\Value
    ProcedureReturn 1
    
  Else
    
    ProcedureReturn 0
    
  EndIf
EndProcedure

Procedure.l IMoney_percentage(*IThis.IMoney, percent.f)
  Protected *SThis.SMoney
  *SThis  = *IThis
  
  *SThis\Value = Int(Round((percent / 100.0) * *SThis\Value, 1))
EndProcedure

Procedure.l IMoney_setCommaPosition(*IThis.IMoney, index.l)
  Protected *SThis.SMoney
  *SThis  = *IThis
  
  *SThis\Comma = index
  
  ProcedureReturn 1
EndProcedure

Procedure.l IMoney_getCommaPosition(*IThis.IMoney)
  Protected *SThis.SMoney
  *SThis  = *IThis
  
  ProcedureReturn *SThis\Comma
EndProcedure

; Destructor and constructor:
Procedure IMoney_Dcon(*IThis.IMoney)
  ProcedureReturn FreeMemory(*IThis)
EndProcedure

Procedure IMoney_Con()
  Protected *Result.SMoney
  
  *Result = AllocateMemory(SizeOf(SMoney))
  
  CopyMemory(?IMoneyData, *Result + OffsetOf(SMoney\Functions), SizeOf(SMoney) -  OffsetOf(SMoney\Functions))
  *Result\VTable = *Result + OffsetOf(SMoney\Functions)
  
  ProcedureReturn *Result
  
  DataSection
    IMoneyData:
      ; Functions:
      Data.l @IMoney_setValue()
      Data.l @IMoney_setValueString()
      Data.l @IMoney_getValueString()
      Data.l @IMoney_null()
      Data.l @IMoney_add()
      Data.l @IMoney_sub()
      Data.l @IMoney_mul()
      Data.l @IMoney_div()
      Data.l @IMoney_percentage()
      Data.l @IMoney_setCommaPosition()
      Data.l @IMoney_getCommaPosition()
      Data.l @IMoney_Dcon()
      
      ; Variables:
      Data.q 0
      Data.l 2
  EndDataSection
EndProcedure


Define *Object1.IMoney, *Object2.IMoney

*Object1 = IMoney_Con()
*Object2 = IMoney_Con()


Debug "Setting the Object1 to 0.10:"
*Object1\setValueString("0.10", ".", "'")
Debug "Object1: " + *Object1\getValueString(".", "'")
Debug ""

Debug "Setting the Object2 to the value of Object1:"
*Object2\setValue(*Object1)
Debug "Object2: " + *Object2\getValueString(".", "'")
Debug ""


Debug "Adding Object1 to Object2"
*Object2\add(*Object1)
Debug "Object2: " + *Object2\getValueString(".", "'")

Debug "Subtracting Object1 from Object2"
*Object2\sub(*Object1)
Debug "Object2: " + *Object2\getValueString(".", "'")

Debug "40% of Object2:"
*Object2\percentage(40)
Debug "Object2: " + *Object2\getValueString(".", "'")

Debug "Setting the Object1 to 12'345.23:"
*Object1\setValueString("12'345.23", ".", "'")
Debug "Object1: " + *Object1\getValueString(".", "'")
Debug ""

Debug "Setting the commaposition to 6:"
*Object1\setCommaPosition(6)
Debug "Object1: " + *Object1\getValueString(".", "'")
Debug ""

Debug "Getting the commaposition:"
Debug *Object1\getCommaPosition()
Debug ""

*Object1\release()
*Object2\release()
But I don't know if it's buggy or such. I don't think a currency type should be implemented by default in any programming language. There are just the standard types which can be handled by the processor directly.

Posted: Thu Jan 17, 2008 7:36 am
by superadnim
But custom-types should be supported!

Thats a nice lib DarkDragon :)

Posted: Thu Jan 17, 2008 4:37 pm
by Rook Zimbabwe
Both are great!!! Thanks guys!!! 8)
All times are UTC+01:00
Page 1 of 1

Powered by phpBB® Forum Software © phpBB Limited