Bin2Dec() »»» Converting binary numbers to decimal system

[DoubleDutch]

This does all that and more (but not as fast)!

for conversion from binary:
no$=Base(binary$,2)

then convert no$ to a number - depends on range of the number

Code: Select all

Procedure.s Base(string$,base,base2=10)
	Static table$="0123456789abcdef"
	If base>1 And base<17 And base2>1 And base2<17
		If base=base2
			result$=string$
		Else
			If base>10
				string$=LCase(string$)
			EndIf
			For loop=1 To Len(string$)
				digit=FindString(table$,Mid(string$,loop,1),1)
				If digit
					number.q*base
					number+(digit-1)
				EndIf
			Next
			If base2=10
				result$=StrQ(number)
			Else
				Repeat
					remainder=number%base2
					number=number/base2
					result$=Mid(table$,remainder+1,1)+result$
				Until number=0
			EndIf
		EndIf
	EndIf
	ProcedureReturn result$
EndProcedure

[AND51]

> no space around = operator
Everybody has his own preferences. For examnple, I don't type spaces around = when initalizing or writing into variables.
I only type spaces aorund = when comparing with IF, WHILE or UNTIL.

You might say: "What's that?" But I'm used to "my methods".

If you want to add my code to your project, for example, you can adjust it as you want. I'm doing so with your code.

[Trond]

It's ok to not prefer spaces, but look at the code:
Protected Result.q,Ptr = @Hex, Char.l=PeekC(Ptr) - '0'

You have spaces one place and not another place. Of course it doesn't have any practical consequence and everyone does it their way, so I'm not going to follow your suggestion.

[remi_meier]

Btw, does anybody care about wrong input but me?

Some procedures crash with

Code: Select all

s.s
debug bin2dec(s)

and some do cool things with

Code: Select all

s.s="bb101"
Debug Bin2Dec(s)

my procedure works

@blueznl:
Yes, I use break only with small loops or for speed reasons. But it is
better than goto (and avoids an extra variable)
Here is my opinion about your code:
- universal -> nice
- I hate your space filler ;
- You don't align "=", which looks ugly
- You don't use spaces around operators in expr. like "t*b+c"
- Your If-ElseIf-ElseIf...-EndIf block looks horrible , you have
too many unneeded function calls there (btw. who needs PeekB() if you
even work with addresses?)
- You don't seem to care about an empty string
- No Unicode (yes, I know, 3.94...)
Just my opinion. Of course one could argue about some points here

[AND51]

It's ok to not prefer spaces, but look at the code:
Protected Result.q,Ptr = @Hex, Char.l=PeekC(Ptr) - '0'

You have spaces one place and not another place. Of course it doesn't have any practical consequence and everyone does it their way, so I'm not going to follow your suggestion.

I already answered this comment. This line, that you quoted, was just a quick adjustment.
In fact, I would do it another way.

[Froggerprogger]

A little bit faster than Tronds and handles negative numbers.

+ stopps parsing when found any char not equal to 0 or 1
+ works with and without unicode
+ negative numbers supported (have to be exact 64 respective 32 bits long with beginning 1)
- no maximum length-check, so binary number with more than valid digits shifts the left ones out

Code: Select all

Procedure.l Bin2DecL(s.s) ; returns the decimal number for this (max) 32-bit-binary string 
  Protected res.l = 0 
  Protected *pS.Character = @s 
  
  If *pS = 0
    ProcedureReturn 0
  EndIf
  
  Repeat 
    Debug *pS\c 
    If *pS\c = '1' 
      res << 1 | 1 
    ElseIf *pS\c = '0' 
      res << 1 
    Else 
      Break 
    EndIf 
    *pS + SizeOf(Character) 
  ForEver 
  
  ProcedureReturn res 
EndProcedure 

Procedure.q Bin2DecQ(s.s) ; returns the decimal number for this (max) 64-bit-binary string 
  Protected res.q = 0 
  Protected *pS.Character = @s 
  
  If *pS = 0
    ProcedureReturn 0
  EndIf
  
  Repeat 
    Debug *pS\c 
    If *pS\c = '1' 
      res << 1 | 1 
    ElseIf *pS\c = '0' 
      res << 1 
    Else 
      Break 
    EndIf 
    *pS + SizeOf(Character) 
  ForEver 
  
  ProcedureReturn res 
EndProcedure

[remi_meier]

Code: Select all

s.s
Bin2DecL(s)
Bin2DecQ(s)

Oh come on, this error shouldn't slip through
(already discussed several times)

[Froggerprogger]

hmm. ok. I just added a nullpointer-check...

[breeze4me]

Inline ASM version for Windows.

Code: Select all

