Die Community zu .NET und Classic VB.

Startseite / Tipps / VB 5/6-Tipp 0776: "Unendlich" Jetzt mit Kommentaren

VB 5/6-Tipp 0776: "Unendlich" Jetzt mit Kommentaren

 von OlimilO

Schwierigkeitsgrad:

Verwendete API-Aufrufe: RtlMoveMemory

Download: Download des Beispielprojektes [2.99 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
'Manchmal ist es hilfreich, bei einer Zahl zu überprüfen, ob sie an die
'im Variablentyp darstellbare Grenze stößt, um die Zahl dann adäquat als
'String darzustellen. Hier wird gezeigt, dass die Unendlichkeit in den
'Floating-Point-Standards bereits verankert ist, und wie man in VB damit
'ganz einfach umgehen kann.

Public posINF As Double ' positiv Unendlich
Public negINF As Double ' negativ Unendlich
Public NaN    As Double ' "Not A Number", "keine Zahl"
Private 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
    ' Erzeugt die Bitfolge für + oder - Unendlich
    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
    ' Erzeugt die Bitfolge für + oder - Unendlich
    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)
    ' Erzeugt die Bitfolge für "Not a Number".
    ' Funktioniert nur als ByRef-Parameter.
    ' Funktioniert nicht als Rückgabewert der Funktion,
    ' da VB sonst einen Fehler auslöst.
    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
    ' Überprüft ob die Zahl DblVal die Bitfolge für "keine Zahl" enthält.
    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
    ' Überprüft ob die Zahl DblVal die Bitfolge für positiv Unendlich enthält.
    IsPosINF = (DblVal = posINF)
End Function
Public Function IsNegINF(ByVal DblVal As Double) As Boolean
    ' Überprüft ob die Zahl DblVal die Bitfolge für negativ Unendlich enthält.
    IsNegINF = (DblVal = negINF)
End Function

Public Function NaNToString() As String
    ' Die Funktion ist trivial und liefert lediglich den String "1.#QNAN" zurück.
    ' Funktioniert nur kompiliert als Native-Code Exe;
    ' die Funktion verwendet keine String-Konstante.
    ' Es soll hier gezeigt werden, dass VB eine Double-Variable mit der
    ' entsprechenden Bitfolge für "Not A Number", über die Funktion CStr
    ' in den definierten String "1.#QNAN" umwandelt.
    On Error Resume Next
    NaNToString = CStr(NaN)
    On Error Goto 0
End Function
Public Function PosINFToString() As String
    ' Die Funktion ist trivial und liefert lediglich den String "1,#INF" zurück.
    ' Funktioniert auch in der IDE;
    ' die Funktion verwendet keine String-Konstante.
    ' Es soll hier gezeigt werden, dass VB eine Double-Variable mit der
    ' entsprechenden Bitfolge für positiv Unendlich, über die Funktion CStr
    ' in den definierten String "1,#INF" umwandelt.
    PosINFToString = CStr(posINF)
End Function
Public Function NegINFToString() As String
    ' Die Funktion ist trivial und liefert lediglich den String "-1,#INF" zurück.
    ' Funktioniert auch in der IDE;
    ' die Funktion verwendet keine String-Konstante.
    ' Es soll hier gezeigt werden, dass VB eine Double-Variable mit der
    ' entsprechenden Bitfolge für negativ Unendlich, über die Funktion CStr
    ' in den definierten String "-1,#INF" umwandelt.
    NegINFToString = CStr(negINF)
End Function

Public Sub DoubleParse(d As Double, StrVal As String)
    ' parst den String StrVal, und gibt den Wert über den Parameter d zurück.
    If Len(StrVal) > 0 Then
        StrVal = Replace(StrVal, ",", ".")
        Select Case StrVal
        Case "1.#QNAN": Call GetNaN(d)
        Case "1.#INF":  d = GetINF
        Case "-1.#INF": d = GetINF(-1)
        Case Else:      d = Val(StrVal)
        End Select
    End If
End Sub
'-------- Ende Modul "ModDouble" alias ModDouble.bas --------
'------ Anfang Modul "ModSubMain" alias ModSubMain.bas ------
Option Explicit

Sub Main()
    Call ModDouble.Init
    
    'Funktioniert nur kompiliert als Native Exe
    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 --------------