De retour des ameriques, j'ai ramené ce code tout chaud de AKJ
Cela va donc faire, d'apres mes calculs, et si "je m'ai pas trompé", au moins deux heureux
ATTENTION !!!, Il est pour la 4.20.
Pour la 4.10 modifier la ligne 14 :
Code : Tout sélectionner
If Left(tmp$,1)="0": dec$ = Mid(tmp$, 2, 100): Else: dec$ = tmp$: EndIf
En fait, j'ai mis 100 au hasard, apparement ça ne pose pas de probleme
Il est trop fort ce KCC
Code : Tout sélectionner
; Binary AKJ 31-Jan-08
Procedure.s ConvertBinary(dec$)
; Convert a decimal string (no leading zeroes) to binary
Protected bin$, tmp$, carry, p, digit, quot
bin$ = ""
While dec$
tmp$ = "": carry=0
For p=1 To Len(dec$)
digit = Val(Mid(dec$,p,1))+carry*10
quot = digit/2 : carry = digit-quot-quot
tmp$ + Chr(quot+'0')
Next p
If Left(tmp$,1)="0": dec$ = Mid(tmp$, 2): Else: dec$ = tmp$: EndIf
bin$ = Chr('0'+carry)+bin$
Wend
ProcedureReturn bin$
EndProcedure
Procedure.s ConvertDecimal(bin$)
; Convert a binary string (no leading zeroes) to decimal
Protected dec$, p, carry, tmp$, q, digit
If bin$="": ProcedureReturn "": EndIf
dec$ = "0"
For p = 1 To Len(bin$)
If Mid(bin$,p,1)="1": carry=1: Else: carry=0: EndIf
tmp$ = ""
For q = Len(dec$) To 1 Step -1
digit = Val(Mid(dec$, q, 1))*2+carry
If digit>9
carry = 1: tmp$ = Chr(digit-10+'0') + tmp$
Else
carry = 0: tmp$ = Chr(digit+'0') + tmp$
EndIf
Next q
If carry: dec$ = "1"+tmp$: Else: dec$ = tmp$: EndIf
Next p
ProcedureReturn dec$
EndProcedure
Define dec$, bin$, tmp$
dec$ = "35735435438573546876687387443738743743573874387438743878374387438743873874387373745434"
Debug dec$
bin$ = ConvertBinary(dec$)
Debug bin$
tmp$ = ConvertDecimal(bin$)
Debug tmp$
If dec$<>tmp$: Debug "D>B>D Error": EndIf
Debug "---"
bin$ = "101011011101010101000101010101010110101101010101000101010101010101001010101010101010101011111101101010101101101010"
Debug bin$
dec$ = ConvertDecimal(bin$)
Debug dec$
tmp$ = ConvertBinary(dec$)
Debug tmp$
If bin$<>tmp$: Debug "B>D>B Error": EndIf
End