Author Topic: Format$ update by RhoSigma  (Read 1589 times)

0 Members and 1 Guest are viewing this topic.

Offline bplus

  • Moderator
  • Forum Resident
  • Posts: 6642
  • b = b + ...
Format$ update by RhoSigma
« on: August 24, 2020, 11:55:25 AM »
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.

Code: QB64: [Select]
  1. _TITLE "FormatExample"
  2. '=== Full description for the IndexFormat$() function is available
  3. '=== in the separate HTML document.
  4. '=====================================================================
  5. WIDTH , 30
  6.  
  7.  
  8. '-- The following format templates need its arguments in different order,
  9. '-- no problem with indexing, no need to reorder the given arguments.
  10. '-- You may even use different formatting for the same argument, as long
  11. '-- as its types are compatible (ie. string vs. number).
  12. dateDE$ = "Date format Germany: 0{#}. 1{&} 2{####}" ' 1{} = full string
  13. dateUS$ = "Date format US     : 1{\ \}/0{#} 2{####}" '1{} = first 3 chars only
  14.  
  15. '-- The easiest way to pass a variable number of arguments, which may
  16. '-- even be of different types, to a user function is using a string.
  17. '-- All arguments will be concatenated in this string, separated by a
  18. '-- designated char/string which does not appear in the arguments itself.
  19. '-- Strings can be added as is, numbers can be added as literal strings
  20. '-- too, or in the form STR$(variable).
  21. year% = 2021
  22. argStr$ = "2|Januar|" + STR$(year%)
  23. '-- In this example the | is the argument separator. Use whatever is
  24. '-- suitable for your needs, maybe even a CHR$(0).
  25.  
  26. '-- Now let's test the whole thing, we've different token orders in the
  27. '-- format templates, but use the same argument string for both calls.
  28. PRINT IndexFormat$(dateDE$, argStr$, "|")
  29. PRINT IndexFormat$(dateUS$, argStr$, "|")
  30.  
  31.  
  32.  
  33. '-- And here the examples from the function description, which also
  34. '-- shows the reuse of arguments without the need to pass more arguments
  35. '-- for the additional "feet" and "toes" format tokens.
  36. head = 1: hands = 2: fingers = 10
  37. PRINT USING "## head, ## hands and ## fingers"; head, hands, fingers
  38. PRINT USING "## fingers, ## head and ## hands"; head, hands, fingers
  39.  
  40. argStr$ = STR$(head) + "|" + STR$(hands) + "|" + STR$(fingers)
  41. PRINT IndexFormat$("2{##} fingers, 0{##} head and 1{##} hands", argStr$, "|")
  42. PRINT IndexFormat$("0{##} head, 1{##} hands and 2{##} fingers, also 1{##} feet and 2{##} toes", argStr$, "|")
  43.  
  44.  
  45.  
  46. '-- The function can also handle escape sequences as known from C/C++,
  47. '-- so you may use those sequences within your format templates.
  48. PRINT IndexFormat$("Column-1\tColumn-2\tColumn-3\n0{#.##}\t\t1{#.##}\t\t2{#.##}", "1.11|2.22|3.33", "|")
  49. PRINT IndexFormat$("This is a \x220{&}\x22 section.", "quoted", "|")
  50. '-- Using escape sequences and the new bin/dec/hex/oct/real formatting,
  51. '-- while reusing the same argument for all tokens. Also showing the use
  52. '-- of preferences specifiers to group bin and hex outputs.
  53. 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", "|")
  54.  
  55.  
  56.  
  57. '-- Alignment of strings in a fixed length field, the square brackets are
  58. '-- just used to better visualize the field.
  59. PRINT IndexFormat$("[0{?L:\             \}]", "RhoSigma", "|")
  60. PRINT IndexFormat$("[0{?C:\             \}]", "RhoSigma", "|")
  61. PRINT IndexFormat$("[0{?R:\             \}]", "RhoSigma", "|")
  62.  
  63.  
  64.  
  65. '-- Finally a currency example with replaced dollar sign and flipped
  66. '-- comma/dot notation. I'd like to get that much for this function ;)
  67. PRINT IndexFormat$("Account balance: 0{?î,:**$#####,.##}", "12345.67", "|")
  68.  
  69.  
  70. '-- done
  71.  
  72.  
  73.  
  74.  
  75.  
  76. '--- Full description available in separate HTML document.
  77. '---------------------------------------------------------------------
  78. FUNCTION IndexFormat$ (fmt$, arg$, sep$)
  79. '--- option _explicit requirements ---
  80. DIM args$, shan&, dhan&, than&, idx%, cpos&, res$, lit%, tok%, ft$, cch$
  81. DIM och$, opos&, tmp$, fp$, tyl%, typ$, oval&&, temp~&&, curr%, high%
  82. '--- init ---
  83. args$ = arg$ 'avoid side effects
  84. shan& = _SOURCE: dhan& = _DEST: than& = _NEWIMAGE(256, 1, 0)
  85. _SOURCE than&: _DEST than&
  86. REDIM argArr$(0 TO 35) 'all args empty
  87. '--- parse arguments ---
  88. IF RIGHT$(args$, LEN(sep$)) <> sep$ THEN args$ = args$ + sep$
  89. FOR idx% = 0 TO 35
  90.     cpos& = INSTR(args$, sep$): IF cpos& = 0 THEN EXIT FOR
  91.     argArr$(idx%) = LEFT$(args$, cpos& - 1)
  92.     args$ = MID$(args$, cpos& + LEN(sep$))
  93. NEXT idx%
  94. '--- process format template ---
  95. res$ = "": lit% = 0: tok% = 0: ft$ = "": idx% = -1
  96. FOR cpos& = 1 TO LEN(fmt$)
  97.     cch$ = MID$(fmt$, cpos&, 1)
  98.     IF cch$ = "_" AND lit% = 0 THEN 'take next \{} as literal
  99.         IF NOT tok% THEN lit% = -1
  100.     ELSEIF cch$ = "\" AND lit% = 0 AND tok% = 0 THEN 'insert esc sequence
  101.         IF cpos& < LEN(fmt$) THEN
  102.             SELECT CASE UCASE$(MID$(fmt$, cpos& + 1, 1))
  103.                 CASE "A": och$ = CHR$(7) ' audio bell
  104.                 CASE "B": och$ = CHR$(8) ' backspace
  105.                 CASE "T": och$ = CHR$(9) ' tabulator
  106.                 CASE "N": och$ = CHR$(10) 'line feed
  107.                 CASE "V": och$ = CHR$(11) 'vertical tabulator
  108.                 CASE "F": och$ = CHR$(12) 'form feed
  109.                 CASE "R": och$ = CHR$(13) 'carriage return
  110.                 CASE "E": och$ = CHR$(27) 'escape
  111.                 CASE "0", "1", "2", "3" '  octal ASCII (3 digits)
  112.                     och$ = CHR$(VAL("&O" + MID$(fmt$, cpos& + 1, 3)))
  113.                     cpos& = cpos& + 2
  114.                 CASE "X" '                 hex ASCII (x + 2 digits)
  115.                     och$ = CHR$(VAL("&H" + MID$(fmt$, cpos& + 2, 2)))
  116.                     cpos& = cpos& + 2
  117.                 CASE ELSE: och$ = "" '     ignore unknowns
  118.             END SELECT
  119.             res$ = res$ + och$
  120.             cpos& = cpos& + 1: opos& = cpos&
  121.         END IF
  122.     ELSEIF cch$ = "{" AND lit% = 0 THEN 'begin of formatting token
  123.         IF idx% = -1 THEN
  124.             och$ = UCASE$(MID$(fmt$, cpos& - 1, 1)): tok% = -1
  125.             IF ((cpos& - 1) = opos&) OR ((och$ < "0" OR och$ > "9") AND (och$ < "A" OR och$ > "Z")) THEN och$ = "-"
  126.             IF och$ = "-" THEN och$ = "0": ELSE res$ = LEFT$(res$, LEN(res$) - 1)
  127.             IF och$ >= "A" THEN idx% = ASC(och$) - 55: ELSE idx% = VAL(och$)
  128.         END IF
  129.     ELSEIF cch$ = "}" AND lit% = 0 THEN 'end of formatting token
  130.         IF idx% >= 0 THEN
  131.             GOSUB doArgFormat: res$ = res$ + tmp$
  132.             tok% = 0: ft$ = "": idx% = -1
  133.         END IF
  134.     ELSE 'accumulate chars/symbols in correct channel
  135.         IF lit% AND INSTR("\{}", cch$) = 0 THEN cch$ = "_" + cch$
  136.         IF tok% THEN ft$ = ft$ + cch$: ELSE res$ = res$ + cch$
  137.         lit% = 0
  138.     END IF
  139. NEXT cpos&
  140. '--- cleanup & set result ---
  141. ERASE argArr$
  142. _SOURCE shan&: _DEST dhan&: _FREEIMAGE than&
  143. IndexFormat$ = res$
  144. '-----------------------------
  145. doArgFormat:
  146. CLS: tmp$ = "": fp$ = "": ft$ = LTRIM$(RTRIM$(ft$))
  147. IF LEFT$(ft$, 1) = "?" THEN
  148.     tyl% = INSTR(2, ft$, ":")
  149.     IF tyl% > 0 THEN fp$ = LEFT$(MID$(ft$, 2, tyl% - 2), 2): ft$ = LTRIM$(MID$(ft$, tyl% + 1)) 'extract format prefs
  150. IF ft$ = "" THEN RETURN 'empty token = empty formatted
  151.     CASE "!", "&", "\" 'regular string formatting
  152.         IF LEFT$(ft$, 1) = "\" THEN
  153.             tyl% = INSTR(2, ft$, "\"): IF tyl% = 0 THEN ft$ = "\" + ft$: tyl% = 2
  154.             IF LTRIM$(fp$) <> "" AND LEN(argArr$(idx%)) < tyl% THEN
  155.                 SELECT CASE LEFT$(LTRIM$(fp$), 1)
  156.                     CASE "C", "c": tyl% = (tyl% - LEN(argArr$(idx%))) \ 2
  157.                     CASE "R", "r": tyl% = tyl% - LEN(argArr$(idx%))
  158.                     CASE ELSE: tyl% = 0 'L or Unknown is default (left)
  159.                 END SELECT
  160.                 argArr$(idx%) = SPACE$(tyl%) + argArr$(idx%)
  161.             END IF
  162.         END IF
  163.         PRINT USING ft$; argArr$(idx%);: fp$ = ""
  164.     CASE "B", "D", "H", "O", "R" 'extended number formatting (bin/dec/hex/oct/real)
  165.         typ$ = LEFT$(ft$, 1): tyl% = VAL(MID$(ft$, 2))
  166.         SELECT CASE typ$
  167.             CASE "B", "b": GOSUB doBinString
  168.             CASE "D", "d": tmp$ = LTRIM$(STR$(_ROUND(VAL(argArr$(idx%)))))
  169.             CASE "H", "h"
  170.                 tmp$ = HEX$(VAL(argArr$(idx%)))
  171.                 IF typ$ = "H" THEN tmp$ = UCASE$(tmp$): ELSE tmp$ = LCASE$(tmp$)
  172.             CASE "O", "o": tmp$ = OCT$(VAL(argArr$(idx%)))
  173.             CASE "R", "r": tmp$ = LTRIM$(STR$(VAL(argArr$(idx%)))): fp$ = ""
  174.         END SELECT
  175.         IF tyl% > 0 THEN 'adjust field length (if any)
  176.             IF LEN(tmp$) <= tyl% THEN
  177.                 tmp$ = RIGHT$(STRING$(tyl%, "0") + tmp$, tyl%): idx% = INSTR(tmp$, "-")
  178.                 IF idx% > 0 THEN
  179.                     typ$ = UCASE$(MID$(tmp$, idx% - 1, 1))
  180.                     IF typ$ <> "E" AND typ$ <> "D" THEN tmp$ = "-" + LEFT$(tmp$, idx% - 1) + MID$(tmp$, idx% + 1)
  181.                 END IF
  182.             ELSE
  183.                 tmp$ = "%" + tmp$
  184.             END IF
  185.         END IF
  186.         IF LTRIM$(fp$) <> "" THEN 'apply grouping (if any)
  187.             typ$ = "": tyl% = 0
  188.             FOR idx% = LEN(tmp$) TO 1 STEP -1
  189.                 typ$ = MID$(tmp$, idx%, 1) + typ$: tyl% = tyl% + 1
  190.                 IF tyl% = VAL(fp$) THEN typ$ = " " + typ$: tyl% = 0
  191.             NEXT idx%
  192.             tmp$ = LTRIM$(typ$): IF LEFT$(tmp$, 2) = "- " THEN tmp$ = "-" + MID$(tmp$, 3)
  193.         END IF
  194.         RETURN
  195.     CASE ELSE 'regular number formatting (or invalid nonsense)
  196.         IF INSTR(ft$, "**") = 0 AND INSTR(ft$, "$$") = 0 AND INSTR(ft$, "#") = 0 THEN
  197.             PRINT ft$; 'take nonsense as is
  198.         ELSE
  199.             PRINT USING ft$; VAL(argArr$(idx%));
  200.         END IF
  201. tyl% = INSTR(fp$, ","): IF tyl% > 0 THEN MID$(fp$, tyl%, 1) = " "
  202. fp$ = LTRIM$(RTRIM$(fp$))
  203. FOR idx% = 1 TO POS(0) - 1
  204.     typ$ = CHR$(SCREEN(1, idx%)): ft$ = typ$
  205.     IF fp$ <> "" AND typ$ = "$" THEN ft$ = fp$
  206.     IF tyl% > 0 AND typ$ = "," THEN ft$ = "."
  207.     IF tyl% > 0 AND typ$ = "." THEN ft$ = ","
  208.     tmp$ = tmp$ + ft$
  209. NEXT idx%
  210. '-----------------------------
  211. doBinString:
  212. oval&& = VAL(argArr$(idx%)): temp~&& = oval&&
  213. tmp$ = STRING$(64, "0"): curr% = 64: high% = 64
  214.     IF (temp~&& AND 1) THEN MID$(tmp$, curr%, 1) = "1": high% = curr%
  215.     curr% = curr% - 1: temp~&& = temp~&& \ 2
  216. LOOP UNTIL temp~&& = 0
  217. IF oval&& < 0 THEN
  218.     IF -oval&& < &H0080000000~&& THEN high% = 33
  219.     IF -oval&& < &H0000008000~&& THEN high% = 49
  220.     IF -oval&& < &H0000000080~&& THEN high% = 57
  221. tmp$ = MID$(tmp$, high%)
  222.  
  223.  
« Last Edit: January 02, 2021, 09:40:04 PM by bplus »