AW: Hallo Planlos
20.05.2023 12:02:31
Pappawinni
Es geht auch ohne benutzerdefinierte Datentypen.
Wenn da quasi eine Double erzeugt wird, dann versteh ich nicht ganz, warum dd.d nicht als double ausgewiesen wird.
Würde das der internen Darstellung von date entsprechen, müsste man dd.d nicht auch noch zurechtbiegen, bevor man es als Date verwenden kann, oder?
Ich hab jetzt mal die eine Richtung zu Fuß, also ohne diesen Kunstgriff gemacht.
ist halt im Grunde relativ rechenaufwändig und insofern für umfangreichere Verwendung weniger ideal.
Mal so als Anschauungsbeispiel, wie im Grunde eine Double intern aufgebaut ist...
Hab das nicht ausführlich getestet und die Umkehrung spar ich mir mal.
Sub test()
Dim strHex As String
Dim strDblHex As String
Dim dtD As Date
Dim dblDate As Double
Dim i As Long
Dim B() As String
strHex = "ab,aa,aa,aa,ea,00,e6,40"
B = Split(strHex, ",")
If UBound(B) = 7 Then
For i = 0 To 7
strDblHex = strDblHex & B(7 - i)
Next
dblDate = HexToDouble(strDblHex)
dtD = CDate(dblDate)
Debug.Print dtD
End If
End Sub
Function HexToDouble(hexValue As String) As Double
' refers to IEEE 754
'
' Separate sign, exponent, mantissa and Calculate exponent and fraction values
Dim intSign As Integer
Dim lngExp As Long
Dim lngHexSignVal As Long
Dim dblMantissa As Double
Dim strMantissaHex As String
Dim i As Long, j As Long, k As Long, m As Long
intSign = (CLng("&H0" & Left(hexValue, 1)) And 8) / 8
lngExp = (CLng("&H" & Left(hexValue, 2)) And 127) * 16 + CLng("&H" & Mid(hexValue, 3, 1))
lngExp = lngExp - 1023 'Subtract BIAS
strMantissaHex = Mid(hexValue, 4, 13)
dblMantissa = 1
For i = 1 To Len(strMantissaHex)
lngHexSignVal = CLng("&H" & Mid(strMantissaHex, i, 1))
For j = 0 To 3
k = (i - 1) * 4 + j + 1
m = 3 - j
dblMantissa = dblMantissa + ((lngHexSignVal And 2 ^ m) / (2 ^ m)) * (2 ^ -k)
Next
Next
' Calculate double value
Dim result As Double
result = (-1) ^ intSign * dblMantissa * 2 ^ lngExp
HexToDouble = result
End Function