Format$ update by RhoSigma

Samples Gallery & Reference > Utilities

(1/1)

bplus:
Author: @RhoSigma
Source: qb64.org Forum
URL: https://www.qb64.org/forum/index.php?topic=2932.msg121898#msg121898
Version: 2021-01-02
Tag: [String Function]

Description: More than just a replacement for missing FORMAT$ function from QB of past, RhoSigma has added some features to make this function more flexible. Whether you want to format some numbers with commas or create a form letter, you should find this very well documented function a handy tool for your toolbox. HTML document included in the 7z attachment.

--- Quote --- Completely new are the preferences specifiers, which allow to customize the standard behavior of some PRINT USING format symbols and the bin/dec/hex/oct outputs. So you can set an alignment for strings in a fixed length field (\\), group bin/dec/hex/oct outputs in blocks with a certain amout of digits, replace the dollar sign for currency formatting and/or flip the usage of comma and dot as group/decimal separator.

--- End quote ---

--- Code: QB64: ---_TITLE "FormatExample"'=== Full description for the IndexFormat$() function is available'=== in the separate HTML document.'=====================================================================WIDTH , 30 '-- The following format templates need its arguments in different order,'-- no problem with indexing, no need to reorder the given arguments.'-- You may even use different formatting for the same argument, as long'-- as its types are compatible (ie. string vs. number).dateDE$ = "Date format Germany: 0{#}. 1{&} 2{####}" ' 1{} = full stringdateUS$ = "Date format US : 1{\ \}/0{#} 2{####}" '1{} = first 3 chars only '-- The easiest way to pass a variable number of arguments, which may'-- even be of different types, to a user function is using a string.'-- All arguments will be concatenated in this string, separated by a'-- designated char/string which does not appear in the arguments itself.'-- Strings can be added as is, numbers can be added as literal strings'-- too, or in the form STR$(variable).year% = 2021argStr$ = "2|Januar|" + STR$(year%)'-- In this example the | is the argument separator. Use whatever is'-- suitable for your needs, maybe even a CHR$(0). '-- Now let's test the whole thing, we've different token orders in the'-- format templates, but use the same argument string for both calls.PRINT IndexFormat$(dateDE$, argStr$, "|")PRINT IndexFormat$(dateUS$, argStr$, "|")PRINT '-- And here the examples from the function description, which also'-- shows the reuse of arguments without the need to pass more arguments'-- for the additional "feet" and "toes" format tokens.head = 1: hands = 2: fingers = 10PRINT USING "## head, ## hands and ## fingers"; head, hands, fingersPRINT USING "## fingers, ## head and ## hands"; head, hands, fingers argStr$ = STR$(head) + "|" + STR$(hands) + "|" + STR$(fingers)PRINT IndexFormat$("2{##} fingers, 0{##} head and 1{##} hands", argStr$, "|")PRINTPRINT IndexFormat$("0{##} head, 1{##} hands and 2{##} fingers, also 1{##} feet and 2{##} toes", argStr$, "|")PRINT '-- The function can also handle escape sequences as known from C/C++,'-- so you may use those sequences within your format templates.PRINT IndexFormat$("Column-1\tColumn-2\tColumn-3\n0{#.##}\t\t1{#.##}\t\t2{#.##}", "1.11|2.22|3.33", "|")PRINTPRINT IndexFormat$("This is a \x220{&}\x22 section.", "quoted", "|")PRINT'-- Using escape sequences and the new bin/dec/hex/oct/real formatting,'-- while reusing the same argument for all tokens. Also showing the use'-- of preferences specifiers to group bin and hex outputs.PRINT IndexFormat$(" Bin: 0{?4:B16}\n Dec: 0{D}\n Hex: 0{?2:H8}\n Oct: 0{O}\nReal: 0{R}\n", "2021.00548", "|") '-- Alignment of strings in a fixed length field, the square brackets are'-- just used to better visualize the field.PRINT IndexFormat$("[0{?L:\ \}]", "RhoSigma", "|")PRINT IndexFormat$("[0{?C:\ \}]", "RhoSigma", "|")PRINT IndexFormat$("[0{?R:\ \}]", "RhoSigma", "|")PRINT '-- Finally a currency example with replaced dollar sign and flipped'-- comma/dot notation. I'd like to get that much for this function ;)PRINT IndexFormat$("Account balance: 0{?î,:**$#####,.##}", "12345.67", "|") '-- doneEND '--- Full description available in separate HTML document.'---------------------------------------------------------------------FUNCTION IndexFormat$ (fmt$, arg$, sep$)'--- option _explicit requirements ---DIM args$, shan&, dhan&, than&, idx%, cpos&, res$, lit%, tok%, ft$, cch$DIM och$, opos&, tmp$, fp$, tyl%, typ$, oval&&, temp~&&, curr%, high%'--- init ---args$ = arg$ 'avoid side effectsshan& = _SOURCE: dhan& = _DEST: than& = _NEWIMAGE(256, 1, 0)_SOURCE than&: _DEST than&REDIM argArr$(0 TO 35) 'all args empty'--- parse arguments ---IF RIGHT$(args$, LEN(sep$)) <> sep$ THEN args$ = args$ + sep$FOR idx% = 0 TO 35 cpos& = INSTR(args$, sep$): IF cpos& = 0 THEN EXIT FOR argArr$(idx%) = LEFT$(args$, cpos& - 1) args$ = MID$(args$, cpos& + LEN(sep$))NEXT idx%'--- process format template ---res$ = "": lit% = 0: tok% = 0: ft$ = "": idx% = -1FOR cpos& = 1 TO LEN(fmt$) cch$ = MID$(fmt$, cpos&, 1) IF cch$ = "_" AND lit% = 0 THEN 'take next \{} as literal IF NOT tok% THEN lit% = -1 ELSEIF cch$ = "\" AND lit% = 0 AND tok% = 0 THEN 'insert esc sequence IF cpos& < LEN(fmt$) THEN SELECT CASE UCASE$(MID$(fmt$, cpos& + 1, 1)) CASE "A": och$ = CHR$(7) ' audio bell CASE "B": och$ = CHR$(8) ' backspace CASE "T": och$ = CHR$(9) ' tabulator CASE "N": och$ = CHR$(10) 'line feed CASE "V": och$ = CHR$(11) 'vertical tabulator CASE "F": och$ = CHR$(12) 'form feed CASE "R": och$ = CHR$(13) 'carriage return CASE "E": och$ = CHR$(27) 'escape CASE "0", "1", "2", "3" ' octal ASCII (3 digits) och$ = CHR$(VAL("&O" + MID$(fmt$, cpos& + 1, 3))) cpos& = cpos& + 2 CASE "X" ' hex ASCII (x + 2 digits) och$ = CHR$(VAL("&H" + MID$(fmt$, cpos& + 2, 2))) cpos& = cpos& + 2 CASE ELSE: och$ = "" ' ignore unknowns END SELECT res$ = res$ + och$ cpos& = cpos& + 1: opos& = cpos& END IF ELSEIF cch$ = "{" AND lit% = 0 THEN 'begin of formatting token IF idx% = -1 THEN och$ = UCASE$(MID$(fmt$, cpos& - 1, 1)): tok% = -1 IF ((cpos& - 1) = opos&) OR ((och$ < "0" OR och$ > "9") AND (och$ < "A" OR och$ > "Z")) THEN och$ = "-" IF och$ = "-" THEN och$ = "0": ELSE res$ = LEFT$(res$, LEN(res$) - 1) IF och$ >= "A" THEN idx% = ASC(och$) - 55: ELSE idx% = VAL(och$) END IF ELSEIF cch$ = "}" AND lit% = 0 THEN 'end of formatting token IF idx% >= 0 THEN GOSUB doArgFormat: res$ = res$ + tmp$ tok% = 0: ft$ = "": idx% = -1 END IF ELSE 'accumulate chars/symbols in correct channel IF lit% AND INSTR("\{}", cch$) = 0 THEN cch$ = "_" + cch$ IF tok% THEN ft$ = ft$ + cch$: ELSE res$ = res$ + cch$ lit% = 0 END IFNEXT cpos&'--- cleanup & set result ---ERASE argArr$_SOURCE shan&: _DEST dhan&: _FREEIMAGE than&IndexFormat$ = res$EXIT FUNCTION'-----------------------------doArgFormat:CLS: tmp$ = "": fp$ = "": ft$ = LTRIM$(RTRIM$(ft$))IF LEFT$(ft$, 1) = "?" THEN tyl% = INSTR(2, ft$, ":") IF tyl% > 0 THEN fp$ = LEFT$(MID$(ft$, 2, tyl% - 2), 2): ft$ = LTRIM$(MID$(ft$, tyl% + 1)) 'extract format prefsEND IFIF ft$ = "" THEN RETURN 'empty token = empty formattedSELECT CASE UCASE$(LEFT$(ft$, 1)) CASE "!", "&", "\" 'regular string formatting IF LEFT$(ft$, 1) = "\" THEN tyl% = INSTR(2, ft$, "\"): IF tyl% = 0 THEN ft$ = "\" + ft$: tyl% = 2 IF LTRIM$(fp$) <> "" AND LEN(argArr$(idx%)) < tyl% THEN SELECT CASE LEFT$(LTRIM$(fp$), 1) CASE "C", "c": tyl% = (tyl% - LEN(argArr$(idx%))) \ 2 CASE "R", "r": tyl% = tyl% - LEN(argArr$(idx%)) CASE ELSE: tyl% = 0 'L or Unknown is default (left) END SELECT argArr$(idx%) = SPACE$(tyl%) + argArr$(idx%) END IF END IF PRINT USING ft$; argArr$(idx%);: fp$ = "" CASE "B", "D", "H", "O", "R" 'extended number formatting (bin/dec/hex/oct/real) typ$ = LEFT$(ft$, 1): tyl% = VAL(MID$(ft$, 2)) SELECT CASE typ$ CASE "B", "b": GOSUB doBinString CASE "D", "d": tmp$ = LTRIM$(STR$(_ROUND(VAL(argArr$(idx%))))) CASE "H", "h" tmp$ = HEX$(VAL(argArr$(idx%))) IF typ$ = "H" THEN tmp$ = UCASE$(tmp$): ELSE tmp$ = LCASE$(tmp$) CASE "O", "o": tmp$ = OCT$(VAL(argArr$(idx%))) CASE "R", "r": tmp$ = LTRIM$(STR$(VAL(argArr$(idx%)))): fp$ = "" END SELECT IF tyl% > 0 THEN 'adjust field length (if any) IF LEN(tmp$) <= tyl% THEN tmp$ = RIGHT$(STRING$(tyl%, "0") + tmp$, tyl%): idx% = INSTR(tmp$, "-") IF idx% > 0 THEN typ$ = UCASE$(MID$(tmp$, idx% - 1, 1)) IF typ$ <> "E" AND typ$ <> "D" THEN tmp$ = "-" + LEFT$(tmp$, idx% - 1) + MID$(tmp$, idx% + 1) END IF ELSE tmp$ = "%" + tmp$ END IF END IF IF LTRIM$(fp$) <> "" THEN 'apply grouping (if any) typ$ = "": tyl% = 0 FOR idx% = LEN(tmp$) TO 1 STEP -1 typ$ = MID$(tmp$, idx%, 1) + typ$: tyl% = tyl% + 1 IF tyl% = VAL(fp$) THEN typ$ = " " + typ$: tyl% = 0 NEXT idx% tmp$ = LTRIM$(typ$): IF LEFT$(tmp$, 2) = "- " THEN tmp$ = "-" + MID$(tmp$, 3) END IF RETURN CASE ELSE 'regular number formatting (or invalid nonsense) IF INSTR(ft$, "**") = 0 AND INSTR(ft$, "$$") = 0 AND INSTR(ft$, "#") = 0 THEN PRINT ft$; 'take nonsense as is ELSE PRINT USING ft$; VAL(argArr$(idx%)); END IFEND SELECTtyl% = INSTR(fp$, ","): IF tyl% > 0 THEN MID$(fp$, tyl%, 1) = " "fp$ = LTRIM$(RTRIM$(fp$))FOR idx% = 1 TO POS(0) - 1 typ$ = CHR$(SCREEN(1, idx%)): ft$ = typ$ IF fp$ <> "" AND typ$ = "$" THEN ft$ = fp$ IF tyl% > 0 AND typ$ = "," THEN ft$ = "." IF tyl% > 0 AND typ$ = "." THEN ft$ = "," tmp$ = tmp$ + ft$NEXT idx%RETURN'-----------------------------doBinString:oval&& = VAL(argArr$(idx%)): temp~&& = oval&&tmp$ = STRING$(64, "0"): curr% = 64: high% = 64DO IF (temp~&& AND 1) THEN MID$(tmp$, curr%, 1) = "1": high% = curr% curr% = curr% - 1: temp~&& = temp~&& \ 2LOOP UNTIL temp~&& = 0IF oval&& < 0 THEN IF -oval&& < &H0080000000~&& THEN high% = 33 IF -oval&& < &H0000008000~&& THEN high% = 49 IF -oval&& < &H0000000080~&& THEN high% = 57END IFtmp$ = MID$(tmp$, high%)RETURNEND FUNCTION

Navigation

[0] Message Index

Go to full version