Die Community zu .NET und Classic VB.

Startseite / Tipps / VB 5/6-Tipp 0747: Positiv und negativ Unendlich darstellen

VB 5/6-Tipp 0747: Positiv und negativ Unendlich darstellen

 von Oliver Meyer

Schwierigkeitsgrad:

Verwendete API-Aufrufe: RtlMoveMemory

Download: Download des Beispielprojektes [2,94 KB]

'Dieser Quellcode stammt von http://www.activevb.de
'und kann frei verwendet werden. Für eventuelle Schäden
'wird nicht gehaftet.

'Um Fehler oder Fragen zu klären, nutzen Sie bitte unser Forum.
'Ansonsten viel Spaß und Erfolg mit diesem Source!

'------------- Anfang Projektdatei Projekt1.vbp -------------
'------- Anfang Modul "ModDouble" alias ModDouble.bas -------
Option Explicit

Public posINF As Double
Public negINF As Double
Public NaN    As Double

Public Declare Sub RtlMoveMemory Lib "kernel32" ( _
    ByRef pDst As Any, ByRef pSrc As Any, ByVal bLength As Long)

Public Sub Init()
    posINF = GetINF
    negINF = GetINF(-1)
    Call GetNaN(NaN)
End Sub

'entweder mit Fehlerbehandlung:
Public Function GetINFE(Optional ByVal sign As Long = 1) As Double
    On Error Resume Next
    GetINFE = Sgn(sign) / 0
    On Error Goto 0
End Function

' oder ohne Fehlerbehandlung:
Public Function GetINF(Optional ByVal sign As Long = 1) As Double
    Dim L(1 To 2) As Long
    If Sgn(sign) > 0 Then
        L(2) = &H7FF00000
    ElseIf Sgn(sign) < 0 Then
        L(2) = &HFFF00000
    End If
    Call RtlMoveMemory(GetINF, L(1), 8)
End Function

Public Sub GetNaN(ByRef DblVal As Double)
    Dim L(1 To 2) As Long
    L(1) = 1
    L(2) = &H7FF00000
    Call RtlMoveMemory(DblVal, L(1), 8)
End Sub

Public Function IsNaN(ByRef DblVal As Double) As Boolean
    Dim b(0 To 7) As Byte
    Dim i As Long
    
    Call RtlMoveMemory(b(0), DblVal, 8)
    
    If (b(7) = &H7F) Or (b(7) = &HFF) Then
        If (b(6) >= &HF0) Then
            For i = 0 To 5
                If b(i) <> 0 Then
                    IsNaN = True
                    Exit Function
                End If
            Next
        End If
    End If
End Function

Public Function IsPosINF(ByVal DblVal As Double) As Boolean
    IsPosINF = (DblVal = posINF)
End Function

Public Function IsNegINF(ByVal DblVal As Double) As Boolean
    IsNegINF = (DblVal = negINF)
End Function

Public Function NaNToString() As String
    On Error Resume Next
    NaNToString = CStr(NaN)
    On Error Goto 0
End Function

Public Function PosINFToString() As String
    PosINFToString = CStr(posINF)
End Function

Public Function NegINFToString() As String
    NegINFToString = CStr(negINF)
End Function

Public Sub DoubleParse(d As Double, StrVal As String)
    If Len(StrVal) > 0 Then
        StrVal = Replace(StrVal, ",", ".")
        If StrComp(StrVal, "1.#QNAN") = 0 Then
            Call GetNaN(d)
        ElseIf StrComp(StrVal, "1.#INF") = 0 Then
            d = GetINF
        ElseIf StrComp(StrVal, "-1.#INF") = 0 Then
            d = GetINF(-1)
        Else
            d = CDbl(StrVal)
        End If
    End If
End Sub
'-------- Ende Modul "ModDouble" alias ModDouble.bas --------
'------ Anfang Modul "ModSubMain" alias ModSubMain.bas ------
Option Explicit

Sub Main()
    Call ModDouble.Init
    
    MsgBox "Not a Number: " & NaNToString
    
    MsgBox "Positive Infinity: " & PosINFToString
    
    MsgBox "Negative Infinity: " & NegINFToString
    
    MsgBox "? IsNaN(NaN): " & CStr(IsNaN(NaN))
    
    MsgBox "? IsPosINF(posINF): " & CStr(IsPosINF(posINF))
    
    MsgBox "? IsNegINF(negINF): " & CStr(IsNegINF(negINF))
    
    MsgBox "? IsNaN(1#): " & CStr(IsNaN(1#))
    
    MsgBox "? IsPosINF(1#): " & CStr(IsPosINF(1#))
    
    MsgBox "? IsNegINF(1#): " & CStr(IsNegINF(1#))
    
    Dim d As Double
    Dim s As String
    s = NaNToString
    Call DoubleParse(d, s)
    MsgBox CStr(d)
    
    s = PosINFToString
    Call DoubleParse(d, s)
    MsgBox CStr(d)
    
    s = NegINFToString
    Call DoubleParse(d, s)
    MsgBox CStr(d)
End Sub
'------- Ende Modul "ModSubMain" alias ModSubMain.bas -------
'-------------- Ende Projektdatei Projekt1.vbp --------------