How do you get VB6 to initialize doubles with +infinity, -infinity and NaN?

Question

VB6 doesn't appear to make it that easy to store +infinity, -infinity and NaN into double vars. It would help if it could so that I could do comparisons with those values in the context of complex numbers. How?

Answer 1

This page shows a slightly torturous way to do it. I've trimmed it down to match what your question asked for but haven't tested thoroughly. Let me know if there's any problems. One thing I noticed on that site is that the code they had for a quiet NaN was wrong, it should start the mantissa with a 1-bit - they seemed to have got that confused with a signalling NaN.

Public NegInfinity As Double
Public PosInfinity As Double
Public QuietNAN As Double

Private Declare Sub CopyMemoryWrite Lib "kernel32" Alias "RtlMoveMemory" ( _
    ByVal Destination As Long, source As Any, ByVal Length As Long)

' IEEE754 doubles:                                                          '
'   seeeeeee eeeemmmm mmmmmmmm mmmmmmmm mmmmmmmm mmmmmmmm mmmmmmmm mmmmmmmm '
'   s = sign                                                                '
'   e = exponent                                                            '
'   m = mantissa                                                            '
'   Quiet NaN: s = x, e = all 1s, m = 1xxx...                               '
'   +Inf     : s = 0, e = all 1s, m = all 0s.                               '
'   -Inf     : s = 1, e = all 1s, m = all 0s.                               '

 

Public Sub Init()
    Dim ptrToDouble As Long
    Dim byteArray(7) As Byte
    Dim i As Integer

    byteArray(7) = &H7F
    For i = 0 To 6
        byteArray(i) = &HFF
    Next
    ptrToDouble = VarPtr(QuietNAN)
    CopyMemoryWrite ptrToDouble, byteArray(0), 8

    byteArray(7) = &H7F
    byteArray(6) = &HF0
    For i = 0 To 5
        byteArray(i) = 0
    Next
    ptrToDouble = VarPtr(PosInfinity)
    CopyMemoryWrite ptrToDouble, byteArray(0), 8

    byteArray(7) = &HFF
    byteArray(6) = &HF0
    For i = 0 To 5
        byteArray(i) = 0
    Next
    ptrToDouble = VarPtr(NegInfinity)
    CopyMemoryWrite ptrToDouble, byteArray(0), 8
End Sub

It basically uses kernel-level memory copies to transfer the bit patterns from a byte array to the double.

You should keep in mind however that there are multiple bit-values that can represent QNaN, specifically the sign bit can be 0 or 1 and all bits of the mantissa other than the first can also be zero or 1. This may complicate your strategy for comparisons unless you can discover if VB6 only uses one of the bit patterns - it won't affect the initialization of those values however, assuming VB6 properly implements IEE754 doubles.

Answer 2

Actually, there is a MUCH simpler way to get Infinity and -Infinity...try this.

public lfPosInf as double
public lfNegInf as double

public sub Init
  on error resume next
  lfPosInf=1/0
  on error goto 0
  lfNegInf=-lfPosInf
end sub

Answer 3

Hi Boost, A few different things. As you can see from Pax's example, you really just need to look up the IEEE 754 standard and then plug your bytes into the right places. The only caution I would give you is that MS has depreciated RtlMoveMemory due to it's potential for creating security issues of the overflow type. As an alternative you can accomplish this in "pure" VB with a little careful coercion using User Defined Types and LSet. (Also note that there are two types of NaN.)

Option Explicit

Public Enum abIEEE754SpecialValues
    abInfinityPos
    abInfinityNeg
    abNaNQuiet
    abNaNSignalling
    abDoubleMax
    abDoubleMin
End Enum

Private Type TypedDouble
    value As Double
End Type

Private Type ByteDouble
    value(7) As Byte
End Type

Public Sub Example()
    MsgBox GetIEEE754SpecialValue(abDoubleMax)
End Sub

Public Function GetIEEE754SpecialValue(ByVal value As abIEEE754SpecialValues) As Double
    Dim dblRtnVal As Double
    Select Case value
    Case abIEEE754SpecialValues.abInfinityPos
        dblRtnVal = BuildDouble(byt6:=240, byt7:=127)
    Case abIEEE754SpecialValues.abInfinityNeg
        dblRtnVal = BuildDouble(byt6:=240, byt7:=255)
    Case abIEEE754SpecialValues.abNaNQuiet
        dblRtnVal = BuildDouble(byt6:=255, byt7:=255)
    Case abIEEE754SpecialValues.abNaNSignalling
        dblRtnVal = BuildDouble(byt6:=248, byt7:=255)
    Case abIEEE754SpecialValues.abDoubleMax
        dblRtnVal = BuildDouble(255, 255, 255, 255, 255, 255, 239, 127)
    Case abIEEE754SpecialValues.abDoubleMin
        dblRtnVal = BuildDouble(255, 255, 255, 255, 255, 255, 239, 255)
    End Select
    GetIEEE754SpecialValue = dblRtnVal
End Function

Public Function BuildDouble( _
    Optional byt0 As Byte = 0, _
    Optional byt1 As Byte = 0, _
    Optional byt2 As Byte = 0, _
    Optional byt3 As Byte = 0, _
    Optional byt4 As Byte = 0, _
    Optional byt5 As Byte = 0, _
    Optional byt6 As Byte = 0, _
    Optional byt7 As Byte = 0 _
    ) As Double
    Dim bdTmp As ByteDouble, tdRtnVal As TypedDouble
    bdTmp.value(0) = byt0
    bdTmp.value(1) = byt1
    bdTmp.value(2) = byt2
    bdTmp.value(3) = byt3
    bdTmp.value(4) = byt4
    bdTmp.value(5) = byt5
    bdTmp.value(6) = byt6
    bdTmp.value(7) = byt7
    LSet tdRtnVal = bdTmp
    BuildDouble = tdRtnVal.value
End Function

One last side note, you can also get NaN this way:

Public Function GetNaN() As Double
    On Error Resume Next
    GetNaN = 0 / 0
End Function