Challenge: International version of PRINT USING

[Plasma]

Here's my solution. It simply changes the required symbols in QB's internal routine. This works with PRINT USING, PRINT # USING and LPRINT USING.

Code:

'===============================================================
' SetUsing by Plasma
'---------------------------------------------------------------
' International support for PRINT USING, PRINT # USING and
' LPRINT USING. Created for Moneo's challenge.
'===============================================================

DECLARE SUB SetUsing (Currency$, Thousand$, Fractional$)

' Example...
CLS
' European (if you use cp858, you can use CHR$(213) for the real Euro)
SetUsing "E", ".", ","
PRINT USING "$$#.#######,##"; 1983745.34
' USA
SetUsing "$", ",", "."
PRINT USING "$$#,#######.##"; 1983745.34


DEFINT A-Z
SUB SetUsing (Currency$, Thousand$, Fractional$)

  '===============================================================
  ' SetUsing by Plasma
  '---------------------------------------------------------------
  ' International support for PRINT USING, PRINT # USING and
  ' LPRINT USING. Created for Moneo's challenge.
  '---------------------------------------------------------------
  ' Currency$ - New currency symbol, null to keep old symbol
  '             (default is "$")
  '
  ' Thousand$ - New separator character for thousands, null to
  '             keep old character (default is ",")
  '
  ' Fractional$ - New delimiter for fractional values, null to
  '               keep old delimiter (default is ".")
  '---------------------------------------------------------------
  ' * Compatible with:      QBasic 1.x
  '                     QuickBasic 4.x (IDE & compiled)
  '                         QB PDS 7.x (IDE & compiled)
  '                          VBDOS 1.0 (IDE & compiled)
  '
  '   Note: If you compile your program, it must be compiled as
  '         a stand-alone EXE!
  '===============================================================

  ' Due to Moneo's challenge rules, $ needs to be used in the
  ' format string no matter what you set the currency symbol
  ' to. If you would like to use your specified currency symbol
  ' in the format string, change the constant below to 1.
  CONST FormatCurrency = 0

  STATIC UsingSeg1&, UsingOff1
  STATIC UsingSeg2&, UsingOff2
  STATIC Version

  ' Find the segment and offset of the symbols in B$PUFOUT
  IF UsingSeg1& = 0 THEN
    UsingSeg1& = VARSEG(DefSeg$) - &H400
    DO WHILE UsingSeg1& > 0
      DEF SEG = UsingSeg1&
      FOR i = &H0 TO &H3FF4
        IF PEEK(i) = &HB0 AND PEEK(i + 2) = &HAA THEN
        IF PEEK(i + 3) = &H8A AND PEEK(i + 4) = &HCE THEN
        IF PEEK(i + 5) = &HF6 AND PEEK(i + 6) = &HDE THEN
        IF PEEK(i + 7) = &H7C AND PEEK(i + 8) = &H12 THEN
        IF PEEK(i + 9) = &HFE AND PEEK(i + 10) = &HCF THEN
        IF PEEK(i + 11) = &H75 THEN
          UsingOff1 = i
          EXIT DO
        END IF
        END IF
        END IF
        END IF
        END IF
        END IF
      NEXT
      UsingSeg1& = UsingSeg1& - &H3F0
    LOOP
    IF i = &H3FF5 THEN ERROR 5
  END IF

  ' Find the segment and offset of the symbols in PUSCAN
  IF UsingSeg2& = 0 THEN
    UsingSeg2& = UsingSeg1&
    DO WHILE UsingSeg2& > 0
      DEF SEG = UsingSeg2&
      FOR i = &H0 TO &H3FF4
        IF PEEK(i) = &H3C AND PEEK(i + 2) = &H74 THEN
          IF PEEK(i + 3) = &H45 THEN
            IF PEEK(i + 4) = &H3C AND PEEK(i + 5) = &H5F THEN
            IF PEEK(i + 6) = &H74 AND PEEK(i + 7) = &H94 THEN
            IF PEEK(i + 8) = &H3C AND PEEK(i + 9) = &H5C THEN
            IF PEEK(i + 10) = &H74 AND PEEK(i + 11) = &HB1 THEN
              UsingOff2 = i
              Version = 45
              EXIT DO
            END IF
            END IF
            END IF
            END IF
          ELSEIF PEEK(i + 3) = &H48 THEN
            IF PEEK(i + 4) = &H3C AND PEEK(i + 5) = &H5F THEN
            IF PEEK(i + 6) = &H74 AND PEEK(i + 7) = &H8C THEN
            IF PEEK(i + 8) = &H3C AND PEEK(i + 9) = &H5C THEN
            IF PEEK(i + 10) = &H74 AND PEEK(i + 11) = &HAC THEN
              UsingOff2 = i
              Version = 71
              EXIT DO
            END IF
            END IF
            END IF
            END IF
          END IF
        END IF
      NEXT
      UsingSeg2& = UsingSeg2& - &H3F0
    LOOP
    IF i = &H3FF5 THEN ERROR 5
  END IF

  ' Change the symbols in B$PUFOUT
  DEF SEG = UsingSeg1&
  IF Currency$ <> "" THEN POKE UsingOff1 + &H1, ASC(Currency$)
  IF Thousand$ <> "" THEN POKE UsingOff1 + &H17, ASC(Thousand$)
  IF Fractional$ <> "" THEN POKE UsingOff1 + &H2D, ASC(Fractional$)

  ' Change the symbols in PUSCAN
  DEF SEG = UsingSeg2&
  IF Version = 45 THEN
    IF FormatCurrency AND Currency$ <> "" THEN
      POKE UsingOff2 + &H11, ASC(Currency$)
      POKE UsingOff2 + &H24, ASC(Currency$)
    END IF
    IF Thousand$ <> "" THEN POKE UsingOff2 + &H41, ASC(Thousand$)
    IF Fractional$ <> "" THEN
      POKE UsingOff2 + &H1, ASC(Fractional$)
      POKE UsingOff2 + &H39, ASC(Fractional$)
      POKE UsingOff2 + &H4E, ASC(Fractional$)
    END IF
  ELSE
    IF FormatCurrency AND Currency$ <> "" THEN
      POKE UsingOff2 + &H12, ASC(Currency$)
      POKE UsingOff2 + &H26, ASC(Currency$)
    END IF
    IF Thousand$ <> "" THEN POKE UsingOff2 + &H44, ASC(Thousand$)
    IF Fractional$ <> "" THEN
      POKE UsingOff2 + &H1, ASC(Fractional$)
      POKE UsingOff2 + &H3C, ASC(Fractional$)
      POKE UsingOff2 + &H52, ASC(Fractional$)
    END IF
  END IF

  EXIT SUB
  PRINT USING ""; 0   ' Force the compiler to include PRINT USING

END SUB