2002-05-30 21:22

'OUTPUT FORMATTING with USING$ FUNCTIONI
     DECLARE FUNCTIONI USING$(...) AS STRING
     $TYPECHECK ON
     $ESCAPECHARS ON


'all the following constants belong to the FUNCTION
'..unfortunately RAPIDQ doesn't allow to define local constants.
     CONST SGNNO%=0:CONST SGNFRONT%=1:CONST SGNBACK%=2
'               123456789012 Repeated backslash because of ESCAPECHARS
     CONST symbols$="#.,-+^*$&! \\"
     CONST signs$="- +"
     CONST log10=2.302585

'change these constants to suit your local needs
     CONST thou$="."
     CONST dec$=","
     CONST curr$="$"
     CONST fill$="*"

     FUNCTIONI USING$(...)
   'More or less accurate port of QBasic formatting function USING

   'Antoni Gual agual@eic.ictnet.es 3/6/00
   'SYNTAX:    A$=USING$(FORMATTING_STRING, LIST OF STRING AND NUMERIC VALUES)


   'Some characters in the formatting string indicate the format the rest of parameters must have:

   'NUMBER FORMATTING
   '#    digit
   '.    decimal separator
   ',    (before.) thousands separator
   '+    sign position
   '$$   LEADING currency sign
   '**   FILL LEADING SPACES WITH *
   '^^^^ 4 ^s after a valid numeric format displays value in exp value (keep place for exponent)
   '     If the format is too small for the number, the number is displayed unformatted,
   '     preceeded by a %

   'TEXT FORMATTING
   '&    entire string
   '!    only first letter
   '\  \ only (num of spaces+2) chars. Double backslashes if you have ESCAPECHARS ON
   '-    prefixing any format symbol, prints it

   'This is to use while William works to implement VB's FORMAT ;)
   'Not bundled to PRINT or LPRINT, it simply returns a string
   'Formatting string does'nt need to be the first parameter (courtesy of RapidQ double stack of params)
   ' , but must be the first string.
   'After reaching Format string's end, the function will return unformatted numeric values and strings separed by spaces
   '   Note that in this case the strings will go after numbers (also courtesy of RapidQ)
   'Displays local decimal, thousands, and currency  simbols, as stated in CONSTS (not read from Windows)


   'a lot of vars!
      DIM FORMAT$ AS STRING,OUTPUT$ AS STRING ,a$ AS STRING
      DIM ipart$ AS STRING, fpart$ AS STRING,epart$ AS STRING,spart$ AS STRING
      DIM valcount% AS INTEGER,strcount% AS INTEGER, innum% AS INTEGER,THOU% AS INTEGER,expo% AS INTEGER
      DIM DECPOS% AS INTEGER,SIGN% AS INTEGER,PAD% AS INTEGER,currency% AS INTEGER
      DIM SKIP% AS INTEGER,oom% AS INTEGER,decplaces% AS INTEGER,totplaces% AS INTEGER
      DIM i% AS INTEGER, xx% AS INTEGER,num# AS DOUBLE,b# AS DOUBLE
      DIM ptr% AS INTEGER,f$ AS STRING,i$ AS STRING,places% AS INTEGER
      DIM pad$ AS STRING,j% AS INTEGER,k% AS INTEGER,neg% AS INTEGER
      DIM INSTRING% AS INTEGER,backslash% AS INTEGER


      output$=""
      valcount%=1:strcount%=1
   'get format string
      IF PARAMSTRCOUNT THEN
       format$=PARAMSTR$(1)
       INC strcount%
       output$=""
       ptr%=1
       GOSUB reset
     'parsing format string loop
       WHILE ptr%=<LEN(format$)
        a$=MID$(format$,ptr%,1)
        xx%=INSTR(symbols$,a$)
        IF  xx% AND (skip%=0) THEN
         SELECT CASE xx%
         CASE 1 '#
          INC innum%
         CASE 2 '.
          INC innum%: DECPOS%=innum%
         CASE 3 ',
          IF innum% AND (decpos%=0)THEN :INC innum%:thou%=1: ELSE: GOSUB buildoutput:END IF
         CASE 4 '-
          IF innum% THEN INC innum%:sign%=sgnback%  ELSE  skip%=1
         CASE 5 '+
          INC innum%: sign%=sgnfront%
         CASE 7 '*
          INC pad%
          IF pad%=2 THEN INC innum%,2
         CASE 6 '^
          INC expo%

         CASE 8 '$
          INC currency%
          IF currency%=2 THEN INC innum%,2
         CASE 9 '&
          instring%=-1
         CASE 10 '!
          INC instring%
         CASE 12 '\
          INC instring%:INC backslash%
         CASE 11 'space
          IF backslash%=1 THEN :INC instring%,1 :ELSE :GOSUB buildoutput :END IF
         END SELECT
        ELSE
         GOSUB buildoutput
        END IF
        INC ptr%
       WEND
       a$="":GOSUB buildoutput
      END IF
   'output the remaining numeric values and strings separed by spaces and exit
   'CAUTION!: RapidQ FUNCTIONI doesn't preserve the relative position of strings  and values in
   'the parameter list!..So I decided strings will go after numbers!
      FOR i%=valcount% TO PARAMVALCOUNT:output$=output$+" "+ STR$(PARAMVAL(i%)):NEXT
       FOR i%=strcount% TO PARAMSTRCOUNT:output$=output$+" "+PARAMSTR$(i%):NEXT
        using$=output$
        EXIT FUNCTIONI

