PureBasic Forums - English

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

ValD() StrD(X$,2) are killing me

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

Page 2 of 2

Posted: Thu Jan 17, 2008 4:33 pm
by Rook Zimbabwe
I'd use Longs, but store the value in cents
so

100 = $1.00
999 = $9.99

no precision errors that way
Thats what I was doing. It was all good. But the problem is that the spreadsheet HAS to have the values as currency for the reports to work.

I simplified it by cutting off the third through the last parts of the string.

But that isn't accurate as I would like. Money is almost metric. There are a few mashes in the metric plan, but that is to make the metric amount come out more even and simplify the pay process.

I had thought about writing a DLL but cannot locate a tutorial on how to get values in to PB.

Posted: Thu Jan 17, 2008 5:15 pm
by jack
writing a dll in VB would still require the VB runtime DLL's, so why not just use the runtime DLL directly
the decimal type is a decimal floating point number with 28 digits precision, while the currency type is a fixed point number with 4 decimals represented in a quad-integer
here's simple example on using the decimal functions in oleaut.dll, you will need to build the oleaut32.lib and put it in the PureBasic\PureLibraries\Windows\Libraries folder as the lib that comes with PB does not have the decimal math functions
to make the lib you need the oleaut32.dll, then do:
polib oleaut32.dll /machine:ix86 /out:oleaut32.lib

Code: Select all

Structure decimal
  wReserved.w
  scale.b
  sign.b
  hi32.l
  lo64.q
EndStructure

Structure DATE
  date.d
EndStructure

Structure CY
  int64.q
EndStructure

Structure VARIANT_BOOL
  BOOL.w
EndStructure

