Currency "type"

Share your advanced PureBasic knowledge/code with the community.
Post Reply
Trond
Always Here
Always Here
Posts: 7446
Joined: Mon Sep 22, 2003 6:45 pm
Location: Norway

Currency "type"

Post 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)
Top
DarkDragon
Addict
Addict
Posts: 2344
Joined: Mon Jun 02, 2003 9:16 am
Location: Germany
Contact:
Contact DarkDragon

Post 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.
bye,
Daniel
Top
superadnim
Enthusiast
Enthusiast
Posts: 480
Joined: Thu Jul 27, 2006 4:06 am

Post by superadnim »

But custom-types should be supported!

Thats a nice lib DarkDragon :)
Top
User avatar
Rook Zimbabwe
Addict
Addict
Posts: 4322
Joined: Tue Jan 02, 2007 8:16 pm
Location: Cypress TX
Contact:
Contact Rook Zimbabwe

Post by Rook Zimbabwe »

Both are great!!! Thanks guys!!! 8)
Binarily speaking... it takes 10 to Tango!!!

Image
http://www.bluemesapc.com/
Top
Post Reply

Return to “Tricks 'n' Tips”