PureBasic Forums - English

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