Convert VB Double to Pascal Real

[David Scemama]

Hi,

I'm writing a program using VB.NET that needs to communicate with a DOS
Pascal program than cannot be modified. The communication channel is through
some file databases, and I have a huge problem writing VB Double values to
the file so as the Pascal program can read them as Pascal Real values.

I've managed to find the algorithm to read the Pascal Real format and
convert it to a VB Double, but I cannot figure out the opposite algorithm.

Can someone help me reverse my algorithm and develop the function
"DoubleToRe al (ByVal Data As Double) As String"

Here is the conversion from real to double:

Public Function RealToDouble(By Val Data As String) As Double
Dim dMantissa As Double
Dim i As Integer
Dim j As Long
Dim k As Long

If Len(Data) <> 6 Then
'Err.Raise
'exception
Exit Function
End If

'accumulate the mantissa
dMantissa = 1
For i = 6 To 2 Step -1
For j = CType(IIf(i = 6, 6, 7), Long) To 0 Step -1
k = k + 1
If (Asc(Mid$(Data, i, 1)) And CType(2 ^ j, Long)) <> 0 Then
dMantissa = dMantissa + 2 ^ -k
End If
Next j
Next i

'finally, assemble all the pieces into a number
If (Asc(Mid$(Data, 6, 1)) And &H80) = &H80 Then
RealToDouble = -dMantissa * 2 ^ (Asc(Mid$(Data, 1, 1)) - 129)
Else
RealToDouble = dMantissa * 2 ^ (Asc(Mid$(Data, 1, 1)) - 129)
End If

Try
Return ([Decimal].Round(CDec(Rea lToDouble), 2))
Catch ex As Exception
'MsgBox("RealTo Double, Conversion error: " & Data & "; " &
RealToDouble.To String, MsgBoxStyle.Cri tical)
Return 0
End Try

End Function

Thanks for your help
David

[One Handed Man]

I dont know the answer to this. I suggest you post the following this
specific question at top level in the group:
Regards - OHM

Cor wrote:

But should it do that?

[Cor]

Hi David,

I think this is a much to dificult approach for a newsgroup.
Maybe if guys like Fergus Cooney where here now, he could help you because
he likes this.

But he is not and I don't know if he will return soon.

Every byte in a file is representent by a hex value.

Can you not represent the bytes in hex form representing a normal decimal
value, maybe somebody can help you than.

Probably not me, because mostly this is not my stuff, but you never know.

Cor

[Cor]

Hi OHM,

Putted it in the vb.language.con trols group.

Almost the private group from Herfied, I am curious what happens.

:-))

Cor

[David Scemama]

The exact representation of the Pascal Real type is:
Sign Significand Exponent
Width (bits) 1 39 8

David

"David Scemama" <da***********@ nospam.wanadoo. fr> wrote in message
news:eF******** ******@TK2MSFTN GP12.phx.gbl...

The Pascal Real type, is stored on 6 bytes with a very special coding. When you write a real value in a file, 6 bytes are written to represent the value (obviously, no language writes the string representation of the real !). My function reads the 6 bytes and convert them to a VB double.

I need the reverse function !

David
"One Handed Man" <Bo****@Duck.ne t> wrote in message
news:bp******** **@titan.btinte rnet.com...

I probably have not understood you correctly, but can you not simply

convert

the double to a string an then truncate the string to the correct length?
As far as I am aware, a real number is simply a number which is not
imaginary, so I dont know how this differs in a Pascal Real number. Your
function seems to convert a string into a double but goes a long way

around.

BTW, I actually tried to convert "1.2345" and it returned 0.0

I'm sure Im missing something here, can you illuminate ?

Regards - OHM

David Scemama wrote:

Hi,

I'm writing a program using VB.NET that needs to communicate with a
DOS Pascal program than cannot be modified. The communication channel
is through some file databases, and I have a huge problem writing VB
Double values to the file so as the Pascal program can read them as
Pascal Real values.

I've managed to find the algorithm to read the Pascal Real format and
convert it to a VB Double, but I cannot figure out the opposite
algorithm.

Can someone help me reverse my algorithm and develop the function
"DoubleToRe al (ByVal Data As Double) As String"

Here is the conversion from real to double:

Public Function RealToDouble(By Val Data As String) As Double
Dim dMantissa As Double
Dim i As Integer
Dim j As Long
Dim k As Long

If Len(Data) <> 6 Then
'Err.Raise
'exception
Exit Function
End If

