PureBoard

Code: Alles auswählen

;Zeige Zahlen aus dem float Wertebereich an. 
Structure VierByte 
  StructureUnion
    f.f
    l.l
  EndStructureUnion
EndStructure
Define f.VierByte\f=1e-15
Define g.VierByte\f=3e23 
Debug f\f
Debug StrF(f\f)
Debug FormatNumber(f\f,61)
Debug FormatNumber(f\f,Int(Log10(1/f\f)+17))
Debug RSet(Bin(f\l),32,"0")
Debug g\f
Debug StrF(g\f)
Debug RSet(Bin(g\l),32,"0")
Debug FormatNumber(g\f,0)
Debug ""
MessageRequester("Warte","Warte")
Define i.i=1 
f\f=1.0
g\f=1.0
While f\f>0.0
  Debug i 
  Debug f\f
  Debug StrF(f\f)
  Debug FormatNumber(f\f,61)
  Debug FormatNumber(f\f,Int(Log10(1/f\f)+17))
  Debug RSet(Bin(f\l),32,"0")
  Debug g\f
  Debug StrF(g\f)
  Debug RSet(Bin(g\l),32,"0")
  Debug FormatNumber(g\f,0)
  Debug ""
  f\f=f\f/2.0
  g\f=g\f*2.0 
  i=i+1
Wend 

Code: Alles auswählen

;-TOP
; Created by mk-soft, v1.01, 28.07.2018

CompilerSelect #PB_Compiler_OS
  CompilerCase #PB_OS_Windows
    ImportC ""
      CompilerIf #PB_Compiler_Processor = #PB_Processor_x64
        __StrE(*pResult, nBytes, sFMT.p-ascii, sBugfix.s, dblVal.d) As "_snprintf"
      CompilerElse
        __StrE(*pResult, nBytes, sFMT.p-ascii, sBugfix.s, dblVal.d) As "__snprintf"
      CompilerEndIf  
    EndImport
  CompilerCase #PB_OS_MacOS
    ImportC ""
      __StrE(*pResult, nBytes, sFMT.p-ascii, sBugfix.s, dblVal.d) As "_snprintf"
    EndImport
  CompilerCase #PB_OS_Linux
    ImportC ""
      __StrE(*pResult, nBytes, sFMT.p-ascii, sBugfix.s, dblVal.d) As "snprintf"
    EndImport
CompilerEndSelect

Procedure.s StrE(dblVal.d, decimal = 18)
  Protected *pResult
  Protected sFMT.s
  Protected Result.s
  
  *pResult = AllocateMemory(256)
  sFMT = "%s%."+Str(decimal) + "e"
  If __StrE(*pResult, 255, sFMT, #Empty$, dblVal) > 0
    Result = PeekS(*pResult, -1, #PB_Ascii)
  EndIf
  FreeMemory(*pResult)
  ProcedureReturn Result
EndProcedure


f1.f = 12345.6789
d1.d = 1234567890123456789.0

Debug StrE(f1, 8)
Debug StrE(d1,18)

Code: Alles auswählen

; Double und Float ggf. mit Exponent ausgeben. 

CompilerSelect #PB_Compiler_OS ;Created by mk-soft, v1.01, 28.07.2018
  CompilerCase #PB_OS_Windows
    ImportC ""
      CompilerIf #PB_Compiler_Processor = #PB_Processor_x64
        __StrE(*pResult, nBytes, sFMT.p-ascii, sBugfix.s, dblVal.d) As "_snprintf"
      CompilerElse
        __StrE(*pResult, nBytes, sFMT.p-ascii, sBugfix.s, dblVal.d) As "__snprintf"
      CompilerEndIf  
    EndImport
  CompilerCase #PB_OS_MacOS
    ImportC ""
      __StrE(*pResult, nBytes, sFMT.p-ascii, sBugfix.s, dblVal.d) As "_snprintf"
    EndImport
  CompilerCase #PB_OS_Linux
    ImportC ""
      __StrE(*pResult, nBytes, sFMT.p-ascii, sBugfix.s, dblVal.d) As "snprintf"
    EndImport
CompilerEndSelect

Procedure.s DebugStrF(fltVal.f)
  Protected pResult.s{128}
  Protected sFMT.s
  Protected Result.s
  If (fltVal<1e-10 And fltVal>-1e-10 And fltVal<>0.0) Or fltVal>=1e10 Or  fltVal<=-1e10   
    sFMT = "%s%.5e"
    If __StrE(@pResult, 255, sFMT, #Empty$, fltVal) > 0
      Result=PeekS(@pResult, -1, #PB_Ascii)
      ; lösche Nullen zwischen Komma und e 
      While FindString(Result,"0e")
        Result=ReplaceString(Result,"0e","e")
      Wend 
      If FindString(Result,".e")
        Result=ReplaceString(Result,".e","e")
      EndIf  
      ProcedureReturn Result
    Else
      ProcedureReturn ""
    EndIf  
  Else
    ProcedureReturn StrF(fltVal)
 EndIf 
EndProcedure

Procedure.s DebugStrD(dblVal.d)
  Protected pResult.s{128}
  Protected sFMT.s
  Protected Result.s
  If (dblVal<1e-10 And dblVal>-1e-10 And dblVal<>0.0) Or dblVal>=1e10 Or  dblVal<=-1e10  
    sFMT = "%s%.14e"
    If __StrE(@pResult, 255, sFMT, #Empty$, dblVal) > 0
      Result=PeekS(@pResult, -1, #PB_Ascii)
      ; lösche Nullen zwischen Komma und e 
      While FindString(Result,"0e")
        Result=ReplaceString(Result,"0e","e")
      Wend 
      If FindString(Result,".e")
        Result=ReplaceString(Result,".e","e")
      EndIf  
      ProcedureReturn Result
    Else
      ProcedureReturn ""
    EndIf  
  Else
    ProcedureReturn StrD(dblVal)
 EndIf 
EndProcedure

f1.f = 1e-15
d1.d = 3e23
Debug DebugStrF(f1)
Debug DebugStrD(d1) 

f1=1.23e38
While f1>0.0 
  Debug DebugStrF(f1)
  f1/10
Wend 
f1=-1.711e38
While f1<0 
  Debug DebugStrF(f1)
  f1/10
Wend 
d1=1e100
While d1>0.0 
  Debug DebugStrD(d1)
  d1/10
Wend 
d1=-1.23456789012345678e38
While d1<0 
  Debug DebugStrD(d1)
  d1/10
Wend