Procedure.q asm_Bin2Dec(bin.s)
  PUSH esi ebx
  MOV eax, 0
  MOV edx, eax
  MOV ecx, eax
  MOV esi, [p.v_bin + 8]
  TEST esi, esi ;if null pointer, exit.
  !JZ .end_calc
  !@@:
    CompilerIf #PB_Compiler_Unicode
      MOVZX ebx, word [esi+ecx*2]
    CompilerElse
      MOVZX ebx, byte [esi+ecx]
    CompilerEndIf
    XOR ebx, $30    ;AND ebx, $FFFFFFCF
    CMP ebx, 1 ;if character is not '0' or '1', then exit loop.
    !JA .end_calc
    SHLD edx, eax, 1
    SHL eax, 1
    OR eax, ebx
  INC ecx
  CMP ecx, 64
  !JB @r
  !.end_calc:
  POP ebx esi
  ProcedureReturn
EndProcedure

Procedure.q asm_Bin2Dec_ptr(*string.l)
  PUSH esi ebx
  MOV eax, 0
  MOV edx, eax
  MOV ecx, eax
  MOV esi, [p.p_string + 8]
  TEST esi, esi ;if null pointer, exit.
  !JZ .end_calc
  !@@:
    CompilerIf #PB_Compiler_Unicode
      MOVZX ebx, word [esi+ecx*2]
    CompilerElse
      MOVZX ebx, byte [esi+ecx]
    CompilerEndIf
    XOR ebx, $30    ;AND ebx, $FFFFFFCF
    CMP ebx, 1 ;if character is not '0' or '1', then exit loop.
    !JA .end_calc
    SHLD edx, eax, 1
    SHL eax, 1
    OR eax, ebx
  INC ecx
  CMP ecx, 64
  !JB @r
  !.end_calc:
  POP ebx esi
  RET 4
  ;ProcedureReturn
EndProcedure

Test code.

Code: Select all

DisableDebugger

Macro d(s, v)
  Debug s + ": " + Str(v)
EndMacro


Procedure.q Bin2Dec(binary.s)
   Protected result.q, n, temp
   For n=MemoryStringLength(@binary)-1 To 0 Step -1
      temp=(PeekC(@binary+n*SizeOf(Character))-48)*1<<(MemoryStringLength(@binary)-1-n)
      result+temp ; leave this line untouched, quad-bug otherwise!
   Next
   ProcedureReturn result
EndProcedure

Procedure.l rm_Bin2Dec(s.s) 
  Protected *ptr.CHARACTER 
  Protected pos.l, Value.l 
  
  If s 
    pos  = Len(s) - 1 
    *ptr = @s 
    
    While *ptr\c <> 0 
      If *ptr\c = '1' 
        Value + (1 << pos) 
        
      ElseIf *ptr\c <> '0' 
        Value = 0 
        Break 
        
      EndIf 
      
      pos  - 1 
      *ptr + SizeOf(CHARACTER) 
    Wend 
    
  EndIf 
  
  ProcedureReturn Value 
EndProcedure

Procedure.q Bin2Dec2(Hex.s) 
  Protected Result.q 
  Protected Char.l 
  Protected Ptr = @Hex 
  Char = PeekC(Ptr) - '0' 
  While Char <> - '0' 
    Ptr + SizeOf(Character) 
    Result = Result << 1 + Char 
    Char = PeekC(Ptr) - '0' 
  Wend 
  ProcedureReturn Result 
EndProcedure

Procedure.l Bin2DecL(s.s) ; returns the decimal number for this (max) 32-bit-binary string 
  Protected res.l = 0 
  Protected *pS.Character = @s 
  
  If *pS = 0 
    ProcedureReturn 0 
  EndIf 
  
  Repeat 
    Debug *pS\c 
    If *pS\c = '1' 
      res << 1 | 1 
    ElseIf *pS\c = '0' 
      res << 1 
    Else 
      Break 
    EndIf 
    *pS + SizeOf(Character) 
  ForEver 
  
  ProcedureReturn res 
EndProcedure 

Procedure.q Bin2DecQ(s.s) ; returns the decimal number for this (max) 64-bit-binary string 
  Protected res.q = 0 
  Protected *pS.Character = @s 
  
  If *pS = 0 
    ProcedureReturn 0 
  EndIf 
  
  Repeat 
    Debug *pS\c 
    If *pS\c = '1' 
      res << 1 | 1 
    ElseIf *pS\c = '0' 
      res << 1 
    Else 
      Break 
    EndIf 
    *pS + SizeOf(Character) 
  ForEver 
  
  ProcedureReturn res 
EndProcedure

Procedure.q asm_Bin2Dec(bin.s)
  PUSH esi ebx
  MOV eax, 0
  MOV edx, eax
  MOV ecx, eax
  MOV esi, [p.v_bin + 8]
  TEST esi, esi ;if null pointer, exit.
  !JZ .end_calc
  !@@:
    CompilerIf #PB_Compiler_Unicode
      MOVZX ebx, word [esi+ecx*2]
    CompilerElse
      MOVZX ebx, byte [esi+ecx]
    CompilerEndIf
    XOR ebx, $30    ;AND ebx, $FFFFFFCF
    CMP ebx, 1 ;if character is not '0' or '1', then exit loop.
    !JA .end_calc
    SHLD edx, eax, 1
    SHL eax, 1
    OR eax, ebx
  INC ecx
  CMP ecx, 64
  !JB @r
  !.end_calc:
  POP ebx esi
  ProcedureReturn
