home *** CD-ROM | disk | FTP | other *** search
/ Power-Programmierung / CD1.mdf / basic / library / qb_pds / pbclon20 / pbc_bas / any2dec.bas < prev    next >
Encoding:
BASIC Source File  |  1992-10-07  |  1.5 KB  |  51 lines
  1. '   +----------------------------------------------------------------------+
  2. '   |                                                                      |
  3. '   |        PBClone  Copyright (c) 1990-1992  Thomas G. Hanlin III        |
  4. '   |                                                                      |
  5. '   +----------------------------------------------------------------------+
  6.  
  7. SUB Any2Dec (Number%, NumberBase%, DecimalNumber%, ErrCode%)
  8.    Result& = 0&
  9.    ErrCode% = 0
  10.    IF NumberBase% < 2 OR NumberBase% > 35 THEN
  11.       ErrCode% = -1
  12.    END IF
  13.  
  14.    Num$ = UCASE$(LTRIM$(RTRIM$(Number$)))
  15.    IF LEFT$(Num$, 1) = "-" THEN
  16.       Negate% = -1
  17.       Num$ = MID$(Num$, 2)
  18.    ELSE
  19.       Negate% = 0
  20.    END IF
  21.  
  22.    DO
  23.       Ch$ = LEFT$(Num$, 1)
  24.       Num$ = MID$(Num$, 2)
  25.       IF LEN(Ch$) THEN
  26.          Digit% = ASC(Ch$) - 48
  27.          IF Digit% > 9 THEN Digit% = Digit% - 7
  28.          IF Digit% >= NumberBase% THEN
  29.             ErrCode% = -1
  30.          ELSE
  31.             Result& = Result& * NumberBase% + CLNG(Digit%)
  32.          END IF
  33.          IF Result& > 32768 THEN ErrCode% = -1
  34.       ELSE
  35.          ErrCode% = -1
  36.       END IF
  37.    LOOP WHILE LEN(Num$) AND NOT ErrCode%
  38.  
  39.    IF NOT ErrCode% THEN
  40.       IF Result& > 32767& AND NOT Negate% OR Result& > 32768 AND Negate% THEN
  41.          ErrCode% = -1
  42.       ELSE
  43.          IF Negate% THEN
  44.             DecimalNumber% = CINT(-Result&)
  45.          ELSE
  46.             DecimalNumber% = CINT(Result&)
  47.          END IF
  48.       END IF
  49.    END IF
  50. END SUB
  51.