Bin2Double und umgekehrt

[NicTheQuick]

Nach dem Eintrag in der FAQ, hier nur der passende Code:

Code: Alles auswählen

Procedure.s Double2Bin(Dec.d, nbDecimals.l = 64)
  Protected i.q = IntQ(Dec), bin.s, post.s
  
  Dec - i
  While i
    If i & 1
      bin = "1" + bin
    Else
      bin = "0" + bin
    EndIf
    i >> 1
  Wend
  
  While Dec <> 0.0 And i < nbDecimals
    Dec * 2
    If Dec >= 1
      post + "1"
      Dec - 1
    Else
      post + "0"
    EndIf
    i + 1
  Wend
  
  If bin
    If post : bin + "." + post : EndIf
  Else
    If post
      bin = "0." + post
    Else
      bin = "0"
    EndIf
  EndIf
  
  ProcedureReturn bin
EndProcedure

Procedure.d Bin2Double(bin.s)
  Protected i.q, Double.d, *c.Character = @bin, post.d
  
  While *c\c And *c\c <> '.'
    i << 1
    If *c\c <> '0'
      i | 1
    EndIf
    *c + SizeOf(Character)
  Wend
  If *c\c = 0 :  ProcedureReturn i : EndIf
  
  *c + SizeOf(Character)
  post = 0.5
  While *c\c
    If *c\c <> '0'
      Double + post
    EndIf
    post * 0.5
    *c + SizeOf(Character)
  Wend
  
  ProcedureReturn Double + i
EndProcedure

Debug Double2Bin(#PI)
Debug Double2Bin(0.222)
Debug Double2Bin(0.333)
Debug Double2Bin(0.444)
Debug Double2Bin(0.555)
Debug Double2Bin(0.666)
Debug Double2Bin(0.777)
Debug Double2Bin(0.888)
Debug Double2Bin(0.999)
Debug ""
Debug Bin2Double("1011")
Debug Bin2Double("0.110011001100")
Debug Bin2Double("0.11")
Debug Bin2Double("10.011")