An auxiliary function for strings as sprintf. All values byref hand over. Values can be handed over up to 11.
Update v2.01
- complete new code
- change syntax for hex
- new syntax for string
- no truncate results
Update v2.02
- Bugfix: hex values from args
Update v2.03
- Bugfix: hex type
Update v2.05
- Optimize code: Thanks to peterb
- added character
Update v2.06
- change: check hex value (pcfreak)
- added: null character '\0'
Update v2.07
- added: unsigned byte
- added: unsigned word
- added: character '\%'
- change: remove most peek functions
Update v2.08
- Removed null character '\0' (It does not work)
Update v2.09
- Fixed compiler option Purifier
Code: Select all
;-TOP
; Comment : Formatierung von Strings und Werte
; Author : mk-soft, Germany
; Second Author : peterb, Czech Republic
; File : Format.pb
; Version : 2.09
; Create : 10.04.2008
; Update : 18.07.2018
;
; Compilermode :
;
; ***************************************************************************************
; Syntax:
;
; %[flags][width][.precision]specifier
;
; Flags:
; - Left-justify within the given field width; Right justification is the default
; + Forces to preceed the result with a plus or minus sign (+ or -) even for positive numbers
; '[char] Fill Character; Space is the default
;
; With:
; [Number] Minimum number of characters To be printed. If the value To be printed is shorter than this number, the result is padded With blank spaces
; The value is not truncated even if the result is larger.
;
; Precision:
; [Number] For float and Double specifiers: this is the number of digits to be printed after the decimal point
; For string specifiers: truncate string
; For hexnumber: defined input value; 2 = byte, 4 = word; 8 = dword; 16 = qword
;
; Specifier:
; b Byte
; a Unsigned byte
; w Word
; u Unsigned word
; l Long
; q Quat
; i Integer
; f Float
; d Double
; X Hex; Uppercase character
; x Hex; Lowercase character
; s String
; c Char; value as integer
; EnableExplicit
Structure udtAny
StructureUnion
a.a
b.b
c.c
w.w
u.w
l.l
i.i
f.f
d.d
q.q
EndStructureUnion
EndStructure
Procedure.s Format ( text.s, *value1 = 0, *value2 = 0, *value3 = 0, *value4 = 0, *value5 = 0, *value6 = 0, *value7 = 0, *value8 = 0, *value9 = 0, *value10 = 0, *value11 = 0 )
Protected *args.integer, *value.udtAny, param_align
Protected result.s, help.s
Protected *text.character
Protected IsValue, IsString, IsLeft, IsVZ, IsNum2, SetFill.s, num1, num2
; Check parameter align because compiler option Purifier
param_align = @*value2 - @*value1
*args = @*value1
*text = @text
Repeat
Select *text\c
Case 0
Break
Case '\'
*text + SizeOf ( character )
Select *text\c
Case 0 : Break
Case '\' : result + "\"
Case 'n' : result + #LF$
Case 'r' : result + #CR$
Case 't' : result + #HT$
Case 'v' : result + #VT$
Case 39 : result + #DQUOTE$ ; (')
Case 'a' : result + #BEL$
Case 'b' : result + #BS$
Case 'f' : result + #FF$
Case '[' : result + #ESC$
Case '%' : result + "%"
EndSelect
*text + SizeOf ( character )
Case '%'
help = "?"
IsValue = #False
IsString = #False
IsLeft = #False
IsVZ = #False
IsNum2 = #False
SetFill = " "
num1 = 0
num2 = 0
*text + SizeOf ( character )
*value = *args\i ; get pointer to value
Repeat
Select *text\c
Case 0 : Break
Case '-' : IsLeft = #True
Case '+' : IsVZ = #True
Case '.' : IsNum2 = #True
Case '%' : result + "%" : *text + SizeOf ( character ) : Break
Case 39 : *text + SizeOf ( character ) : If *text\c = 0 : Break : Else : SetFill = Chr(*text\c) : EndIf
Case '0' To '9'
If IsNum2 : num2 = num2 * 10 + *text\c - 48 : Else : num1 = num1 * 10 + *text\c - 48 : EndIf
Case 'a'
If *value : help = Str ( *value\a ) : EndIf : IsValue = #True
Case 'b'
If *value : help = Str ( *value\b ) : EndIf : IsValue = #True
Case 'u'
If *value : help = StrU ( *value\u, #PB_Word ) : EndIf : IsValue = #True
Case 'w'
If *value : help = Str ( *value\w ) : EndIf : IsValue = #True
Case 'l'
If *value : help = Str ( *value\l ) : EndIf : IsValue = #True
Case 'q'
If *value : help = Str ( *value\q ) : EndIf : IsValue = #True
Case 'i'
If *value : help = Str ( *value\i ) : EndIf : IsValue = #True
Case 'f'
If *value : help = StrF ( *value\f, num2 ) : EndIf : IsValue = #True
Case 'd'
If *value : help = StrD ( *value\d , num2 ) : EndIf : IsValue = #True
Case 's'
If *value : help = PeekS ( *value ) : EndIf
If num2 : help = Left ( help, num2 ) : EndIf : IsString = #True
Case 'c'
If *value : help = Chr ( *value\i ) : EndIf : IsString = #True
Case 'X', 'x'
If num2 = 0 : num2 = num1 : EndIf
If *value
Select num2
Case 0 To 2 : help = RSet ( Hex ( *value\b, #PB_Byte), num2, "0" )
Case 3 To 4 : help = RSet ( Hex ( *value\w, #PB_Word), num2, "0" )
Case 5 To 8 : help = RSet ( Hex ( *value\l, #PB_Long), num2, "0" )
Default : help = RSet ( Hex ( *value\q, #PB_Quad), num2, "0" )
EndSelect
EndIf
If *text\c = 'x' : help = LCase ( help ) : EndIf
IsString = #True
Default
IsString = #True
EndSelect
If IsValue And IsVZ
If Left ( help, 1 ) <> "-"
help = "+" + help
EndIf
EndIf
*text + SizeOf(character)
If IsString Or IsValue
If num1 And Len ( help ) < num1
If IsLeft
result + LSet ( help, num1, SetFill )
Else
result + RSet ( help, num1, SetFill )
EndIf
Else
result + help
EndIf
*args + param_align
Break
EndIf
ForEver
Default
result + Chr ( *text\c )
*text + SizeOf ( character )
EndSelect
ForEver
ProcedureReturn result
EndProcedure
