Fiddled together out of posts from here.
Polished it a bit - maybe useful for somone
HexUtils:
Code: Select all
; hex-utils
; Authors: fweil, ntq
; fiddled togetehr by Thalius ;)
;- Allocate Ressources
Global Dim Dec2BaseDigit.s(16)
; Fill Hex Data
Dec2BaseDigit(0) = "0"
Dec2BaseDigit(1) = "1"
Dec2BaseDigit(2) = "2"
Dec2BaseDigit(3) = "3"
Dec2BaseDigit(4) = "4"
Dec2BaseDigit(5) = "5"
Dec2BaseDigit(6) = "6"
Dec2BaseDigit(7) = "7"
Dec2BaseDigit(8) = "8"
Dec2BaseDigit(9) = "9"
Dec2BaseDigit(10) = "A"
Dec2BaseDigit(11) = "B"
Dec2BaseDigit(12) = "C"
Dec2BaseDigit(13) = "D"
Dec2BaseDigit(14) = "E"
Dec2BaseDigit(15) = "F"
; Original Author: fweil
Procedure.s Dec2Base(n.l, Base.l)
Protected RB.l, Out.s = "", Res.l, Result.l
Select Base
Case 16
Out = Hex(n)
Default
Result.l = n
Res.l = 0
If Base <> 0
While Result > 0
RB = Result / Base
Res = Base * RB
Out = Dec2BaseDigit(Result - Res) + Out
Result = RB
Wend
EndIf
If Out = ""
Out = "0"
EndIf
EndSelect
ProcedureReturn Out
EndProcedure
Procedure.s Dec2Hex(n.l)
Protected Res.l, R16.l, Result.l = n, Out.s = ""
While Result > 0
R16 = Result >> 4
Res = R16 << 4
Out = Dec2BaseDigit(Result - Res) + Out
Result = R16
Wend
If Out = ""
Out = "0"
EndIf
ProcedureReturn Out
EndProcedure
Procedure.s Dec2Oct(n.l)
Protected Res.l, R8.l, Result.l = n, Out.s = ""
While Result > 0
R8 = Result >> 3
Res = R8 << 3
Out = Dec2BaseDigit(Result - Res) + Out
Result = R8
Wend
If Out = ""
Out = "0"
EndIf
ProcedureReturn Out
EndProcedure
Procedure.s Dec2Bin(n.l)
Protected Res.l, R2.l, Result.l = n, Out.s =""
While Result > 0
R2 = Result >> 1
Res = 2 * R2
Out = Dec2BaseDigit(Result - Res) + Out
Result = R2
Wend
If Out = ""
Out = "0"
EndIf
ProcedureReturn Out
EndProcedure
Procedure Bin2Dec(n.s)
Protected Result.l, i.l = 1
For i.l = 1 To Len(n)
Result = 2 * Result + Val(Mid(n, i, 1))
Next
ProcedureReturn Result
EndProcedure
Procedure Oct2Dec(n.s)
Protected Result.l, i.l = 1
For i.l = 1 To Len(n)
Result = 8 * Result + Val(Mid(n, i, 1))
Next
ProcedureReturn Result
EndProcedure
; Original Author: ntq
Procedure.l Hex2Dec(h$)
Protected a$, d.l
h$=UCase(h$)
For r=1 To Len(h$)
d<<4 : a$=Mid(h$,r,1)
If Asc(a$)>60
d+Asc(a$)-55
Else
d+Asc(a$)-48
EndIf
Next
ProcedureReturn d
EndProcedure
;
; Main starts here for testing
;
DecConst.l
BinConst.s
OctConst.s
HexConst.s
OpenConsole()
DecConst = 16434824
BinConst = "111110101100011010001000"
OctConst = "76543210"
HexConst = "FAC688"
PrintN( "Dec2Base(n,2) : " + "Dec2Base(" + Str(DecConst) + ", 2 ) = " + Dec2Base(DecConst, 2) )
PrintN( "Dec2Bin(n) : Dec2Bin(" + Str(DecConst) + ") = " + Dec2Bin(DecConst) )
PrintN( "Dec2Bin(n) : Dec2Bin(" + Str(DecConst) + ") = " + Dec2Bin(DecConst) )
PrintN( "Dec2Base(n,8) : Dec2Base(" + Str(DecConst) + ",8) = " + Dec2Base(DecConst, 8) )
PrintN( "Dec2Oct(n) : Dec2Oct(" + Str(DecConst) + ") = " + Dec2Oct(DecConst) )
PrintN( "Dec2Base(n,16) : Dec2Base(" + Str(DecConst) + ",16)= " + Dec2Base(DecConst, 16) )
PrintN( "Dec2Hex(n) : Dec2Hex(" + Str(DecConst) + ") = " + Dec2Hex(DecConst) )
PrintN( "Hex(n) : Hex(" + Str(DecConst) + ") = " + Hex(DecConst) )
PrintN( "Bin2Dec(n) : Bin2Dec(" + BinConst + ") = " + Str(Bin2Dec(BinConst)) )
PrintN( "Oct2Dec(n) : Oct2Dec(" + OctConst + ") = " + Str(Oct2Dec(OctConst)) )
PrintN( "Hex2Dec(n) : Hex2Dec(" + HexConst + ") = " + Str(Hex2Dec(HexConst)) )
;
; and for fun ...
;
PrintN("Function Test:")
PrintN(Str(Hex2Dec(Dec2Hex(123456789))))
PrintN(Str(Oct2Dec(Dec2Oct(123456789))))
PrintN(Str(Bin2Dec(Dec2Bin(123456789))))
PrintN("Smack Return to exit...")
Input()
; Free ***********
CloseConsole()
End
Thalius
"
