如何将 REAL48 浮点数转换为双倍数

将此添加为另一个答案，因为我终于想通了。 这是将转换值的PHP代码。 它必须手动计算，因为PHP不知道如何解压缩Real48(非标准(。 下面评论中的解释。

function BiIntToReal48($f1, $f2){
  $x = str_pad(decbin($f1), 16, "0", STR_PAD_LEFT);
  $y = str_pad(decbin($f2), 32, "0", STR_PAD_LEFT);
  //full Real48 binary string
  $real48 = $y . $x;
  //Real48 format is V = (-1)^s * 1.f * 2^(exp-129)
  // rightmost eight bits are the exponent  (bits 40-->47)
  // subtract 129 to get the final value
  $exp = (bindec(substr($real48, -8)) - 129);
  //Sign bit is leftmost bit (bit[0])
  $sign =$real48[0];
  //Now work through the significand - bits are fractional binary 
  //(1/2s place, 1/4s place, 1/8ths place, etc)
  // bits 1-->39 
  // significand is always 1.fffffffff... etc so start with 1.0
  $sgf = "1.0";
  for ($i = 1; $i <= 39; $i++){
      if ($real48[$i] == 1){
        $sgf = $sgf + pow(2,-$i); 
      }       
  } 
  //final calculation
  $final = pow(-1, $sign) * $sgf * pow(2,$exp);
  return($final);
}
$field_1 = 132;
$field_2 = 805306368;      
$ConvVal = BiIntToReal48($field_1, $field_2);
// ^ gives $ConvVal = 11, qed

我已经在这个问题上工作了大约一个星期，试图为我们的组织解决这个问题。

我们的财务部门使用「综合注册资讯系统」国库，我们需要降低成本。使用上面的PHP代码，我设法通过以下代码(包括依赖函数(在Excel VBA中工作。如果在下面没有正确归因，我从 www.sulprobil.com 那里得到了所有长十进制到垃圾箱的函数。如果将以下代码块复制并粘贴到模块中，则可以从单元格引用我的 ExchequerDouble 函数。

在继续之前，我必须指出上面 C/PHP 代码中的一个错误。如果你看一下 Significand 循环：

C/PHP: Significand = Significand + 2 ^ (-i)
VBA:   Significand = Significand + 2 ^ (1 - i)

我在测试过程中注意到答案非常接近，但经常不正确。进一步向下钻探，我将其缩小到Significand。这可能是将代码从一种语言/方法翻译成另一种语言/方法的问题，或者可能只是一个错字，但添加 (1 - i( 使一切变得不同。

Function ExchequerDouble(Val1 As Integer, Val2 As Long) As Double
    Dim Int2 As String
    Dim Int4 As String
    Dim Real48 As String
    Dim Exponent As String
    Dim Sign As String
    Dim Significand As String
    'Convert each value to binary
    Int2 = LongDec2Bin(Val1, 16, True)
    Int4 = LongDec2Bin(Val2, 32, True)
    'Concatenate the binary strings to produce a 48 bit "Real"
    Real48 = Int4 & Int2
    'Calculate the exponent
    Exponent = LongBin2Dec(Right(Real48, 8)) - 129
    'Calculate the sign
    Sign = Left(Real48, 1)
    'Begin calculation of Significand
    Significand = "1.0"
    For i = 2 To 40
        If Mid(Real48, i, 1) = "1" Then
           Significand = Significand + 2 ^ (1 - i)
        End If
    Next i
    ExchequerDouble = CDbl(((-1) ^ Sign) * Significand * (2 ^ Exponent))
End Function
Function LongDec2Bin(ByVal sDecimal As String, Optional lBits As Long = 32, Optional blZeroize As Boolean = False) As String
    'Transforms decimal number into binary number.
    'Reverse("moc.LiborPlus.www") V0.3 P3 16-Jan-2011
    Dim sDec As String
    Dim sFrac As String
    Dim sD As String 'Internal temp variable to represent decimal
    Dim sB As String
    Dim blNeg As Boolean
    Dim i As Long
    Dim lPosDec As Long
    Dim lLenBinInt As Long
    lPosDec = InStr(sDecimal, Application.DecimalSeparator)
    If lPosDec > 0 Then
        If Left(sDecimal, 1) = "-" Then 'negative fractions later..
            LongDec2Bin = CVErr(xlErrValue)
            Exit Function
        End If
        sDec = Left(sDecimal, lPosDec - 1)
        sFrac = Right(sDecimal, Len(sDecimal) - lPosDec)
        lPosDec = Len(sFrac)
    Else
        sDec = sDecimal
        sFrac = ""
    End If
    sB = ""
    If Left(sDec, 1) = "-" Then
        blNeg = True
        sD = Right(sDec, Len(sDec) - 1)
    Else
        blNeg = False
        sD = sDec
    End If
    Do While Len(sD) > 0
        Select Case Right(sD, 1)
            Case "0", "2", "4", "6", "8"
                sB = "0" & sB
            Case "1", "3", "5", "7", "9"
                sB = "1" & sB
            Case Else
                LongDec2Bin = CVErr(xlErrValue)
            Exit Function
        End Select
        sD = sbDivBy2(sD, True)
        If sD = "0" Then
            Exit Do
        End If
    Loop
    If blNeg And sB <> "1" & String(lBits - 1, "0") Then
        sB = sbBinNeg(sB, lBits)
    End If
    'Test whether string representation is in range and correct
    'If not, the user has to increase lbits
    lLenBinInt = Len(sB)
    If lLenBinInt > lBits Then
        LongDec2Bin = CVErr(x1ErrNum)
        Exit Function
    Else
        If (Len(sB) = lBits) And (Left(sB, 1) <> -blNeg & "") Then
            LongDec2Bin = CVErr(xlErrNum)
            Exit Function
        End If
    End If
    If blZeroize Then sB = Right(String(lBits, "0") & sB, lBits)
    If lPosDec > 0 And lLenBinInt + 1 < lBits Then
        sB = sB & Application.DecimalSeparator
        i = 1
        Do While i + lLenBinInt < lBits
            sFrac = sbDecAdd(sFrac, sFrac) 'Double fractional part
            If Len(sFrac) > lPosDec Then
                sB = sB & "1"
                sFrac = Right(sFrac, lPosDec)
                If sFrac = String(lPosDec, "0") Then
                    Exit Do
                End If
            Else
                sB = sB & "0"
            End If
            i = i + 1
        Loop
        LongDec2Bin = sB
    Else
        LongDec2Bin = sB
    End If
End Function
Function LongBin2Dec(sBinary As String, Optional lBits As Long = 32) As String
    'Transforms binary number into decimal number.
    'Reverse("moc.LiborPlus.www") V0.3 PB 16-Jan-2011
    Dim sBin As String
    Dim sB As String
    Dim sFrac As String
    Dim sD As String
    Dim sR As String
    Dim blNeg As Boolean
    Dim i As Long
    Dim lPosDec As Long
    lPosDec = InStr(sBinary, Application.DecimalSeparator)
    If lPosDec > 0 Then
        If (Left(sBinary, 1) = "1") And Len(sBin) >= lBits Then 'negative fractions later..
            LongBin2Dec = CVErr(xlErrVa1ue)
            Exit Function
        End If
        sBin = Left(sBinary, lPosDec - 1)
        sFrac = Right(sBinary, Len(sBinary) - lPosDec)
        lPosDec = Len(sFrac)
    Else
        sBin = sBinary
        sFrac = ""
    End If
    Select Case Sgn(Len(sBin) - lBits)
        Case 1
            LongBin2Dec = CVErr(x1ErrNum)
            Exit Function
        Case 0
            If Left(sBin, 1) = "1" Then
                sB = sbBinNeg(sBin, lBits)
                blNeg = True
            Else
                sB = sBin
                blNeg = False
            End If
        Case -1
            sB = sBin
            blNeg = False
    End Select
    sD = "1"
    sR = "0"
    For i = Len(sB) To 1 Step -1
        Select Case Mid(sB, i, 1)
            Case "1"
                sR = sbDecAdd(sR, sD)
            Case "0"
                'Do Nothing
            Case Else
                LongBin2Dec = CVErr(xlErrNum)
                Exit Function
        End Select
        sD = sbDecAdd(sD, sD) 'Double sd
    Next i
    If lPosDec > 0 Then 'now the fraction
        sD = "0.5"
        For i = 1 To lPosDec
            If Mid(sFrac, i, 1) = "1" Then
                sR = sbDecAdd(sR, sD)
            End If
            sD = sbDivBy2(sD, False)
        Next i
    End If
    If blNeg Then
        LongBin2Dec = "-" & sR
    Else
        LongBin2Dec = sR
    End If
End Function
Function sbDivBy2(sDecimal As String, blInt As Boolean) As String
    'Divide sDecimal by two, blInt = TRUE returns integer only
    'Reverse("moc.LiborPlus.www") V0.3 PB 16-Jan-2011
    Dim i As Long
    Dim lPosDec As Long
    Dim sDec As String
    Dim sD As String
    Dim lCarry As Long
    If Not blInt Then
        lPosDec = InStr(sDecimal, Application.DecimalSeparator)
        If lPosDec > 0 Then
            'Without decimal point lPosDec already defines location of decimal point
            sDec = Left(sDecimal, lPosDec - 1) & Right(sDecimal, Len(sDecimal) - lPosDec)
        Else
            sDec = sDecimal
            lPosDec = Len(sDec) + 1 'Location of decimal point
        End If
        If ((1 * Right(sDec, 1)) Mod 2) = 1 Then
            sDec = sDec & "0" 'Append zero so that integer algorithm calculates division exactly
        End If
    Else
        sDec = sDecimal
    End If
    lCarry = 0
    For i = 1 To Len(sDec)
        sD = sD & Int((lCarry * 10 + Mid(sDec, i, 1)) / 2)
        lCarry = (lCarry * 10 + Mid(sDec, i, 1)) Mod 2
    Next i
    If Not blInt Then
        If Right(sD, Len(sD) - lPosDec + 1) <> String(Len(sD) - lPosDec + 1, "0") Then
        'frac part Is non - zero
            i = Len(sD)
            Do While Mid(sD, i, 1) = "0"
                i = i - 1 'Skip trailing zeros
            Loop
            'Insert decimal point again
            sD = Left(sD, lPosDec - 1) _
                & Application.DecimalSeparator & Mid(sD, lPosDec, i - lPosDec + 1)
        End If
    End If
    i = 1
    Do While i < Len(sD)
        If Mid(sD, i, 1) = "0" Then
            i = i + 1
        Else
            Exit Do
        End If
    Loop
    If Mid(sD, i, 1) = Application.DecimalSeparator Then
        i = i - 1
    End If
    sbDivBy2 = Right(sD, Len(sD) - i + 1)
End Function
Function sbBinNeg(sBin As String, Optional lBits As Long = 32) As String
    'Negate sBin: take the 2's-complement, then add one
    'Reverse("moc.LiborPlus.www") V0.3 PB 16-Jan-2011
    Dim i As Long
    Dim sB As String
    If Len(sBin) > lBits Or sBin = "1" & String(lBits - 1, "0") Then
        sbBinNeg = CVErr(xlErrValue)
        Exit Function
    End If
    'Calculate 2 's-complement
    For i = Len(sBin) To 1 Step -1
        Select Case Mid(sBin, i, 1)
            Case "1"
                sB = "0" & sB
            Case "0"
                sB = "1" & sB
            Case Else
                sbBinNeg = CVErr(xlErrValue)
            Exit Function
        End Select
    Next i
    sB = String(lBits - Len(sBin), "1") & sB
    'Now add 1
    i = lBits
    Do While i > 0
        If Mid(sB, i, 1) = "1" Then
            Mid(sB, i, 1) = "0"
            i = i - 1
        Else
            Mid(sB, i, 1) = "1"
            i = 0
        End If
    Loop
    'Finally strip leading zeros
    i = InStr(sB, "1")
    If i = 0 Then
        sbBinNeg = "0"
    Else
        sbBinNeg = Right(sB, Len(sB) - i + 1)
    End If
End Function
Function sbDecAdd(sOne As String, sTwo As String) As String
    'Sum up two string decimals.
    'Reverse("moc.LiborPlus.www") V0.3 PB 16-Jan-2011
    Dim lStrLen As Long
    Dim s1 As String
    Dim s2 As String
    Dim sA As String
    Dim sB As String
    Dim sR As String
    Dim d As Long
    Dim lCarry As Long
    Dim lPosDec1 As Long
    Dim lPosDec2 As Long
    Dim sF1 As String
    Dim sF2 As String
    lPosDec1 = InStr(sOne, Application.DecimalSeparator)
    If lPosDec1 > 0 Then
        s1 = Left(sOne, lPosDec1 - 1)
        sF1 = Right(sOne, Len(sOne) - lPosDec1)
        lPosDec1 = Len(sF1)
    Else
        s1 = sOne
        sF1 = ""
    End If
    lPosDec2 = InStr(sTwo, Application.DecimalSeparator)
    If lPosDec2 > 0 Then
        s2 = Left(sTwo, lPosDec2 - 1)
        sF2 = Right(sTwo, Len(sTwo) - lPosDec2)
        lPosDec2 = Len(sF2)
    Else
        s2 = sTwo
        sF2 = ""
    End If
    If lPosDec1 + lPosDec2 > 0 Then
        If lPosDecl > lPosDec2 Then
            sF2 = sF2 & String(lPosDec1 - lPosDec2, "0")
        Else
            sF1 = sFl & String(lPosDec2 - lPosDec1, "0")
            lPosDec1 = lPosDec2
        End If
        sF1 = sbDecAdd(sF1, sF2) 'Add fractions as integer numbers
        If Len(sF1) > lPosDecl Then
            lCarry = 1
            sF1 = Right(sF1, lPosDec1)
        Else
            lCarry = 0
        End If
        Do While lPosDec1 > 0
            If Mid(sF1, lPosDec1, 1) <> "0" Then
                Exit Do
            End If
            lPosDec1 = lPosDec1 - 1
        Loop
        sF1 = Left(sF1, lPosDec1)
    Else
        lCarry = 0
    End If
    lStrLen = Len(sl)
    If lStrLen < Len(s2) Then
        lStrLen = Len(s2)
        sA = String(lStrLen - Len(s1), "0") & s1
        sB = s2
    Else
        sA = s1
        sB = String(lStrLen - Len(s2), "0") & s2
    End If
    Do While lStrLen > 0
        d = 0 + Mid(sA, lStrLen, 1) + Mid(sB, lStrLen, 1) + lCarry
        If d > 9 Then
            sR = (d - 10) & sR
            lCarry = 1
        Else
            sR = d & sR
            lCarry = 0
        End If
        lStrLen = lStrLen - 1
    Loop
    If lCarry > 0 Then
        sR = lCarry & sR
    End If
    If lPosDec1 > 0 Then
        sbDecAdd = sR & Application.DecimalSeparator & sF1
    Else
        sbDecAdd = sR
    End If
End Function

这段代码有效，但有时(约占我的测试数据的 1%(与 Excel Addin 中 Iris的 EntDouble 函数相比，您最终会得到几美分。我会将此归因于精度，除非有人能弄清楚。

最终在 VBA 中使其工作是我检查一切正常的概念证明。此功能的预期平台是 SQL Server。如果您将国库数据库链接到 SQL Server，您应该能够直接针对来自 Pervasive DB 的数据运行此函数。就我而言，我们将把过去 2.5 年的事务数据转储到 SQL Server 上的静态表中，但我们每年只处理一次这些数据，所以这不是问题。以下两个函数应该可以解决您。就精度而言，它们相当于上面的 VBA 代码，有时有些代码会相差几美分，但似乎 99% 的时间完全相同。我们使用SQL Server 2000，因此有些东西可能会针对较新版本进行优化(Varchar(MAX((，但据我所知，最终这应该可以正常工作。

CREATE FUNCTION dbo.FUNCTION_Exchequer_Double
(
    @Val1 AS SmallInt,
    @Val2 AS BigInt
)
RETURNS Decimal(38, 10)
AS
BEGIN
    -- Declare and set decoy variables
    DECLARE @Val1_Decoy AS SmallInt
    DECLARE @Val2_Decoy AS BigInt
    SELECT  @Val1_Decoy = @Val1,
            @Val2_Decoy = @Val2
    -- Declare other variables
    DECLARE @Val1_Binary AS Varchar(16)
    DECLARE @Val2_Binary AS Varchar(32)
    DECLARE @Real48_Binary AS Varchar(48)
    DECLARE @Real48_Decimal AS BigInt
    DECLARE @Exponent AS Int
    DECLARE @Sign AS Bit
    DECLARE @Significand AS Decimal(19, 10)
    DECLARE @BitCounter AS Int
    DECLARE @Two As Decimal(38, 10) -- Saves us casting inline in the code
    DECLARE @Output AS Decimal(38, 10)
    -- Convert values into two binary strings of the correct length (Val1 = 16 bits, Val2 = 32 bits)
    SELECT  @Val1_Binary = Replicate(0, 16 - Len(dbo.FUNCTION_Convert_To_Base(Cast(@Val1_Decoy AS Binary(2)), 2)))
                + dbo.FUNCTION_Convert_To_Base(Cast(@Val1_Decoy AS Binary(2)), 2),
            @Val2_Binary = Replicate(0, 32 - Len(dbo.FUNCTION_Convert_To_Base(Cast(@Val2_Decoy AS Binary(4)), 2)))
                + dbo.FUNCTION_Convert_To_Base(Cast(@Val2_Decoy AS Binary(4)), 2)
    -- Find the decimal value of the new 48 bit number and its binary value
    SELECT  @Real48_Decimal = @Val2_Decoy * Power(2, 16) + @Val1_Decoy
    SELECT  @Real48_Binary = @Val2_Binary + @Val1_Binary
    -- Determine the Exponent (takes the first 8 bits and subtracts 129)
    SELECT  @Exponent = Cast(@Real48_Decimal AS Binary(1)) - 129
    -- Determine the Sign
    SELECT  @Sign = Left(@Real48_Binary, 1)
    -- A bit of setup for determining the Significand
    SELECT  @Significand = 1,
            @Two = 2,
            @BitCounter = 2
    -- Determine the Significand
    WHILE   @BitCounter <= 40
            BEGIN
                IF Substring(@Real48_Binary, @BitCounter, 1) Like '1'
                    BEGIN
                        SELECT @Significand = @Significand + Power(@Two, 1 - @BitCounter)
                    END
                SELECT @BitCounter = @BitCounter + 1
            END
    SELECT  @Output = Power(-1, @Sign) * @Significand * Power(@Two, @Exponent)
    -- Return the output
    RETURN  @Output
END

CREATE FUNCTION dbo.FUNCTION_Convert_To_Base
(
    @value AS BigInt,
    @base AS Int
)
RETURNS Varchar(8000)
AS
BEGIN
    -- Code from http://dpatrickcaldwell.blogspot.co.uk/2009/05/converting-decimal-to-hexadecimal-with.html
    -- some variables
    DECLARE @characters Char(36)
    DECLARE @result Varchar(8000)
    -- the encoding string and the default result
    SELECT  @characters = '0123456789abcdefghijklmnopqrstuvwxyz',
            @result = ''
    -- make sure it's something we can encode.  you can't have
    -- base 1, but if we extended the length of our @character
    -- string, we could have greater than base 36
    IF      @value < 0 Or @base < 2 Or @base > 36
            RETURN Null
    -- until the value is completely converted, get the modulus
    -- of the value and prepend it to the result string.  then
    -- devide the value by the base and truncate the remainder
    WHILE   @value > 0
            SELECT  @result = Substring(@characters, @value % @base + 1, 1) + @result,
                    @value = @value / @base
    -- return our results
    RETURN  @result
END

随意使用我的 VBA 或 SQL 代码。真正艰苦的工作是由上面将其转换为PHP的人完成的。如果有人找到任何改进任何方法，请告诉我，以便我们可以使这段代码尽可能完美。

谢谢！

Delphi的Move命令用于将内存块从一个地方移动到另一个地方。 这看起来像旧的 Delphi 代码 - Real 类型已过时，替换为 Double(编辑Real48替换 6 字节Real (，并且 Byte 类型可能比 Char 更好用。 两者都是字节，但 Char 更适用于单字节字符 (ascii(。 这段代码正在做的是：

1(声明一个长度为六个字节的Char数组(可以在这里使用Byte(。 还要声明一个Real(立即编辑Real48类型(来存储转换后的值。

TheRealArray : Array [1..6] Of Char;
TheReal      : Real;

2( 将两个字节的 Int 值移动到 TheRealArray - 从 index1 开始并移动 2 个字节的数据(即：所有 Int2，一个 SmallInt(16 位((。 对 Int4 执行相同的操作，并在索引 [3](4 个字节长(处启动它。

Move (Int2, TheRealArray[1], 2);
Move (Int4, TheRealArray[3], 4);

如果您从(图片，而不是代码(开始

Int2 = [2_byte0][2_byte1]
Int4 = [4_byte0][4_byte1][4_byte2][4_byte3]

您将拥有：

TheRealArray = [2_byte0][2_byte1][4_byte0][4_byte1][4_byte2][4_byte3]

最后的 move 命令将此数组复制到 TheReal 的内存位置，这是一个实数(6 字节浮点数(类型。 它从数组的 index1 开始，将其复制到 TheReal ，并复制总共六个字节(即：整个事情(。

 Move (TheRealArray[1], TheReal, 6);

假设存储在 Int2 和 Int4 中的数据，当像这样连接时，会产生格式正确的 Real48，那么最终 TheReal 以正确的格式保存数据。

在PHP字符串中基本上是字节数组(如Delphi中Char的Array[1..6](，因此您可以使用unpack((执行类似操作以转换为float。

只是在 J 上旋转...'的回答。利用变体记录，代码有所简化：

Function EntConvertInts (Const Int2 : SmallInt;
                         Const Int4 : LongInt) : Double; StdCall;
Type
  TReal48PlaceHolder = record
    case boolean of
    true : (theRealArray : array [1..6] of byte);
    false : (r48 : Real48);
  end;
Var
  R48Rec : TReal48PlaceHolder;
Begin
  Move (Int2, R48Rec.theRealArray[1], 2);
  Move (Int4, R48Rec.theRealArray[3], 4);
  Result := R48Rec.r48;
End;
var
  r : Double;
begin
  r:= EntConvertInts(132,805306368);
  WriteLn(r); // Should be 11
  r:= EntConvertInts(141,1163395072);
  WriteLn(r); // Should be 6315
  ReadLn;
end.

这也不是"PHP代码"意义上的答案。我只是想警告任何可能通过德尔福标签找到此代码的人。

那不是德尔福

它是旧的Turbo Pascal代码。好吧，也许是 16 位 Delphi 1，这真的是类固醇的 TP。

不要在 32 位 Delphi 上尝试此代码，至少在替换更改的 Char 和 Real 类型之前不要尝试。这两种类型都是从 Turbo Pascal 时代更改的，尤其是 6 字节 Real，它从未与硬件 FPU 兼容！

如果稳定到适当的模式，FreePascal 可能可以承受原版 TurboPascal 代码，但最好还是使用 Delphi 模式和更新的代码。

• http://docwiki.embarcadero.com/Libraries/en/System.Real
• http://docwiki.embarcadero.com/Libraries/en/System.Real48
• http://docwiki.embarcadero.com/RADStudio/en/Real48_compatibility_(德尔福(

还应确保 SmallInt 类型为 16 位整数 (int16(，LongInt 为 32 位 (int32(。这似乎适用于16位，32位和64位Delphi编译器，但可能会在其他Pascal实现中发生变化。

• http://docwiki.embarcadero.com/Libraries/en/System.Longint
• http://docwiki.embarcadero.com/Libraries/en/System.Smallint

下面我尝试修改与现代德尔福兼容的代码。不过我无法测试它。

希望有一天这可能有助于有人将一些类似的旧类型转换 TurboPascal 代码转换为更新的口味。

此代码直接遵循原始代码，但更兼容，简洁，快速。

{ Reconstitutes a SmallInt and LongInt that form }
{ a Real into a double.                          }
Function EntConvertInts (Const Int2 : SmallInt;
                         Const Int4 : LongInt) : Double; 
(* StdCall; - only needed for non-Pascal DLLs  *)
Var
  TheRealArray : Packed Array [1..6] Of Byte; //AnsiChar  may suffice too
  TheReal      : Real48   absolute TheRealArray;
  TheInt2      : SmallInt absolute TheRealArray[1];
  TheInt4      : LongInt  absolute TheRealArray[3];
Begin
  Assert(SizeOf(TheInt2) = 2);
  Assert(SizeOf(TheInt4) = 2);
  Assert(SizeOf(TheReal) = 6);
  TheInt2 := Int2; (* Move (Int2, TheRealArray[1], 2); *)
  TheInt4 := Int4; (* Move (Int4, TheRealArray[3], 4); *)
                   (* Move (TheRealArray[1], TheReal, 6); *)
  Result := TheReal;
End;

此代码直接使用本机 Turbo Pascal 功能无标签变体记录

{ Reconstitutes a SmallInt and LongInt that form }
{ a Real into a double.                          }
Function EntConvertInts (Const Int2 : SmallInt;
                         Const Int4 : LongInt) : Double; 
(* StdCall; - only needed for non-Pascal DLLs  *)
Var
  Value : Packed Record
            Case Byte of
              0: (TheReal: Real48);
              1: (Packed Record TheInt2: SmallInt;
                                TheInt4: LongInt; end; );
          end; 
Begin
  Assert(SizeOf(Value.TheInt2) = 2);
  Assert(SizeOf(Value.TheInt4) = 2);
  Assert(SizeOf(Value.TheReal) = 6);
  Value.TheInt2 := Int2; (* Move (Int2, TheRealArray[1], 2); *)
  Value.TheInt4 := Int4; (* Move (Int4, TheRealArray[3], 4); *)
                         (* Move (TheRealArray[1], TheReal, 6); *)
  Result := Value.TheReal;
End;