VB6如何用+ infinity，-infinity和NaN初始化雙精度？

Question

VB6似乎並沒有讓它很容易將+ infinity，-infinity和NaN存儲到雙重變量中。如果可以的話，這將有助於我在複雜數字的背景下與這些值進行比較。怎麼樣？

Answer 1

一些不同的東西。正如你從Pax的例子中可以看到的，你只需要查看IEEE 754標準，然後將你的字節插入正確的位置。我會給你的唯一警告是MicroSoft has deprecated RtlMoveMemory，因爲它可能會產生溢出類型的安全問題。作爲替代方案，您可以使用「用戶定義類型」和「LSet」在「純」VB中稍微小心地強制執行此操作。 （另請注意，有兩種不同的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 

最後一個側面說明，你還可以得到NaN的這樣：

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

Answer 2

This page顯示了一個稍微折磨的方式來做到這一點。我已經將它縮小以符合你所要求的問題，但沒有完全測試。讓我知道是否有任何問題。我在該網站上注意到的一件事是，他們爲安靜的NaN編寫的代碼是錯誤的，它應該以1位開始尾數 - 他們似乎已經與信號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 

它基本上使用內核級存儲器拷貝到所述位模式從字節數組的雙重傳輸。

你應該記住然而，有能夠代表QNAN多位值，特別是符號位可以是0或1，除了第尾數的所有位也可以是0或1。這可能會使您的比較策略複雜化，除非您可以發現VB6是否只使用一種位模式 - 但它不會影響這些值的初始化，但假設VB6正確實現了IEE754雙工。

Answer 3

其實，還有一個更簡單的方式來獲得無窮，負無窮，而不是一個號碼：

public lfNaN as Double ' or As Single 
public lfPosInf as Double 
public lfNegInf as Double 

on error resume next ' to ignore Run-time error '6': Overflow and '11': Division by zero 
lfNaN = 0/0  ' -1.#IND 
lfPosInf = 1/0  ' 1.#INF 
lfNegInf = -1/0  ' -1.#INF 

on error goto 0   ' optional to reset the error handler