Format Numbers
Posted: Fri Mar 26, 2010 12:26 pm
I've seen people on this forum asking for a Format$() procedure to format numbers. Years ago I wrote a Format library for QuickBASIC, and it was one of my first exercises to port it to PureBasic. Here it is, have fun with it:
Code: Select all
; Format Library
; written by Frank Hoogerbeets
; website: www.ditrianum.org
; e-mail: info@ditrianum.org
EnableExplicit
;{ DOCUMENTATION
; -----------------------------------------------------------------------
; FormatI, FormatF, FormatD
;
; Syntax
; FormatX(Value, Format$)
;
; Parameters
; Value - number to be formatted
; Format$ - format defintion
;
; Usage
; Use the following symbols to define a format:
; # - digit placeholder
; . - as rightmost occurance, decimal point
; , - as rightmost occurance, decimal comma
; 0 - as first character, fills leading placeholders with zeros
; / - as first character, removes leading placeholders
;
; Any other character will be part of the format
;
; Note 1
; Make sure to provide sufficient placeholders for a given number.
; Example: FormatI(21, "#") returns "1", not "21"
; FormatI(21, "##") returns "21"
; FormatI(21, "####") returns " 21"
; FormatI(21, "/####") returns "21"
; FormatI(-1, "#") returns "1"
; FormatI(-1, "##") returns "-1"
; Note 2
; The number of placeholders behind the decimal point or comma
; determines the number of digits of the decimal part.
; Example: FormatD(2/3, "#.##") returns "0.67"
; FormatD(2/3, "#.####") returns "0.6667"
; FormatD(1/3, "#.##") returns "0.33"
; FormatD(1/3, "#.####") returns "0.3333"
; Examples
; See below
; -----------------------------------------------------------------------
;}
Structure CharacterType
c.c[0]
EndStructure
;- INTERNAL PROCEDURES:
Procedure.i Format_mDecPoint(*TFormat.CharacterType)
;return position of decimal point/comma
Protected flen = MemoryStringLength(*TFormat) - 1, i.i
For i = flen To 0 Step -1
Select *TFormat\c[i]
Case ',', '.'
ProcedureReturn flen - i + 1
EndSelect
Next
EndProcedure
Procedure.s Format_mRound(Buffer.s, rpos.i)
Protected fpos.i, ascii.i, result.s, i.i
; floating point position
fpos = FindString(Buffer, Chr(46), 1)
If fpos = 0
ProcedureReturn Buffer
EndIf
result = Left(Buffer, fpos + rpos)
;get next digit to determine round-off
If rpos = 0
result = Left(Buffer, fpos - 1)
EndIf
; < 5 means nothing to round off
If Val(Mid(Buffer, fpos + rpos + 1, 1)) < 5
Goto Format_mRound_Exit
EndIf
;round off
For i = Len(result) To 1 Step -1
ascii = Asc(Mid(result, i, 1))
Select ascii
Case 46
If i = 1
result = Chr(49) + result
Break
EndIf
Case 48 To 56
result = Left(result, i - 1) + Chr(ascii + 1) + Mid(result, i + 1)
Break
Case 57
result = Left(result, i - 1) + Chr(48) + Mid(result, i + 1)
If i = 1
result = Chr(49) + result
Break
EndIf
EndSelect
Next
Format_mRound_Exit:
If fpos = 1
result = Chr(48) + result
EndIf
ProcedureReturn result
EndProcedure
Procedure.s Format_mFormat(Buffer.s, Format.s)
Protected blen.i, flen.i, lzero.i, nospc.i, bdpnt.i, fdpnt.i, n.i
Protected char.s, result.s, i.i
Select Left(Format, 1)
Case Chr(47) ;no (leading) space
nospc = #True
Case Chr(48) ;leading zero
lzero = #True
EndSelect
;remove special character if present
If lzero Or nospc
Format = Mid(Format, 2)
EndIf
flen = Len(Format)
n = 0
;get round-off position (n)
fdpnt = Format_mDecPoint(@Format)
If fdpnt > 0
For i = flen - fdpnt + 2 To flen
If Mid(Format, i, 1) = Chr(35)
n + 1
EndIf
Next
EndIf
Buffer = Format_mRound(Buffer, n)
blen = Len(Buffer)
bdpnt = Format_mDecPoint(@Buffer)
fdpnt = flen - fdpnt + 1
; do the part left of the decimal point
n = blen - bdpnt
For i = fdpnt - 1 To 1 Step -1
char = Mid(Format, i, 1)
Select char
Case Chr(35)
If n > 0
char = Mid(Buffer, n, 1)
n - 1
ElseIf lzero
char = Chr(48)
ElseIf nospc
char = ""
Else
char = Chr(32)
EndIf
Case Chr(44), Chr(46)
If n = 0
If nospc
char = ""
Else
char = Chr(32)
EndIf
EndIf
EndSelect
result = char + result
Next
; do the part right of the decimal point
n = blen - bdpnt + 2
For i = fdpnt To flen
char = Mid(Format, i, 1)
Select char
Case Chr(35)
If n <= blen
char = Mid(Buffer, n, 1)
n + 1
Else
char = Chr(48)
EndIf
EndSelect
result + char
Next
ProcedureReturn result
EndProcedure
Procedure.s Format_mFloatD(Value.d, Format.s)
Protected decimals.i
;find decimal sign (point or comma)
decimals = Format_mDecPoint(@Format) - 1
;convert to string
If decimals > 0
ProcedureReturn StrD(Value, decimals)
EndIf
ProcedureReturn Str(Value)
EndProcedure
Procedure.s Format_mFloatF(Value.f, Format.s)
Protected decimals.i
;find decimal sign (point or comma)
decimals = Format_mDecPoint(@Format) - 1
;convert to string
If decimals > 0
ProcedureReturn StrF(Value, decimals)
EndIf
ProcedureReturn Str(Value)
EndProcedure
;- FORMAT PROCEDURES:
Procedure.s FormatD(Value.d, Format.s)
Protected Buffer.s = Format_mFloatD(Value, Format)
ProcedureReturn Format_mFormat(Buffer, Format)
EndProcedure
Procedure.s FormatF(Value.f, Format.s)
Protected Buffer.s = Format_mFloatF(Value, Format)
ProcedureReturn Format_mFormat(Buffer, Format)
EndProcedure
Procedure.s FormatI(Value.q, Format.s)
Protected Buffer.s = Str(Value)
ProcedureReturn Format_mFormat(Buffer, Format)
EndProcedure
;- EXAMPLES
;{
; -----------------------------------------------------------------------
;
; ;6-digits precision with decimal *point*
; x.d = 33 / 7
; Debug x
; Debug FormatD(x, "#.######")
; ;6-digits precision with decimal *comma*
; x.d = 33 / 7
; Debug x
; Debug FormatD(x, "#,######")
; ;leading zeros
; x.l = 75
; Debug FormatI(x, "0####")
; ;decimal notation with integer
; x.l = 75
; Debug FormatI(x, "$####.##")
; ;remove unused leading placeholders
; x.d = 333 / 7
; Debug x
; Debug FormatD(x, "/####.########")
; ;round to integer
; Debug FormatD(x, "/###")
; negative numbers
; Debug FormatD(-1.33435,"##.##")
; Define x.d = -33 / 7
; Debug x
; Debug FormatD(x, "##.######")
; currency notation
; OpenConsole()
; PrintN(FormatD(1.35, "$ #.###.###,##"))
; PrintN(FormatD(4895.208, "$ #.###.###,##"))
; ; remove unused digit placeholders
; PrintN(FormatD(4895.208, "/$ #.###.###,##"))
; Input()
; CloseConsole()
; -----------------------------------------------------------------------
;}
