Apache OpenOffice Community Forum

Code: Select all

REM The "Calc" representation of a number here means the default.
REM This is IEEE 754 Double in RAM, but always shown in a specific format
REM in spreadsheets, and stored to files in a rounded decimal format.
REM The "DblHEX" representation means "like in RAM", everyone of the 8 bytes
REM converted to two hexadecadic digits. Everything "more significant first".

Function calcToDblHex(pNum As Double) As String
calcToDblHex      = ":fail:"
On Local Error Goto fail
amount            = Abs(pNum)
sign              = Sgn(pNum)
rawDyadicExponent = Int(Log(amount) / Log(2))
rawFloatCut       = (amount*2^-rawDyadicExponent - 1)
currMantissa      = rawFloatCut*(&H1000000)*(&H10000000)'+2^52
offsetDyaExponent = Int(rawDyadicExponent + 1023)
lead12            = IIf(sign<0, &H800, 0) + offsetDyaExponent
startH            = Right(Hex(&H1000 + lead12), 3)
out               = ""
For j = 0 To 5
 quot              = Int(currMantissa/&H100)
 remi              = currMantissa - (quot*&H100)
 currMantissa      = quot
 out               = Right(Hex(&H100 + remi), 2) & out
Next j
quot              = currMantissa\&H10
remi              = currMantissa - (quot*&H10)
currMantissa      = quot
out               = startH & Right(Hex(&H10 + remi), 1) & out
calcToDblHex      = out
fail:
End Function

Function dblHexToCalc(pDblHex As String) As Variant
dblHexToCalc      = ":fail:"
If Len(pDblHex)<>16 Then Exit Function
On Local Error Goto fail
Dim bytes(7) As Byte
For j = 0 To 7
 bytes(j)          = Val("&H" & Mid(pDblHex, j*2+1, 2))
Next j
signBit           = (bytes(0)>127)
eLeft             = bytes(0) AND &H7F
eRight            = (bytes(1) AND &HF0) \ 16
dyaExponent              = (eLeft*16 + eRight) - 1023
bytes(1)          = (bytes(1) AND &H0F) OR &H10 REM !!!!
Dim mantissa As Double
manStart          = CDbl(bytes(1)) / 16
mantissa          = CDbl(0)
For k = 7 To 2 Step -1
 mantissa          = mantissa/256 + CDbl(bytes(k))
Next k
mantissa          = (mantissa/(256*16) + manStart)
res               = mantissa * (2^dyaExponent) * IIf(signBit, -1, 1) 
dblHexToCalc      = res
fail:
End Function

Code: Select all

x = 4908163662587.91
h = x.hex().upper()
print( f"{x = } convert to hex: {h = } , {float.fromhex(h) == x = }")

### x = 4908163662587.91 convert to hex: h = '0X1.1DB15680BEFA4P+42' , float.fromhex(h) == x = True

Code: Select all

x                          hex_by_Lupp         hex_by_python_float.hex().upper()
4908163662587,91	   4291DB15680BEFA4    0X1.1DB15680BEFA4P+42

Code: Select all

REM  *****  BASIC  *****

Option Explicit


Function myPipeDouble2HexStr(myValue as double) as string
 Dim oPipe as object       
 Dim i As Integer
 Dim sResult as string

 	oPipe = myCreatePipe()
	oPipe.Predecessor.writeDouble(myValue)	REM: '.writeFloat' for the Single precision numbers
  	Do While oPipe.Successor.available() > 0
    	i = oPipe.Successor.readByte()
    	i = i AND 255    	
    	If i < 16 Then sResult = sResult & "0"
    	sResult = sResult & Hex(i)
  	Loop
  	myClosePipe(oPipe)
  	  	
myPipeDouble2HexStr = sResult
End function    
'_____________________________________________________________________________________________


Function myPipeHexStr2Double(sHexStr as string) as double
 Dim oPipe        
 Dim myValue As double 
 Dim i as integer
 Dim aBytes(8) as integer
 Dim sTwoChars as string
 	
	If myCheckHexStr(sHexStr) <> 16 then REM: '<> 8 then' for the Single precision numbers
		myPipeHexStr2Double = 0
		MsgBox("Error in the Hexa string",0, "myPipeHexStr2Double:")
		Exit Function
	end if 
  	For i = 0 To 7 
  		sTwoChars = left(sHexStr, 2)
  		aBytes(i) = myHEX2DEC(sTwoChars)
  		sHexStr = right(sHexStr, len(sHexStr) - 2) 		
  	next i  	
	oPipe = myCreatePipe()
	oPipe.Predecessor.writeBytes(aBytes())
	myValue = oPipe.Successor.readDouble() REM: '.readFloat' for the Single precision numbers
	myClosePipe(oPipe)
  	
myPipeHexStr2Double = myValue
end function
'_____________________________________________________________________________________________
'_____________________________________________________________________________________________


Function myCreatePipe() As Object
 Dim oPipe    ' Pipe Service.
 Dim oDataInp ' DataInputStream Service.
 Dim oDataOut ' DataOutputStream Service.
	oPipe    = createUNOService ("com.sun.star.io.Pipe")
	oDataInp = createUNOService ("com.sun.star.io.DataInputStream")
	oDataOut = createUNOService ("com.sun.star.io.DataOutputStream")
	oDataInp.setInputStream(oPipe)
	oDataOut.setOutputStream(oPipe)
	
myCreatePipe = oPipe
End Function
'_____________________________________________________________________________________________


Sub myClosePipe(oPipe)
	oPipe.Successor.closeInput
	oPipe.Predecessor.closeOutput
	oPipe.closeInput
	oPipe.closeOutput
End Sub
'_____________________________________________________________________________________________


function myHex2Dec(sHexa as string) as integer
 Dim oFunctionAccess as object
 Dim Arg
 
	oFunctionAccess = createUnoService( "com.sun.star.sheet.FunctionAccess" )     
	Arg = Array(sHexa)
	
myHex2Dec = oFunctionAccess.CallFunction( "HEX2DEC", Arg)
end function
'_____________________________________________________________________________________________


function myCheckHexStr(sHexStr as string) as integer
 Dim i as integer
 Dim iLen as integer
 
 	iLen = len(sHexStr)
 	For i = 1 to iLen
 		if instr("0123456789aAbBcCdDeEfF", mid(sHexStr,i,1)) = 0 then
 			myCheckHexStr = -1	
 			Exit function
 		end if
 	next i
myCheckHexStr = iLen
end function
'_____________________________________________________________________________________________