LIB-PB v6.20: Format String like sprintf
Posted: Thu Dec 26, 2024 10:54 pm
Orginal without user library show Format string with some values like sprintf (C)
Advantage:
- Zero replacement parameters are no longer written before the function is called.
- Limit to 9 optional parameters
In the previous format function, you could get the stack address from the first value parameter and thus get the following parameters directly from the stack (also works with C compiler)
Passing the stack address to a subfunction is not possible. So first take over the parameters and then call the subfunction.
FormatString.pb
Advantage:
- Zero replacement parameters are no longer written before the function is called.
- Limit to 9 optional parameters
In the previous format function, you could get the stack address from the first value parameter and thus get the following parameters directly from the stack (also works with C compiler)
Passing the stack address to a subfunction is not possible. So first take over the parameters and then call the subfunction.
FormatString.pb
Code: Select all
;-TOP
; Comment : User Library Formatierung von Strings und Werte
; Author : mk-soft, Germany
; File : FormatString.pb
; Version : 1.01.1
; Create : 25.12.2024
; Update : 25.12.2024
;
; Link : https://www.purebasic.fr/english/viewtopic.php?t=85991
;
; ***************************************************************************************
; 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
;
; Control Character;
; \\ Backslash (\)
; \n Line Feed
; \r Carriage Return
; \t Horizontal Tab
; \v Vertical Tab
; \' Double Quote (")
; \a Bell
; \b Back Space
; \f Form Feed
; \[ Escape
; \% Procent (%)
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
DisablePureLibrary FormatString
Declare.s _Format(*text.Character, cArgs, *pArgs.Integer)
; QuickHelp FormatString(Text$, *pValue1 [ ,*pValue2 [ ,*pValue3 [ ,*pValue4 [ ,*pValue5 [ ,*pValue6, [*pValue7 [ ,*pValue8 [ ,*pValue9]]]]]]]])
ProcedureDLL.s FormatString9(Text$, *pValue1, *pValue2, *pValue3, *pValue4, *pValue5, *pValue6, *pValue7, *pValue8, *pValue9)
Dim *args(9)
*args(0) = *pValue1
*args(1) = *pValue2
*args(2) = *pValue3
*args(3) = *pValue4
*args(4) = *pValue5
*args(5) = *pValue6
*args(6) = *pValue7
*args(7) = *pValue8
*args(8) = *pValue9
ProcedureReturn _Format(@Text$, 9, @*args())
EndProcedure
ProcedureDLL.s FormatString8(Text$, *pValue1, *pValue2, *pValue3, *pValue4, *pValue5, *pValue6, *pValue7, *pValue8)
Dim *args(8)
*args(0) = *pValue1
*args(1) = *pValue2
*args(2) = *pValue3
*args(3) = *pValue4
*args(4) = *pValue5
*args(5) = *pValue6
*args(6) = *pValue7
*args(7) = *pValue8
ProcedureReturn _Format(@Text$, 8, @*args())
EndProcedure
ProcedureDLL.s FormatString7(Text$, *pValue1, *pValue2, *pValue3, *pValue4, *pValue5, *pValue6, *pValue7)
Dim *args(7)
*args(0) = *pValue1
*args(1) = *pValue2
*args(2) = *pValue3
*args(3) = *pValue4
*args(4) = *pValue5
*args(5) = *pValue6
*args(6) = *pValue7
ProcedureReturn _Format(@Text$, 7, @*args())
EndProcedure
ProcedureDLL.s FormatString6(Text$, *pValue1, *pValue2, *pValue3, *pValue4, *pValue5, *pValue6)
Dim *args(6)
*args(0) = *pValue1
*args(1) = *pValue2
*args(2) = *pValue3
*args(3) = *pValue4
*args(4) = *pValue5
*args(5) = *pValue6
ProcedureReturn _Format(@Text$, 6, @*args())
EndProcedure
ProcedureDLL.s FormatString5(Text$, *pValue1, *pValue2, *pValue3, *pValue4, *pValue5)
Dim *args(5)
*args(0) = *pValue1
*args(1) = *pValue2
*args(2) = *pValue3
*args(3) = *pValue4
*args(4) = *pValue5
ProcedureReturn _Format(@Text$, 5, @*args())
EndProcedure
ProcedureDLL.s FormatString4(Text$, *pValue1, *pValue2, *pValue3, *pValue4)
Dim *args(4)
*args(0) = *pValue1
*args(1) = *pValue2
*args(2) = *pValue3
*args(3) = *pValue4
ProcedureReturn _Format(@Text$, 4, @*args())
EndProcedure
ProcedureDLL.s FormatString3(Text$, *pValue1, *pValue2, *pValue3)
Dim *args(3)
*args(0) = *pValue1
*args(1) = *pValue2
*args(2) = *pValue3
ProcedureReturn _Format(@Text$, 3, @*args())
EndProcedure
ProcedureDLL.s FormatString2(Text$, *pValue1, *pValue2)
Dim *args(2)
*args(0) = *pValue1
*args(1) = *pValue2
ProcedureReturn _Format(@Text$, 2, @*args())
EndProcedure
ProcedureDLL.s FormatString(Text$, *pValue1)
Dim *args(1)
*args(0) = *pValue1
ProcedureReturn _Format(@Text$, 1, @*args())
EndProcedure
Procedure.s _Format(*text.Character, cArgs, *pArgs.Integer)
Protected *pValue.udtAny, param_align
Protected result.s, help.s
Protected IsValue, IsString, IsLeft, IsVZ, IsNum2, SetFill.s, num1, num2
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)
If cArgs = 0
result + "%"
Else
*pValue = *pArgs\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 *pValue : help = Str(*pValue\a) : EndIf : IsValue = #True
Case 'b'
If *pValue : help = Str(*pValue\b) : EndIf : IsValue = #True
Case 'u'
If *pValue : help = StrU(*pValue\u, #PB_Word) : EndIf : IsValue = #True
Case 'w'
If *pValue : help = Str(*pValue\w) : EndIf : IsValue = #True
Case 'l'
If *pValue : help = Str(*pValue\l) : EndIf : IsValue = #True
Case 'q'
If *pValue : help = Str(*pValue\q) : EndIf : IsValue = #True
Case 'i'
If *pValue : help = Str(*pValue\i) : EndIf : IsValue = #True
Case 'f'
If *pValue : help = StrF(*pValue\f, num2) : EndIf : IsValue = #True
Case 'd'
If *pValue : help = StrD(*pValue\d , num2) : EndIf : IsValue = #True
Case 's'
If *pValue : help = PeekS(*pValue) : EndIf
If num2 : help = Left(help, num2) : EndIf : IsString = #True
Case 'c'
If *pValue : help = Chr(*pValue\i) : EndIf : IsString = #True
Case 'X', 'x'
If num2 = 0 : num2 = num1 : EndIf
If *pValue
Select num2
Case 0 To 2 : help = RSet(Hex(*pValue\b, #PB_Byte), num2, "0")
Case 3 To 4 : help = RSet(Hex(*pValue\w, #PB_Word), num2, "0")
Case 5 To 8 : help = RSet(Hex(*pValue\l, #PB_Long), num2, "0")
Default : help = RSet(Hex(*pValue\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
cArgs - 1
*pArgs + SizeOf(Integer)
Break
EndIf
ForEver
EndIf
Default
result + Chr(*text\c)
*text + SizeOf(character)
EndSelect
ForEver
ProcedureReturn result
EndProcedure