EndProcedure


;
PriorityClass = GetPriorityClass_(GetCurrentProcess_())
Priority = GetThreadPriority_(GetCurrentThread_())
SetPriorityClass_(GetCurrentProcess_(), #REALTIME_PRIORITY_CLASS)
SetThreadPriority_(GetCurrentThread_(), #THREAD_PRIORITY_TIME_CRITICAL)

t1 = 0
t2 = 0
t3 = 0
t4 = 0
t5 = 0
tmp = 0

;v.s
;v.s = ""
;v.s = "0120"
;v.s = BinQ($111)
;v.s = BinQ($FFFFFFFF)
;v.s = BinQ($200000000)
v.s = BinQ($1000000000000000)
;v.s = BinQ($8000000000000000)
;v.s = BinQ(-9876543210)


!rdtsc
PUSH eax
!rdtsc
POP edx
SUB eax, edx
MOV tmp, eax


;test 1 - AND51
Bin2Dec(v)
Bin2Dec(v)
Bin2Dec(v)
!rdtsc
PUSH eax
  Bin2Dec(v)
!rdtsc
POP edx
SUB eax, edx
MOV t1, eax


;test 2 - remi_meier
rm_Bin2Dec(v)
rm_Bin2Dec(v)
rm_Bin2Dec(v)
!rdtsc
PUSH eax
  rm_Bin2Dec(v)
!rdtsc
POP edx
SUB eax, edx
MOV t2, eax


;test 3 - Trond
Bin2Dec2(v)
Bin2Dec2(v)
Bin2Dec2(v)
!rdtsc
PUSH eax
  Bin2Dec2(v)
!rdtsc
POP edx
SUB eax, edx
MOV t3, eax


;test 4 - Froggerprogger
Bin2DecQ(v)
Bin2DecQ(v)
Bin2DecQ(v)
!rdtsc
PUSH eax
  Bin2DecQ(v)
!rdtsc
POP edx
SUB eax, edx
MOV t4, eax

; Bin2DecL(v)
; Bin2DecL(v)
; Bin2DecL(v)
; !rdtsc
; PUSH eax
;   Bin2DecL(v)
; !rdtsc
; POP edx
; SUB eax, edx
; MOV t4, eax


;test 5 - My Asm ver.
asm_Bin2Dec(v)
asm_Bin2Dec(v)
asm_Bin2Dec(v)
!rdtsc
PUSH eax
  asm_Bin2Dec(v)
!rdtsc
POP edx
SUB eax, edx
MOV t5, eax


EnableDebugger

CompilerIf #PB_Compiler_Unicode
  Debug "Unicode Mode"
CompilerElse
  Debug "ASCII Mode"
CompilerEndIf
Debug ""

Debug tmp
d("AND51", t1-tmp)
d("remi_meier", t2-tmp)
d("Trond", t3-tmp)
d("Froggerprogger", t4-tmp)
d("Asm ver.", t5-tmp)
Debug ""

Debug Bin2Dec(v)
Debug rm_Bin2Dec(v)
Debug Bin2Dec2(v)
Debug Bin2DecQ(v)
;Debug Bin2DecL(v)
Debug asm_Bin2Dec(v)

[Kwai chang caine]

Thanks at all for your great codes

But like usually KCC always is never happy
Somebody have a code for convert Bin2Dec with no limit ???

Because the only code with return string is the DOUBLEDUTCH code.
And it return negative result

Code: Select all

Procedure.s Base(string$,base,base2=10)
   Static table$="0123456789abcdef"
   If base>1 And base<17 And base2>1 And base2<17
      If base=base2
         result$=string$
      Else
         If base>10
            string$=LCase(string$)
         EndIf
         For loop=1 To Len(string$)
            digit=FindString(table$,Mid(string$,loop,1),1)
            If digit
               number.q*base
               number+(digit-1)
            EndIf
         Next
         If base2=10
            result$=StrQ(number)
         Else
            Repeat
               remainder=number%base2
               number=number/base2
               result$=Mid(table$,remainder+1,1)+result$
            Until number=0
         EndIf
      EndIf
   EndIf
   ProcedureReturn result$
EndProcedure

Debug Base("1010101001101011111010101111110101010110101011111111111111101000001010101111", 2,10)

[Kaeru Gaman]

this is an OLD OLD OLD thread and the codes are far obsolete!

Code: Select all

Bin$ = Bin( 23 )
Hex$ = Hex( 4711 )

Debug Bin$
Debug Val( "%" + Bin$ )

Debug Hex$
Debug Val( "$" + Hex$ )

when you get a negative Value, your Container is too small.
Use Quad instead of Long to avoid negative values.

if a Quad returns a negative value, bit63 is set, there is no way in PB to display it unsigned.

[Fred]

Bin() and Hex() always display as unsigned, no matter the intput is. You can use StrU() to force the output unsigned if wanted.

[Kwai chang caine]

Thanks a you two for your help

I have modified this code like FRED say
And apparently that's works fine