'===========================================================================
' Subject: BASE CONVERSION ROUTINE            Date: 07-28-96 (12:32)       
'  Author: Tyler Barnes                       Code: QB, QBasic, PDS        
'  Origin: Tyler.Barnes@access.cn.camriv.b  Packet: ALGOR.ABC
'===========================================================================
'A lot of the code in this sub is extraneous, and is only put there to speed things up.

'If you don't know how to use this, just email me at Tyler.Barnes@access.cn.camriv.bc.ca

DECLARE SUB Base2Base (Number1$, Digits1$, Number2$, Digits2$)
CONST Bin = "01", Oct = "01234567", Dec = "0123456789", Hex = "0123456789ABCDEF"

DEFLNG A-Z
SUB Base2Base (Number1$, Digits1$, Number2$, Digits2$)
Number1$ = UCASE$(Number1$): Digits1$ = UCASE$(Digits1$)
Digits2$ = UCASE$(Digits2$)
IF Digits1$ <> "0123456789" THEN
FOR I% = LEN(Number1$) TO 1 STEP -1
IF Digits1$ = "01234567" THEN FinalNum = VAL("&O" + Number1$): I% = 1
IF Digits1$ = "0123456789ABCDEF" THEN FinalNum = VAL("&H" + Number1$): I% = 1
CD$ = MID$(Number1$, I%, 1)
CV% = INSTR(Digits1$, CD$) - 1
FinalNum = FinalNum + (CV% * (LEN(Digits1$) ^ ABS(I% - LEN(Number1$))))
NEXT I%
ELSE
FinalNum = VAL(Number1$)
END IF
IF Digits2$ = "0123456789" THEN Number2$ = LTRIM$(STR$(FinalNum)): EXIT SUB
IF Digits2$ = "0123456789ABCDEF" THEN Number2$ = HEX$(FinalNum): EXIT SUB
IF Digits2$ = "01234567" THEN Number2$ = OCT$(FinalNum): EXIT SUB
Number2$ = "": NeverDone% = 1
LD2% = LEN(Digits2$)
DO
FOR I% = 1 TO LD2%
IT& = (I% - 1) * (LD2% ^ DPos%)
IF IT& > FinalNum THEN Z% = 1: I% = I% - 1
IF IT& = FinalNum OR Z% = 1 THEN
IF Z% = 1 THEN
IF I% = 1 THEN I% = LD2%: DPos% = DPos% - 1
END IF
IF NeverDone% = 1 THEN NeverDone% = 0: N2$ = STRING$(DPos% + 1, "0")
MID$(N2$, LEN(N2$) - DPos%, 1) = MID$(Digits2$, I%, 1)
FinalNum = FinalNum - ((I% - 1) * (LD2% ^ DPos%))
DPos% = -1
Z% = 0
EXIT FOR
END IF
NEXT I%
DPos% = DPos% + 1
LOOP UNTIL FinalNum = 0
Number2$ = N2$
END SUB