home *** CD-ROM | disk | FTP | other *** search
/ POINT Software Programming / PPROG1.ISO / basic / baswiz19 / examples / bcdform.bas < prev    next >
Encoding:
BASIC Source File  |  1993-01-29  |  1.9 KB  |  56 lines
  1. '   +----------------------------------------------------------------------+
  2. '   |                                                                      |
  3. '   |        BASWIZ  Copyright (c) 1990-1993  Thomas G. Hanlin III         |
  4. '   |                                                                      |
  5. '   |                      The BASIC Wizard's Library                      |
  6. '   |                                                                      |
  7. '   +----------------------------------------------------------------------+
  8.  
  9.    DECLARE SUB BCDGetSize (LeftDigits AS INTEGER, RightDigits AS INTEGER)
  10.  
  11.    DEFINT A-Z
  12.  
  13. FUNCTION BCDFormat$ (Nr AS STRING, FormatType%, RightDigits%)
  14.    BCDGetSize LeftD, RightD
  15.    Sign$ = LEFT$(Nr, 1)
  16.    L$ = MID$(Nr, 2, LeftD)
  17.    R$ = RIGHT$(Nr, RightD)
  18.    WHILE LEFT$(L$, 1) = CHR$(0)
  19.       L$ = MID$(L$, 2)
  20.    WEND
  21.    IF L$ = "" THEN L$ = CHR$(0)
  22.    IF FormatType AND 1 AND (LEN(L$) > 3) THEN
  23.       t$ = LEFT$(L$, LEN(L$) - 3)
  24.       L$ = RIGHT$(L$, 3)
  25.       WHILE LEN(t$) > 3
  26.          L$ = RIGHT$(t$, 3) + "," + L$
  27.          t$ = LEFT$(t$, LEN(t$) - 3)
  28.       WEND
  29.       L$ = t$ + "," + L$
  30.       IF LEFT$(L$, 1) = "," THEN L$ = MID$(L$, 2)
  31.    END IF
  32.    IF FormatType AND 2 THEN L$ = "$" + L$
  33.    IF FormatType AND 8 AND (Sign$ = " ") THEN Sign$ = "+"
  34.    R$ = LEFT$(R$, ABS(RightDigits))
  35.    IF RightDigits < 0 THEN
  36.       WHILE RIGHT$(R$, 1) = CHR$(0)
  37.          R$ = LEFT$(R$, LEN(R$) - 1)
  38.       WEND
  39.    END IF
  40.    IF FormatType AND 4 THEN
  41.       R$ = R$ + Sign$
  42.    ELSE
  43.       L$ = Sign$ + L$
  44.    END IF
  45.    St$ = L$ + "." + R$
  46.    IF RightDigits = 0 THEN
  47.       tmp = INSTR(St$, ".")
  48.       St$ = LEFT$(St$, tmp - 1) + MID$(St$, tmp + 1)
  49.    END IF
  50.    FOR tmp = 1 TO LEN(St$)
  51.       ch = ASC(MID$(St$, tmp, 1))
  52.       IF ch < 10 THEN MID$(St$, tmp, 1) = CHR$(ch + 48)
  53.    NEXT
  54.    BCDFormat$ = St$
  55. END FUNCTION
  56.