Hex2Val (0-255)

Share your advanced PureBasic knowledge/code with the community.
Num3
PureBasic Expert
PureBasic Expert
Posts: 2812
Joined: Fri Apr 25, 2003 4:51 pm
Location: Portugal, Lisbon
Contact:

Hex2Val (0-255)

Post by Num3 »

Code updated for 5.20+. Same as Val() with '$' prefix.

Here's a freebie :P

If anyone can improve it feel free!

Code: Select all

Procedure Hex2Val(value.s)
  
  alpha.s="0123456789ABCDEF"
  
  number=Len(value)
  Dim table(number)
  
  mult=16*(number-1)
  
  For a=1 To number
    
    If mult<=0
      mult=1
    EndIf
    
    cur.s=Mid(value,a,1)
    table(a)=(FindString(alpha,cur,0)-1)*mult
    
    If mult>1
      mult-16
    EndIf
    
  Next
  
  For a=1 To number
    out+table(a)
  Next
  
  Dim table(0)
  ProcedureReturn out
  
EndProcedure

k$="FF"
MessageRequester("",Str(Hex2Val(k$)))
fweil
Enthusiast
Enthusiast
Posts: 725
Joined: Thu Apr 22, 2004 5:56 pm
Location: France
Contact:

Post by fweil »

LO Num3,

I formerly used this one which was rather fast :

Code: Select all

Procedure Hex2Dec(n.s)
  Result.l
  Digit.l
  For i = 1 To Len(n)
    Select Mid(n, i, 1)
      Case "A"
        Digit = 10
      Case "B"
        Digit = 11
      Case "C"
        Digit = 12
      Case "D"
        Digit = 13
      Case "E"
        Digit = 14
      Case "F"
        Digit = 15
      Default
        Digit = Val(Mid(n, i, 1))
    EndSelect
    Result = 16 * Result + Digit
  Next
  ProcedureReturn Result
EndProcedure
But I changed it with this one ... runs really faster :

Code: Select all

Procedure Hex2Dec2(HexNumber.s)
  Structure OneByte
    a.b
  EndStructure
  *t.OneByte = @HexNumber
  Result.l = 0
  While *t\a <> 0
    If *t\a >= '0' And *t\a <= '9'
        Result = (Result << 4) + (*t\a - 48)
      ElseIf *t\a >= 'A' And *t\a <= 'F'
        Result = (Result << 4) + (*t\a - 55)
      ElseIf *t\a >= 'a' And *t\a <= 'f'
        Result = (Result << 4) + (*t\a - 87)
      Else
        Result = (Result << 4) + (*t\a - 55)
    EndIf
    *t + 1
  Wend
  ProcedureReturn Result
EndProcedure;
A bit tricky to understand first, but really good and fast.

KRgrds
My avatar is a small copy of the 4x1.8m image I created and exposed at 'Le salon international du meuble à Paris' january 2004 in Matt Sindall's 'Shades' designers exhibition. The original laminated print was designed using a 150 dpi printout.
User avatar
blueznl
PureBasic Expert
PureBasic Expert
Posts: 6172
Joined: Sat May 17, 2003 11:31 am
Contact:

Post by blueznl »

what flavour would you like, sir...

Code: Select all

Procedure.l x_val(string.s)
  Global x_val_type.l
  Protected p,l,b,t,c
  ;
  ; *** as normal val() except it accepts also &H &O &0 &B % \ $ 0X
  ;
  string = UCase(Trim(string))
  l = Len(string)
  t = 0
  ;
  If Left(string,1) = "$"
    p = 1
    b = 16
  ElseIf Left(string,1) = "%"
    p = 1
    b = 2
  ElseIf Left(string,1) = "\"
    p = 1
    b = 8
  ElseIf Left(string,1) = "&B"
    p = 2
    b = 2
  ElseIf Left(string,1) = "&O"
    p = 2
    b = 8
  ElseIf Left(string,1) = "&0"
    p = 2
    b = 8
  ElseIf Left(string,2) = "&H"
    p = 2
    b = 16
  ElseIf Left(string,2) = "0X"
    p = 2
    b = 16
    ;
    ; ElseIf Left(string,1) = "0"           ; i don't like this one, as i often use
    ;    p = 1                              ; preceding zeroes in front of decimals while
    ;    b = 8                              ; c(++) would turn those into octals... brrr...
    ;                                       ; well, it's up to you to uncomment these lines 
  Else
    p = 0
    b = 10
  EndIf
  ;
  While p < l
    p = p+1
    c = Asc(Mid(string,p,1))-48
    If c > 9
      c = c - 7
    EndIf
    If c >= 0 And c < b
      t = t*b+c
    Else
      l = p
    EndIf
  Wend
  x_val_type = b
  ;
  ProcedureReturn t
EndProcedure
i think i posted this before? mmmm
( PB6.00 LTS Win11 x64 Asrock AB350 Pro4 Ryzen 5 3600 32GB GTX1060 6GB - upgrade incoming...)
( The path to enlightenment and the PureBasic Survival Guide right here... )
Post Reply