Procedure StringToBStr (string$) ; By Zapman Inspired by Fr34k 
  Protected Unicode$ = Space(Len(String$)* 2 + 2) 
  Protected bstr_string.l 
  PokeS(@Unicode$, String$, -1, #PB_Unicode) 
  bstr_string = SysAllocString_(@Unicode$) 
  ProcedureReturn bstr_string 
EndProcedure

Procedure.s ReadBstr(*String.s) ; By Fr34k
  Result$ = "" 
  
  If *String 
    length.l = WideCharToMultiByte_(#CP_ACP, 0, *String, -1, 0, 0, 0, 0) 
    *Buffer.l = AllocateMemory(length) 
    
    If *Buffer 
      WideCharToMultiByte_(#CP_ACP, 0, *String, -1, *Buffer, length, 0, 0) 
      Result$ = PeekS(*Buffer) 
      FreeMemory(*Buffer) 
    EndIf 
  EndIf 
  
  ProcedureReturn Result$ 
EndProcedure

 ; Any of the coersion functions that converts either from or to a string
 ; takes an additional lcid and dwFlags arguments. The lcid argument allows
 ; locale specific parsing to occur.  The dwFlags allow additional function
 ; specific condition to occur.  All function that accept the dwFlags argument
 ; can include either 0 or LOCALE_NOUSEROVERRIDE flag.

 ; The VarDateFromStr and VarBstrFromDate functions also accept the
 ; VAR_TIMEVALUEONLY and VAR_DATEVALUEONLY flags
#VAR_TIMEVALUEONLY       = $1
#VAR_DATEVALUEONLY       = $2

 ; VarDateFromUdate() only
#VAR_VALIDDATE           = $4

 ; Accepted by all date & format APIs
#VAR_CALENDAR_HIJRI      = $8

 ; Booleans can optionally be accepted in localized form. Pass VAR_LOCALBOOL
 ; into VarBoolFromStr And VarBstrFromBool To use localized boolean names
#VAR_LOCALBOOL           = $10

 ; When passed into VarFormat And VarFormatFromTokens, prevents substitution
 ; of formats in the Case where a string is passed in that can Not be
 ; coverted into the desired type. (For ex, 'Format("Hello", "General Number")')
#VAR_FORMAT_NOSUBSTITUTE = $20

 ; For VarBstrFromDate only - forces years To be 4 digits rather than shortening
 ; To 2-digits when the years is in the date window.
#VAR_FOURDIGITYEARS      = $40

#VARCMP_LT   = 0
#VARCMP_EQ   = 1
#VARCMP_GT   = 2
#VARCMP_NULL = 3


Import "oleaut32.lib"
  VarUI1FromDec.l  ( *pdecIn.decimal, *pbOut.b )                                 As "_VarUI1FromDec@8"
  VarI2FromDec.l   ( *pdecIn.decimal, *psOut.w )                                 As "_VarI2FromDec@8"
  VarI4FromDec.l   ( *pdecIn.decimal, *plOut.l )                                 As "_VarI4FromDec@8"
  VarR4FromDec.l   ( *pdecIn.decimal, *pfltOut.f )                               As "_VarR4FromDec@8"
  VarR8FromDec.l   ( *pdecIn.decimal, *pdblOut.d )                               As "_VarR8FromDec@8"
  VarDateFromDec.l ( *pdecIn.decimal, *pdateOut.DATE )                           As "_VarDateFromDec@8"
  VarCyFromDec.l   ( *pdecIn.decimal, *pcyOut.q )                                As "_VarCyFromDec@8"
  VarBstrFromDec.l ( *pdecIn.decimal, lcid.l, dwFlags.l, *pbstrOut.p-bstr )      As "_VarBstrFromDec@16"
  VarBoolFromDec.l ( *pdecIn.decimal, *pboolOut.l )                              As "_VarBoolFromDec@8"
  VarI1FromDec.l   ( *pdecIn.decimal, *pcOut.b )                                 As "_VarI1FromDec@8"
  VarUI2FromDec.l  ( *pdecIn.decimal, *puiOut.w )                                As "_VarUI2FromDec@8"
  VarUI4FromDec.l  ( *pdecIn.decimal, *pulOut.l )                                As "_VarUI4FromDec@8"
  VarDecFromUI1.l  ( bIn.b, *pdecOut.decimal )                                   As "_VarDecFromUI1@8"
  VarDecFromI2.l   ( uiIn.w, *pdecOut.decimal )                                  As "_VarDecFromI2@8"
  VarDecFromI4.l   ( lIn.l, *pdecOut.decimal )                                   As "_VarDecFromI4@8"
  VarDecFromR4.l   ( fltIn.f, *pdecOut.decimal )                                 As "_VarDecFromR4@8"
  VarDecFromR8.l   ( dblIn.d, *pdecOut.decimal )                                 As "_VarDecFromR8@12"
  VarDecFromDate.l ( dateIn.d, *pdecOut.decimal )                                As "_VarDecFromDate@12"
  VarDecFromCy.l   ( dcyIn.q, *pdecOut.decimal )                                 As "_VarDecFromCy@12"
  VarDecFromStr.l  ( *strIn.p-bstr, lcid.l, dwFlags.l, *pdecOut.decimal )        As "_VarDecFromStr@16" 
  ;VarDecFromDisp.l ( *pdispIn.l, lcid.l, *pdecOut.decimal )                      As "_VarDecFromDisp@12"
  VarDecFromBool.l ( boolIn.l , *pdecOut.decimal )                               As "_VarDecFromBool@8"
  VarDecFromI1.l   ( cIn.b , *pdecOut.decimal )                                  As "_VarDecFromI1@8"
  VarDecFromUI2.l  ( uiIn.w , *pdecOut.decimal )                                 As "_VarDecFromUI2@8"
  VarDecFromUI4    ( ulIn.l , *pdecOut.decimal )                                 As "_VarDecFromUI4@8"
  VarDecAdd.l      ( *pdecLeft.decimal, *pdecRight.decimal, *pdecResult.decimal) As "_VarDecAdd@12"
  VarDecSub.l      ( *pdecLeft.decimal, *pdecRight.decimal, *pdecResult.decimal) As "_VarDecSub@12"
  VarDecMul.l      ( *pdecLeft.decimal, *pdecRight.decimal, *pdecResult.decimal) As "_VarDecMul@12"
  VarDecDiv.l      ( *pdecLeft.decimal, *pdecRight.decimal, *pdecResult.decimal) As "_VarDecDiv@12"
  VarDecAbs.l      ( *pdecIn.decimal, *pdecResult.decimal )                      As "_VarDecAbs@8"
  VarDecFix.l      ( *pdecIn.decimal, *pdecResult.decimal )                      As "_VarDecFix@8"
  VarDecInt.l      ( *pdecIn.decimal, *pdecResult.decimal )                      As "_VarDecInt@8"
  VarDecNeg.l      ( *pdecIn.decimal, *pdecResult.decimal )                      As "_VarDecNeg@8"
  VarDecRound.l    ( *pdecIn.decimal, cDecimals.l, *pdecResult.decimal )         As "_VarDecRound@12"
  VarDecCmp.l      ( *pdecLeft.decimal, *pdecRight.decimal )                     As "_VarDecCmp@8"
  VarDecCmpR8.l    ( *pdecIn.decimal, dblRight.d )                               As "_VarDecCmpR8@12"
  VarCyFromStr.l   ( *strIn.p-bstr, lcid.l, dwFlags.l, *pcyOut.q )               As "_VarCyFromStr@16"
  VarBstrFromCy.l  ( cyIn.q, lcid.l, dwFlags.l, *pbstrOut.p-bstr )               As "_VarBstrFromCy@20"
  
  VarBstrFromDate.l( dateIn.d, lcid.l, dwFlags.l, *pbstrOut.p-bstr )             As "_VarBstrFromDate@20"
  VarDateFromStr.l ( *strIn.p-bstr, lcid.l, dwFlags.l, *pdateOut.d )             As "_VarDateFromStr@16"
  VarUI1FromDate.l ( dateIn.d, *pbOut.b )                                        As "_VarUI1FromDate@12"
  VarI2FromDate.l  ( dateIn.d, *psOut.w )                                        As "_VarI2FromDate@12"
  VarI4FromDate.l  ( dateIn.d, *plOut.l )                                        As "_VarI4FromDate@12"
  VarR4FromDate.l  ( dateIn.d, *pfltOut.f )                                      As "_VarR4FromDate@12"
  VarR8FromDate.l  ( dateIn.d, *pdblOut.d )                                      As "_VarR8FromDate@12"
  VarCyFromDate.l  ( dateIn.d, *pcyOut.q )                                       As "_VarCyFromDate@12"
  VarDateFromUI1.l ( bIn.b, *pdateOut.d )                                        As "_VarDateFromUI1@8"
  VarDateFromI2.l  ( sIn.w, *pdateOut.d )                                        As "_VarDateFromI2@8"
  VarDateFromI4.l  ( lIn.l, *pdateOut.d )                                        As "_VarDateFromI4@8"
  VarDateFromR4.l  ( fltIn.f, *pdateOut.d )                                      As "_VarDateFromR4@8"
  VarDateFromR8.l  ( dblIn.d, *pdateOut.d )                                      As "_VarDateFromR8@12"
  VarDateFromCy.l  ( cyIn.q, *pdateOut.d )                                       As "_VarDateFromCy@12"
  VarDateFromBool.l( boolIn.w, *pdateOut.d )                                     As "_VarDateFromBool@8"
  VarDateFromI1.l  ( cIn.c, *pdateOut.d )                                        As "_VarDateFromI1@8"
  VarDateFromUI2.l ( uiIn.w, *pdateOut.d )                                       As "_VarDateFromUI2@8"
  VarDateFromUI4.l ( ulIn.l, *pdateOut.d )                                       As "_VarDateFromUI4@8"
  VarCyAdd.l       ( cyLeft.q, cyRight.q, *pcyResult.q )                         As "_VarCyAdd@20"
  VarCyMul.l       ( cyLeft.q, cyRight.q, *pcyResult.q )                         As "_VarCyMul@20"
  VarCyMulI4.l     ( cyLeft.q, lRight.l, *pcyResult.q )                          As "_VarCyMulI4@16"
  VarCySub.l       ( cyLeft.q, cyRight.q, *pcyResult.q )                         As "_VarCySub@20"
  VarCyAbs.l       ( cyIn.q, *pcyResult.q )                                      As "_VarCyAbs@12"
  VarCyFix.l       ( cyIn.q, *pcyResult.q )                                      As "_VarCyFix@12"
  VarCyInt.l       ( cyIn.q, *pcyResult.q )                                      As "_VarCyInt@12"
  VarCyNeg.l       ( cyIn.q, *pcyResult.q )                                      As "_VarCyNeg@12"
  VarCyRound.l     ( cyIn.q, cDecimals.l, *pcyResult.q )                         As "_VarCyRound@16"
  VarCyCmp.l       ( cyLeft.q, cyRight.q )                                       As "_VarCyCmp@16"
  VarCyCmpR8.l     ( cyLeft.q, dblRight.d )                                      As "_VarCyCmpR8@16"
  
EndImport

Define.decimal x,y,z
Define.w dw
Define.l lcid, bstr, bstr2
Define.q cy

bstr=SysAllocStringLen_(bstr,255)
VarDecFromI4( 12345, x )
x\scale=3 ;x=12.345
VarDecAdd( x, x, y );y=24.690
VarBstrFromDec( y, lcid, 0, bstr )
Debug("decimal "+ReadBstr(PeekL(bstr)))
SysFreeString_(bstr)

;=============================================================
bstr2=StringToBStr ("12.34")
VarDecFromStr( bstr2, lcid, 0, y)
VarCyFromDec( y, @cy)
VarCyAdd( cy, cy, @cy)
VarBstrFromCy( cy, lcid, 0, bstr )
Debug ("currency "+ReadBstr(PeekL(bstr)))
Debug "same curency value printed as quad-integer "+StrQ(cy)
SysFreeString_(bstr)
SysFreeString_(bstr2)

Re: ValD() StrD(X$,2) are killing me

Posted: Thu Jan 26, 2012 10:08 pm
by javabean
For some money calculations I used the following procedures...

Code: Select all

; REFERENCES:
; -----------
; Currency Arithmetic Functions :
; http://msdn.microsoft.com/en-us/library/windows/desktop/ms221356%28v=vs.85%29.aspx
; -
; Data Type Conversion Functions:
; http://msdn.microsoft.com/en-us/library/windows/desktop/ms221582%28v=vs.85%29.aspx
; -
; Locale IDs (lcid):
; http://msdn.microsoft.com/en-us/goglobal/bb964664

;Win x86 -ASCII & Unicode


#VARCMP_LT   = 0
#VARCMP_EQ   = 1
#VARCMP_GT   = 2
#VARCMP_NULL = 3

Structure decimal
  wReserved.w
  scale.b
  sign.b
  hi32.l
  lo64.q
EndStructure

Import "oleaut32.lib"
  
  VarCyFromStr.l   (strIn.p-bstr,    lcid.l,   dwFlags.l, *pcyOut.q       )      As "_VarCyFromStr@16"
  VarBstrFromCy.l  (cyIn.q,          lcid.l,   dwFlags.l, *pbstrOut.p-bstr)      As "_VarBstrFromCy@20"
  VarCyFromDec.l   (*pdecIn.decimal, *pcyOut.q                            )      As "_VarCyFromDec@8"
  VarDecFromStr.l  (strIn.p-bstr,    lcid.l,   dwFlags.l, *pdecOut.decimal)      As "_VarDecFromStr@16"
  
  VarDecDiv.l      (*pdecLeft.decimal, *pdecRight.decimal, *pdecResult.decimal)  As "_VarDecDiv@12"
  
  VarCyRound.l     (cyIn.q,   cDecimals.l, *pcyResult.q)                         As "_VarCyRound@16"
  VarCyAdd.l       (cyLeft.q, cyRight.q,   *pcyResult.q)                         As "_VarCyAdd@20"
  VarCyMul.l       (cyLeft.q, cyRight.q,   *pcyResult.q)                         As "_VarCyMul@20"
  VarCyMulI4.l     (cyLeft.q, lRight.l,    *pcyResult.q)                         As "_VarCyMulI4@16"
  VarCyMulI8.l     (cyLeft.q, lRight.q,    *pcyResult.q)                         As "_VarCyMulI8@20"
  VarCySub.l       (cyLeft.q, cyRight.q,   *pcyResult.q)                         As "_VarCySub@20"
  VarCyAbs.l       (cyIn.q,                *pcyResult.q)                         As "_VarCyAbs@12"
  VarCyFix.l       (cyIn.q,                *pcyResult.q)                         As "_VarCyFix@12"
  VarCyInt.l       (cyIn.q,                *pcyResult.q)                         As "_VarCyInt@12"
  VarCyNeg.l       (cyIn.q,                *pcyResult.q)                         As "_VarCyNeg@12"
  VarCyCmp.l       (cyLeft.q,              cyRight.q   )                         As "_VarCyCmp@16"
  VarCyCmpR8.l     (cyLeft.q,              dblRight.d  )                         As "_VarCyCmpR8@16"

EndImport


Procedure.s ReadBstr(*String.s)
  Result$ = ""
 
  If *String
    length.l = WideCharToMultiByte_(#CP_ACP, 0, *String, -1, 0, 0, 0, 0)
    *Buffer.l = AllocateMemory(length)
   
    If *Buffer
      WideCharToMultiByte_(#CP_ACP, 0, *String, -1, *Buffer, length, 0, 0)
      Result$ = PeekS(*Buffer, length, #PB_Ascii)
      FreeMemory(*Buffer)
    EndIf
  EndIf
 
  ProcedureReturn Result$
EndProcedure


Procedure.s FillZeros(StringIn.s, Decimals.l)
  pos.i = 0
  retval.s = ""
  length.i = Len(StringIn)
  pos = FindString(StringIn, ".", 1) 

    
  If pos
    If pos > length-decimals
      retval = LSet(StringIn, pos+Decimals, "0")
      ProcedureReturn retval
    Else
      retval = StringIn
      ProcedureReturn retval
    EndIf
  
  Else
    retval = LSet(StringIn + ".", length + 1 + Decimals, "0")
    ProcedureReturn retval
  EndIf

ProcedureReturn retval
EndProcedure




Procedure.s RoundCy(StringIn.s, Decimals.l)
  lcid.l = 1033
  dwFlags.l = 0
  cy.q = 0
  retval.s = ""
  
  If Decimals > 4
    Decimals = 4
  EndIf
  
  bstr.l=SysAllocStringLen_(bstr,255)
  
  If bstr And StringIn <>""
    If VarCyFromStr(StringIn, lcid, 0, @cy) = #S_OK
      If VarCyRound(cy, Decimals, @cy)  = #S_OK
        If VarBstrFromCy(cy, lcid, 0, bstr) = #S_OK
          retval = FillZeros(ReadBstr(PeekL(bstr)), Decimals)         
          SysFreeString_(bstr)
          ProcedureReturn retval
        EndIf
        
      EndIf
      
    EndIf
  SysFreeString_(bstr)
  EndIf

ProcedureReturn retval
EndProcedure


Procedure.s AddCy(StringIn1.s, StringIn2.s)
  lcid.l = 1033
  dwFlags.l = 0
  cy.q = 0
  cy1.q = 0
  cy2.q = 0
  retval.s = ""
  
  bstr.l=SysAllocStringLen_(bstr,255)
  
  If bstr And StringIn1 <>"" And StringIn2 <>""
    If VarCyFromStr(StringIn1, lcid, 0, @cy1) = #S_OK And VarCyFromStr(StringIn2, lcid, 0, @cy2) = #S_OK
      If VarCyAdd(cy1, cy2, @cy)  = #S_OK
        If VarBstrFromCy(cy, lcid, 0, bstr) = #S_OK
          retval = ReadBstr(PeekL(bstr))         
          SysFreeString_(bstr)
          ProcedureReturn retval
        EndIf
        
      EndIf
      
    EndIf
  SysFreeString_(bstr)
  EndIf

ProcedureReturn retval
EndProcedure


Procedure.s SubCy(StringIn1.s, StringIn2.s)
  lcid.l = 1033
  dwFlags.l = 0
  cy.q = 0
  cy1.q = 0
  cy2.q = 0
  retval.s = ""
  
  bstr.l=SysAllocStringLen_(bstr,255)
  
  If bstr And StringIn1 <>"" And StringIn2 <>""
    If VarCyFromStr(StringIn1, lcid, 0, @cy1) = #S_OK And VarCyFromStr(StringIn2, lcid, 0, @cy2) = #S_OK
      If VarCySub(cy1, cy2, @cy)  = #S_OK
        If VarBstrFromCy(cy, lcid, 0, bstr) = #S_OK
          retval = ReadBstr(PeekL(bstr))         
          SysFreeString_(bstr)
          ProcedureReturn retval
        EndIf
        
      EndIf
      
    EndIf
  SysFreeString_(bstr)
  EndIf

ProcedureReturn retval
EndProcedure


Procedure.s MulCy(StringIn1.s, StringIn2.s)
  lcid.l = 1033
  dwFlags.l = 0
  cy.q = 0
  cy1.q = 0
  cy2.q = 0
  retval.s = ""
  
  bstr.l=SysAllocStringLen_(bstr,255)
  
  If bstr And StringIn1 <>"" And StringIn2 <>""
    If VarCyFromStr(StringIn1, lcid, 0, @cy1) = #S_OK And VarCyFromStr(StringIn2, lcid, 0, @cy2) = #S_OK
      If VarCyMul(cy1, cy2, @cy)  = #S_OK
        If VarBstrFromCy(cy, lcid, 0, bstr) = #S_OK
          retval = ReadBstr(PeekL(bstr))         
          SysFreeString_(bstr)
          ProcedureReturn retval
        EndIf
        
      EndIf
      
    EndIf
  SysFreeString_(bstr)
  EndIf

ProcedureReturn retval
EndProcedure


Procedure.s MulCyLong(StringIn1.s, Int32.l)
  lcid.l = 1033
  dwFlags.l = 0
  cy.q = 0
  cy1.q = 0
  retval.s = ""
  
  bstr.l=SysAllocStringLen_(bstr,255)
  
  If bstr And StringIn1 <>""
    If VarCyFromStr(StringIn1, lcid, 0, @cy1) = #S_OK
      If VarCyMulI4(cy1, Int32, @cy)  = #S_OK
        If VarBstrFromCy(cy, lcid, 0, bstr) = #S_OK
          retval = ReadBstr(PeekL(bstr))         
          SysFreeString_(bstr)
          ProcedureReturn retval
        EndIf
        
      EndIf
      
    EndIf
  SysFreeString_(bstr)
  EndIf

ProcedureReturn retval
EndProcedure


Procedure.s MulCyQuad(StringIn1.s, Int64.q)
  lcid.l = 1033
  dwFlags.l = 0
  cy.q = 0
  cy1.q = 0
  retval.s = ""
  
  bstr.l=SysAllocStringLen_(bstr,255)
  
  If bstr And StringIn1 <>""
    If VarCyFromStr(StringIn1, lcid, 0, @cy1) = #S_OK
      If VarCyMulI8(cy1, Int64, @cy)  = #S_OK
        If VarBstrFromCy(cy, lcid, 0, bstr) = #S_OK
          retval = ReadBstr(PeekL(bstr))         
          SysFreeString_(bstr)
          ProcedureReturn retval
        EndIf
        
      EndIf
      
    EndIf
  SysFreeString_(bstr)
  EndIf

ProcedureReturn retval
EndProcedure


Procedure.s DivCy(StringIn1.s, StringIn2.s)
  lcid.l = 1033
  dwFlags.l = 0
  cy.q = 0
  dec.decimal
  dec1.decimal
  dec2.decimal
  retval.s = ""
  
  bstr.l=SysAllocStringLen_(bstr,255)
  
  If bstr And StringIn1 <>"" And StringIn2 <>""
    If VarDecFromStr(StringIn1, lcid, 0, @dec1) = #S_OK And VarDecFromStr(StringIn2, lcid, 0, @dec2) = #S_OK
      If VarDecDiv(@dec1, @dec2, @dec)  = #S_OK
        If VarCyFromDec(@dec, @cy)  = #S_OK
          If VarBstrFromCy(cy, lcid, 0, bstr) = #S_OK
            retval = ReadBstr(PeekL(bstr))         
            SysFreeString_(bstr)
            ProcedureReturn retval
          EndIf
        EndIf
      EndIf
      
    EndIf
  SysFreeString_(bstr)
  EndIf

ProcedureReturn retval
EndProcedure


Procedure.s NegCy(StringIn.s)
  lcid.l = 1033
  dwFlags.l = 0
  cy.q = 0
  retval.s = ""
  
  If Decimals > 4
    Decimals = 4
  EndIf
  
  bstr.l=SysAllocStringLen_(bstr,255)
  
  If bstr And StringIn <>""
    If VarCyFromStr(StringIn, lcid, 0, @cy) = #S_OK
      If VarCyNeg(cy, @cy)  = #S_OK
        If VarBstrFromCy(cy, lcid, 0, bstr) = #S_OK
          retval = ReadBstr(PeekL(bstr))         
          SysFreeString_(bstr)
          ProcedureReturn retval
        EndIf
        
      EndIf
      
    EndIf
  SysFreeString_(bstr)
  EndIf

ProcedureReturn retval
EndProcedure


Procedure.s AbsCy(StringIn.s)
  lcid.l = 1033
  dwFlags.l = 0
  cy.q = 0
  retval.s = ""
  
  If Decimals > 4
    Decimals = 4
  EndIf
  
  bstr.l=SysAllocStringLen_(bstr,255)
  
  If bstr And StringIn <>""
    If VarCyFromStr(StringIn, lcid, 0, @cy) = #S_OK
      If VarCyAbs(cy, @cy)  = #S_OK
        If VarBstrFromCy(cy, lcid, 0, bstr) = #S_OK
          retval = ReadBstr(PeekL(bstr))         
          SysFreeString_(bstr)
          ProcedureReturn retval
        EndIf
        
      EndIf
      
    EndIf
  SysFreeString_(bstr)
  EndIf

ProcedureReturn retval
EndProcedure


Procedure.s IntCy(StringIn.s)
  lcid.l = 1033
  dwFlags.l = 0
  cy.q = 0
  retval.s = ""
  
  If Decimals > 4
    Decimals = 4
  EndIf
  
  bstr.l=SysAllocStringLen_(bstr,255)
  
  If bstr And StringIn <>""
    If VarCyFromStr(StringIn, lcid, 0, @cy) = #S_OK
      If VarCyInt(cy, @cy)  = #S_OK
        If VarBstrFromCy(cy, lcid, 0, bstr) = #S_OK
          retval = ReadBstr(PeekL(bstr))         
          SysFreeString_(bstr)
          ProcedureReturn retval
        EndIf
        
      EndIf
      
    EndIf
  SysFreeString_(bstr)
  EndIf

ProcedureReturn retval
EndProcedure


Procedure.s FixCy(StringIn.s)
  ProcedureReturn IntCy(StringIn)
EndProcedure


Procedure.l CmpCy(StringIn1.s, StringIn2.s)
  lcid.l = 1033
  dwFlags.l = 0
  cy1.q = 0
  cy2.q = 0
  retval.l = -1
  
  If StringIn1 <>"" And StringIn2 <>""
    If VarCyFromStr(StringIn1, lcid, 0, @cy1) = #S_OK And VarCyFromStr(StringIn2, lcid, 0, @cy2) = #S_OK
      retval = VarCyCmp(cy1, cy2)
    EndIf
  EndIf

ProcedureReturn retval
EndProcedure


Procedure.l CmpCyDouble(StringIn1.s, Double.d)
  lcid.l = 1033
  dwFlags.l = 0
  cy1.q = 0
  retval.l = -1
  
  If StringIn1 <>""
    If VarCyFromStr(StringIn1, lcid, 0, @cy1) = #S_OK
      retval = VarCyCmpR8(cy1, Double)
    EndIf
  EndIf

ProcedureReturn retval
EndProcedure


Debug RoundCy("6462.6789865",2)

Debug AddCy("323.7674", "8872.5")
Debug MulCy("8211.45", "0.567")
Debug NegCy("-121.23")

Debug AbsCy("-121.789")

strg$ = RoundCy(MulCy(AddCy(AddCy("12.32","9988"),"1.2"),"0.78"),4)
Debug strg$


Debug RoundCy(MulCyQuad("67531.632", 23233), 2)

Debug DivCy("345.123","1.2")

Debug FixCy("345.123")

dbl.d = 44.9999
Debug CmpCyDouble("45",dbl)
All times are UTC+01:00
Page 2 of 2

Powered by phpBB® Forum Software © phpBB Limited