'accumulate the mantissa
dMantissa = 1
For i = 6 To 2 Step -1
For j = CType(IIf(i = 6, 6, 7), Long) To 0 Step -1
k = k + 1
If (Asc(Mid$(Data, i, 1)) And CType(2 ^ j, Long)) <>
0 Then dMantissa = dMantissa + 2 ^ -k
End If
Next j
Next i

'finally, assemble all the pieces into a number
If (Asc(Mid$(Data, 6, 1)) And &H80) = &H80 Then
RealToDouble = -dMantissa * 2 ^ (Asc(Mid$(Data, 1, 1)) -
129) Else
RealToDouble = dMantissa * 2 ^ (Asc(Mid$(Data, 1, 1)) -
129) End If

Try
Return ([Decimal].Round(CDec(Rea lToDouble), 2))
Catch ex As Exception
'MsgBox("RealTo Double, Conversion error: " & Data & "; " &
RealToDouble.To String, MsgBoxStyle.Cri tical)
Return 0
End Try

End Function

Thanks for your help
David

[One Handed Man]

You'll probably get the reply in German !.

Regards - OHM

Cor wrote:

Hi OHM,

Putted it in the vb.language.con trols group.

Almost the private group from Herfied, I am curious what happens.

:-))

Cor

[One Handed Man]

Hay David,

This is clearly a complex conversion. I found this on the internet. It is
Quick Basic rendering of a solution to your problem ( Hopefully ). You will
need to amend it a bit for VB.NET, but hopefully it gives you a template to
work with.

