Page 2 of 2
Posted: Fri Jan 19, 2007 10:22 am
by 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
Posted: Fri Jan 19, 2007 10:43 am
by 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.
Posted: Fri Jan 19, 2007 3:50 pm
by 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.
Posted: Fri Jan 19, 2007 7:03 pm
by remi_meier
Btw, does anybody care about wrong input but me?
Some procedures crash with
and some do cool things with
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

Posted: Fri Jan 19, 2007 7:42 pm
by AND51
Trond wrote: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.
Posted: Sat Jan 20, 2007 11:42 am
by 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
Posted: Sat Jan 20, 2007 6:57 pm
by remi_meier
Oh come on, this error shouldn't slip through
(already discussed several times)
Posted: Sun Jan 21, 2007 5:27 pm
by Froggerprogger
hmm. ok. I just added a nullpointer-check...
Posted: Wed Jan 24, 2007 12:17 am
by 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)
Re: Bin2Dec() »»» Converting binary numbers to decimal system
Posted: Thu Oct 29, 2009 10:05 am
by 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)
Re: Bin2Dec() »»» Converting binary numbers to decimal system
Posted: Thu Oct 29, 2009 10:55 am
by 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.
Re: Bin2Dec() »»» Converting binary numbers to decimal system
Posted: Thu Oct 29, 2009 11:35 am
by Fred
Bin() and Hex() always display as unsigned, no matter the intput is. You can use StrU() to force the output unsigned if wanted.
Re: Bin2Dec() »»» Converting binary numbers to decimal system
Posted: Mon Nov 02, 2009 8:33 pm
by Kwai chang caine
Thanks a you two for your help
I have modified this code like FRED say
And apparently that's works fine
