home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
World of Shareware - Software Farm 2
/
wosw_2.zip
/
wosw_2
/
QBAS
/
PBCLON20.ZIP
/
PBC$BAS.ZIP
/
ANY2DEC.BAS
< prev
next >
Wrap
BASIC Source File
|
1992-10-07
|
2KB
|
51 lines
' +----------------------------------------------------------------------+
' | |
' | PBClone Copyright (c) 1990-1992 Thomas G. Hanlin III |
' | |
' +----------------------------------------------------------------------+
SUB Any2Dec (Number%, NumberBase%, DecimalNumber%, ErrCode%)
Result& = 0&
ErrCode% = 0
IF NumberBase% < 2 OR NumberBase% > 35 THEN
ErrCode% = -1
END IF
Num$ = UCASE$(LTRIM$(RTRIM$(Number$)))
IF LEFT$(Num$, 1) = "-" THEN
Negate% = -1
Num$ = MID$(Num$, 2)
ELSE
Negate% = 0
END IF
DO
Ch$ = LEFT$(Num$, 1)
Num$ = MID$(Num$, 2)
IF LEN(Ch$) THEN
Digit% = ASC(Ch$) - 48
IF Digit% > 9 THEN Digit% = Digit% - 7
IF Digit% >= NumberBase% THEN
ErrCode% = -1
ELSE
Result& = Result& * NumberBase% + CLNG(Digit%)
END IF
IF Result& > 32768 THEN ErrCode% = -1
ELSE
ErrCode% = -1
END IF
LOOP WHILE LEN(Num$) AND NOT ErrCode%
IF NOT ErrCode% THEN
IF Result& > 32767& AND NOT Negate% OR Result& > 32768 AND Negate% THEN
ErrCode% = -1
ELSE
IF Negate% THEN
DecimalNumber% = CINT(-Result&)
ELSE
DecimalNumber% = CINT(Result&)
END IF
END IF
END IF
END SUB