HTH - OHM
DECLARE FUNCTION power# (x!, y AS INTEGER)
DECLARE SUB RealConv (RealCost AS ANY, NewCost#)
' the QBASIC equivalent of the above Pascal struct:
TYPE PASdataRecord
EmpNameLength AS STRING * 1
EmpName AS STRING * 30
Number AS INTEGER
Wage AS STRING * 6
END TYPE
' set up the file to be opened and read from QBASIC
DIM EmployeeDAT AS PASdataRecord
OPEN "EMPLOY.DAT " FOR RANDOM ACCESS READ LOCK WRITE AS #1 LEN =
LEN(EmployeeDAT )
' read the file a record at a time until the end
DO WHILE NOT EOF(1)
CLS
Count = Count + 1
SEEK #1, Count
GET #1, , EmployeeDAT
' strip out the actual string using the first length byte
EmployeeDAT.Emp Name = MID$(EmployeeDA T.EmpName, 1,
ASC(EmployeeDAT .EmpNameLength) )
' the following routine converts the pascal real to Qbasic double
CALL RealConv(Employ eeDAT.Wage, BASwage#)
PRINT "Employee number = "; EmployeeDAT.Num ber
PRINT "Employee EmpName = "; EmployeeDAT.Emp Name
PRINT "Employee wage = "; BASwage
LOOP
FUNCTION power# (x, y AS INTEGER)
' simple x to the power of y function
power# = EXP(y * LOG(x))
END FUNCTION

SUB RealConv (Real$, NewCost#)
' create an array to hold each byte of the real string
DIM RealHold(6)
RealHold(1) = ASC(MID$(Real$, 1, 1))
RealHold(2) = ASC(MID$(Real$, 2, 1))
RealHold(3) = ASC(MID$(Real$, 3, 1))
RealHold(4) = ASC(MID$(Real$, 4, 1))
RealHold(5) = ASC(MID$(Real$, 5, 1))
RealHold(6) = ASC(MID$(Real$, 6, 1))
' if positive contains a number then its negative
positive = &H80 AND RealHold(6)
' clear the Pos/Neg bit from byte 6
RealHold(6) = &H80 OR RealHold(6)
' set up the significand as 1.0
Significand# = 1#
' check each individual bit for on/off; if on then multiply out the
' number (2,4,8,16,32,64 ,128, etc.)
FOR bytecheck = 2 TO 6
' bit 0 of byte
IF (RealHold(bytec heck) AND &H1) = 1 THEN
Significand# = Significand# + power(2, (0 + (bytecheck - 2) * 8))
END IF
' bit 1 of byte
IF (RealHold(bytec heck) AND &H2) = 2 THEN
Significand# = Significand# + power(2, (1 + (bytecheck - 2) * 8))
END IF
' bit 2 of byte
IF (RealHold(bytec heck) AND &H4) = 4 THEN
Significand# = Significand# + power(2, (2 + (bytecheck - 2) * 8))
END IF
' bit 3 of byte
IF (RealHold(bytec heck) AND &H8) = 8 THEN
Significand# = Significand# + power(2, (3 + (bytecheck - 2) * 8))
END IF
' bit 4 of byte
IF (RealHold(bytec heck) AND &H10) = 16 THEN
Significand# = Significand# + power(2, (4 + (bytecheck - 2) * 8))
END IF
' bit 5 of byte
IF (RealHold(bytec heck) AND &H20) = 32 THEN
Significand# = Significand# + power(2, (5 + (bytecheck - 2) * 8))
END IF
' bit 6 of byte
IF (RealHold(bytec heck) AND &H40) = 64 THEN
Significand# = Significand# + power(2, (6 + (bytecheck - 2) * 8))
END IF
' bit 7 of byte
IF (RealHold(bytec heck) AND &H80) = 128 THEN
Significand# = Significand# + power(2, (7 + (bytecheck - 2) * 8))
END IF
NEXT
' normalize the number by dividing calculated number by a number with all
' bits turned on: 2 to the power of 40
Significand# = Significand# / power(2, 40)
' calculate in the exponent
Number# = Significand# * power(2, (RealHold(1) - 128))
' set the pos/neg sign
IF positive > 0 THEN Number# = Number# * -1
NewCost# = Number#
END

[David Scemama]

Unfortunately, this is the exact contrary of what I would like to do. This
function converts the Pascal Real contained in a string to a double.

Thanks
David

"One Handed Man" <Bo****@Duck.ne t> wrote in message
news:bq******** **@titan.btinte rnet.com...

Hay David,

This is clearly a complex conversion. I found this on the internet. It is
Quick Basic rendering of a solution to your problem ( Hopefully ). You will need to amend it a bit for VB.NET, but hopefully it gives you a template to work with.

HTH - OHM
DECLARE FUNCTION power# (x!, y AS INTEGER)
DECLARE SUB RealConv (RealCost AS ANY, NewCost#)
' the QBASIC equivalent of the above Pascal struct:
TYPE PASdataRecord
EmpNameLength AS STRING * 1
EmpName AS STRING * 30
Number AS INTEGER
Wage AS STRING * 6
END TYPE
' set up the file to be opened and read from QBASIC
DIM EmployeeDAT AS PASdataRecord
OPEN "EMPLOY.DAT " FOR RANDOM ACCESS READ LOCK WRITE AS #1 LEN =
LEN(EmployeeDAT )
' read the file a record at a time until the end
DO WHILE NOT EOF(1)
CLS
Count = Count + 1
SEEK #1, Count
GET #1, , EmployeeDAT
' strip out the actual string using the first length byte
EmployeeDAT.Emp Name = MID$(EmployeeDA T.EmpName, 1,
ASC(EmployeeDAT .EmpNameLength) )
' the following routine converts the pascal real to Qbasic double
CALL RealConv(Employ eeDAT.Wage, BASwage#)
PRINT "Employee number = "; EmployeeDAT.Num ber
PRINT "Employee EmpName = "; EmployeeDAT.Emp Name
PRINT "Employee wage = "; BASwage
LOOP
FUNCTION power# (x, y AS INTEGER)
' simple x to the power of y function
power# = EXP(y * LOG(x))
END FUNCTION

SUB RealConv (Real$, NewCost#)
' create an array to hold each byte of the real string
DIM RealHold(6)
RealHold(1) = ASC(MID$(Real$, 1, 1))
RealHold(2) = ASC(MID$(Real$, 2, 1))
RealHold(3) = ASC(MID$(Real$, 3, 1))
RealHold(4) = ASC(MID$(Real$, 4, 1))
RealHold(5) = ASC(MID$(Real$, 5, 1))
RealHold(6) = ASC(MID$(Real$, 6, 1))
' if positive contains a number then its negative
positive = &H80 AND RealHold(6)
' clear the Pos/Neg bit from byte 6
RealHold(6) = &H80 OR RealHold(6)
' set up the significand as 1.0
Significand# = 1#
' check each individual bit for on/off; if on then multiply out the
' number (2,4,8,16,32,64 ,128, etc.)
FOR bytecheck = 2 TO 6
' bit 0 of byte
IF (RealHold(bytec heck) AND &H1) = 1 THEN
Significand# = Significand# + power(2, (0 + (bytecheck - 2) * 8))
END IF
' bit 1 of byte
IF (RealHold(bytec heck) AND &H2) = 2 THEN
Significand# = Significand# + power(2, (1 + (bytecheck - 2) * 8))
END IF
' bit 2 of byte
IF (RealHold(bytec heck) AND &H4) = 4 THEN
Significand# = Significand# + power(2, (2 + (bytecheck - 2) * 8))
END IF
' bit 3 of byte
IF (RealHold(bytec heck) AND &H8) = 8 THEN
Significand# = Significand# + power(2, (3 + (bytecheck - 2) * 8))
END IF
' bit 4 of byte
IF (RealHold(bytec heck) AND &H10) = 16 THEN
Significand# = Significand# + power(2, (4 + (bytecheck - 2) * 8))
END IF
' bit 5 of byte
IF (RealHold(bytec heck) AND &H20) = 32 THEN
Significand# = Significand# + power(2, (5 + (bytecheck - 2) * 8))
END IF
' bit 6 of byte
IF (RealHold(bytec heck) AND &H40) = 64 THEN
Significand# = Significand# + power(2, (6 + (bytecheck - 2) * 8))
END IF
' bit 7 of byte
IF (RealHold(bytec heck) AND &H80) = 128 THEN
Significand# = Significand# + power(2, (7 + (bytecheck - 2) * 8))
END IF
NEXT
' normalize the number by dividing calculated number by a number with all
' bits turned on: 2 to the power of 40
Significand# = Significand# / power(2, 40)
' calculate in the exponent
Number# = Significand# * power(2, (RealHold(1) - 128))
' set the pos/neg sign
IF positive > 0 THEN Number# = Number# * -1
NewCost# = Number#
END

[David Scemama]

The exact representation of the Pascal Real type is:
Sign Significand Exponent
Width (bits) 1 39 8

David

"David Scemama" <da***********@ nospam.wanadoo. fr> wrote in message
news:eF******** ******@TK2MSFTN GP12.phx.gbl...

The Pascal Real type, is stored on 6 bytes with a very special coding. When you write a real value in a file, 6 bytes are written to represent the value (obviously, no language writes the string representation of the real !). My function reads the 6 bytes and convert them to a VB double.

I need the reverse function !

David
"One Handed Man" <Bo****@Duck.ne t> wrote in message
news:bp******** **@titan.btinte rnet.com...

I probably have not understood you correctly, but can you not simply

convert

the double to a string an then truncate the string to the correct length?
As far as I am aware, a real number is simply a number which is not
imaginary, so I dont know how this differs in a Pascal Real number. Your
function seems to convert a string into a double but goes a long way

around.

BTW, I actually tried to convert "1.2345" and it returned 0.0

I'm sure Im missing something here, can you illuminate ?

Regards - OHM

David Scemama wrote:

Hi,

I'm writing a program using VB.NET that needs to communicate with a
DOS Pascal program than cannot be modified. The communication channel
is through some file databases, and I have a huge problem writing VB
Double values to the file so as the Pascal program can read them as
Pascal Real values.

I've managed to find the algorithm to read the Pascal Real format and
convert it to a VB Double, but I cannot figure out the opposite
algorithm.

Can someone help me reverse my algorithm and develop the function
"DoubleToRe al (ByVal Data As Double) As String"

Here is the conversion from real to double:

Public Function RealToDouble(By Val Data As String) As Double
Dim dMantissa As Double
Dim i As Integer
Dim j As Long
Dim k As Long

If Len(Data) <> 6 Then
'Err.Raise
'exception
Exit Function
End If

'accumulate the mantissa
dMantissa = 1
For i = 6 To 2 Step -1
For j = CType(IIf(i = 6, 6, 7), Long) To 0 Step -1
k = k + 1
If (Asc(Mid$(Data, i, 1)) And CType(2 ^ j, Long)) <>
0 Then dMantissa = dMantissa + 2 ^ -k
End If
Next j
Next i

'finally, assemble all the pieces into a number
If (Asc(Mid$(Data, 6, 1)) And &H80) = &H80 Then
RealToDouble = -dMantissa * 2 ^ (Asc(Mid$(Data, 1, 1)) -
129) Else
RealToDouble = dMantissa * 2 ^ (Asc(Mid$(Data, 1, 1)) -
129) End If

Try
Return ([Decimal].Round(CDec(Rea lToDouble), 2))
Catch ex As Exception
'MsgBox("RealTo Double, Conversion error: " & Data & "; " &
RealToDouble.To String, MsgBoxStyle.Cri tical)
Return 0
End Try

End Function

Thanks for your help
David