'This GOSUB adds to the output$ string a "dumb" char  directly from format string or a parameter correctly formatted
buildoutput:
   'a formatted string must be included
   '?expo%, A$,innum%,instring%,
        IF instring% THEN
         IF strcount%<=PARAMSTRCOUNT THEN
         'non formatted string
          IF instring%=-1 THEN
           ipart$=PARAMSTR$(strcount%)
         'fixed length string
          ELSE
           ipart$=LEFT$(PARAMSTR$(strcount%)+SPACE$(instring%),instring%)
          END IF
          output$=output$+ipart$
          INC strcount%
         END IF
   'a numeric value must be SHOWN
        ELSEIF  innum% THEN
      'if it was an isolated plus sign, print +
         IF sign%=innum% THEN
          output$=output$+"+"
      'if it was an isolated dot, print dot
         ELSEIF decpos%=1 AND innum%=1 THEN
          output$=output$+"."
         ELSE
         'is there any numeric param?
          IF valcount%=<PARAMVALCOUNT THEN
           num#=(PARAMVAL(valcount%))
           IF num# THEN oom%=ROUND(LOG(ABS(num#))/log10)+1 ELSE  oom%=0
           fpart$="":epart$="":spart$=""
            'sign processing
           IF sign%=1 THEN
            spart$=MID$(signs$,SGN(num#)+2,1)
            DEC innum%:DEC decpos%:IF decpos%<0 THEN decpos%=0
           ELSE
            neg%=1
           END IF
           num#=ABS(num#)
           totplaces%=IIF(decpos%,decpos%-1,innum%)
           places%=totplaces%-(thou%*((totplaces%-1)\ 3) )-(currency%>0)
           decplaces%=IIF (decpos%,innum%-decpos%,0)
            'exponential format
           IF expo%=4 THEN
            j%=oom%-places%
            IF num# THEN k%=oom%-places% ELSE k%=0
            IF j%>0 THEN DEC j%:INC K%
            epart$="E"+MID$(SIGNS$,SGN(k%)+2,1)+RIGHT$("00"+LTRIM$(STR$(ABS(k%))),2)
            num#=num#/(10^j%)
               '?oom%," ",j%," ",num#," ",places%," ",Totplaces%
           END IF
            'round the number
           b#=10^decplaces%
           num#=FIX(num#*b#+0.5*SGN(num#))/b#
           i$=LTRIM$(STR$(FIX(num#)))
            '?oom%," ",len(i$)," ", places%," ",totplaces%," ",innum%," ",decpos%," ",decplaces%
            'see if enough place
           IF LEN(i$)>places% THEN
            spart$="":epart$=""
            ipart$="%"+STR$(PARAMVAL(valcount%))
           ELSE
               'integer part
            pad$=IIF(pad%=2,fill$," ")
               'loop to build int part separing figures by thousands separator
            ipart$=STRING$(totplaces%,pad$)
            j%=IIF (decpos%,decpos%-1,innum%):k%=LEN(i$)
            FOR  i% =1 TO LEN(i$)
             IF thou% THEN IF i%>1 AND ((i% MOD 3) =1) THEN ipart$= REPLACE$(ipart$,thou$,j%):DEC j%
             ipart$=REPLACE$(ipart$,MID$(i$,k%,1),j%)
             DEC j%:DEC k%
            NEXT
            IF currency% THEN ipart$=REPLACE$(ipart$,curr$,j%):DEC j%
            IF sign%=0 AND neg%=1 THEN ipart$=REPLACE$(ipart$,"-",j%)
               'build frac part
            IF decplaces% THEN
             b#=10^decplaces%  'this rounding is to avoid a bug in RapidQ
             num#=FIX(FRAC(ABS(num#))*b#+0.5*SGN(num#))/b#
             F$=MID$(STR$(num#),3)
             fpart$=dec$+LEFT$(f$+STRING$(decplaces%,"0"),decplaces%)
            END IF
           END IF
            '? spart$,"|",ipart$,"|",fpart$,"|",epart$
           output$=output$+spart$+ipart$+fpart$+epart$
           INC valcount%
          END IF
         END IF
   'started to parse as padding format but numeric format did'nt follow
        ELSEIF pad%=1 THEN
         output$=output$+"*"
   'started to parse as currency format but numeric format did'nt follow
        ELSEIF currency%=1 THEN
         output$=output$+"$"
   'started to parse as exponential but had not the correct number of ^ or numeric format not there
        ELSEIF expo% THEN
         output$=output$+STRING$(expo%,"^")
        END IF
   'as GOSUB was called when a dumb char ended formatting string, output this dumb char.
        output$=output$+a$
   '?output$
reset:
   'Reset all conters and return to parsing loop
        a$=""
        backslash%=0:pad%=0
        innum%=0
        DECPOS%=0:THOU%=0:SIGN%=0:PAD%=0:currency%=0:expo%=0
        instring%=0
        skip%=0
        RETURN
       END FUNCTIONI

       $ESCAPECHARS ON
       PRINT using$("! can tell you This is a & Test&","Idiot","silly",", Is'nt?")
       PRINT USING$("This -\a is a fake format-!",111,"hello")
       DIM frm$ AS STRING
       frm$= "+##  \\    \\ , FOB,   cost  $$,####.##  each. +#,###.#^^^^ "
       PRINT using$(frm$,2,"apples",0.2,-1)
       PRINT using$(frm$,34,"cars",1010,345678907)
       PRINT using$(frm$,0,"cars",0,0)
       PRINT using$(frm$,-3,"Computers",-345.6,0.000023)
       ?"Press any key..":DO:LOOP UNTIL LEN(INKEY$)

2002-05-30 21:22