Code: Select all
#Include "vbcompat.bi"
Function NFormat (fdata As String, flen As Integer=10, fdec As Integer=2, _
separator As String=".") As String
'Function returns string formatted according to given field size.
'fdata - string representing number to format
'flen - maximum field lenght (should be 2 or more)
'fdec - number of digital places (0 or more, but no more than flen-2)
'separator - decimal separator in output field (like "." or ",")
'Function treats the last "." or "," as decimal separator in input field, skipping any white spaces
'and thousand separators (","). Numbers should be rounded when some precision is sacrificed.
'Result is aligned right. Overflow is reported as a string consisting of asterisks.
Dim As Integer l=Len(fdata)
Dim As Integer dp=InStrRev(fdata,".")
Dim As String outdata=String(flen-1,32)+"0"+IIf(fdec>0,separator+String(fdec,48),"")
Dim As Integer a,b,fixit
#Define overflow Return String(flen,Asc("*"))
If dp=0 Then dp=InStrRev(fdata,",") 'dot point - if there is no "." in string, check for "," also
If dp>0 And fdec>0 Then 'rewrite decimal part of number
a=dp
b=flen+1
While a<l And b<flen+fdec+1
If fdata[a]>47 And fdata[a]<58 Then
outdata[b]=fdata[a]
Else
If fdata[a]=32 Then b-=1 Else overflow 'ignore spaces; chars other than digits generate error
EndIf
a+=1
b+=1
Wend
If a<l AndAlso fdata[a]>Asc("4") Then fixit=b-1 'round up, starting from current position
a=dp-1 'a is now the last digit of integer part
Else
If dp>0 Then 'rational number is being rewriten as integer
a=dp-1
If dp<l AndAlso fdata[dp]>Asc("4") AndAlso fdata[dp]<58 Then fixit=flen-1 'rounding up is needed
Else
a=l 'the last digit of number (having no decimal part)
EndIf
EndIf
'rewrite integer part of number
b=flen
While b>0 And a>0
a-=1
b-=1
If fdata[a]<58 And fdata[a]>47 Then
outdata[b]=fdata[a]
Else
Select Case As Const fdata[a]
Case Asc("-")
If b=flen-1 Then
If b=0 Then
If dp=0 Then
outdata[b]=0
Else
If fixit Then overflow Else outdata[b]=0
EndIf
Else
outdata[b]=48
outdata[b-1]=Asc("-")
b-=1
EndIf
Else
outdata[b]=Asc("-")
EndIf
Case 32,Asc(",") 'skip thousand separators
b+=1
Case Else
overflow 'unexpected char encountered, set error
End Select
EndIf
Wend
While a>0 'there are still chars to rewrite; if any of them is not a space, set overflow
a-=1
If fdata[a]<>32 Then overflow
Wend
'check if rouding is needed because of sacrificing precision
If b<=fdec Then
Select Case As Const b
Case 0,1 'cutting whole digital part
If dp>0 AndAlso outdata[flen+1]>Asc("4") Then fixit=flen-1
Case Else 'some decimal places can be preserved
If dp>0 AndAlso outdata[flen+b]>Asc("4") Then fixit=flen+b-1
End Select
EndIf
'rounding up
If fixit Then
a=fixit 'start rounding from this char and proceed left
While a>=0 And fixit
If outdata[a]<>Asc(separator) Then 'ignore separator
Select Case As Const outdata[a]
Case Asc("-")
If a>0 Then outdata[a]=Asc("1"):outdata[a-1]=Asc("-"):b-=1:fixit=0
Case 32
outdata[a]=Asc("1"):b-=1:fixit=0
Case 57
outdata[a]=48
Case Else
outdata[a]+=1:fixit=0
End Select
EndIf
a-=1
Wend
If fixit Then overflow 'if number still needs fixing and there is no more space left, set overflow
EndIf
'cut unneeded part of number
If b<=fdec Then
Select Case As Const b
Case 0,1 'cut whole digital part
outdata=Left(outdata,flen)
Case Else 'some places can be preserved
outdata=Mid(outdata,b+1,flen)
End Select
Else 'number fits the given field, there is no need to decrease precision
outdata=Right(outdata,flen)
EndIf
'remove minus sign from numbers like "-0.00"
a=flen
While a>0
a-=1
If outdata[a]>48 And outdata[a]<58 Then Exit While 'ignore 0 and decimal separator
If outdata[a]=Asc("-") Then outdata[a]=32: Exit While
Wend
NFormat=outdata
#Undef overflow
End Function
'Testing...
Dim As String t
Dim As Integer fl=10,fd=4 'maximum field len and number of decimal places; experiment with these
#Define NumFormat(t_) t=t_:Print "["+t_+"]";Tab(25);"["+NFormat(t_,fl,fd)+"]";Tab(30+fl+fd); _
"["+Format(Val(t),String(fl-fd-IIf(fd>0,2,0),"#")+IIf(fd>0,"0."+String(fd,"0"),""))+"]"
Print "String to format";Tab(25);"Result";Tab(30+fl+fd);"FB Format"
Print Tab(25);"["+String(fl,".")+"]";Tab(30+fl+fd);"["+String(fl,".")+"]"
NumFormat(" 15 322 366,77 ")
NumFormat(" -15 322 366,775 ")
NumFormat(" 15 322 366,777 ")
NumFormat(" 15322366.977 ")
NumFormat("1532236699,777 ")
NumFormat("123456789.1")
NumFormat("123456789.5")
NumFormat("-99999.995")
NumFormat("-999 999.995")
NumFormat("-99999999.995")
NumFormat("-342")
NumFormat("-.467577348")
NumFormat("-.567577348")
NumFormat("-0.347577348")
NumFormat("-9.447577348")
NumFormat("-9.557577348")
NumFormat("999.999999998")
NumFormat("999999999.5")
NumFormat("9999999999.5")
NumFormat("-.001")
NumFormat("-.05")
NumFormat("17,290,333.05")
NumFormat("6")
Sleep