Convert VB Double to Pascal Real

[One Handed Man]

Try This !

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]

Re: Try This !

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" <Bombay@Duck.ne t> wrote in message
news:bq00pu$qt1 $1@titan.btinte rnet.com...[color=blue]
> 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[/color]
will[color=blue]
> need to amend it a bit for VB.NET, but hopefully it gives you a template[/color]
to[color=blue]
> 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
>
>[/color]

[David Scemama]

Re: Convert VB Double to Pascal Real

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

David

"David Scemama" <david.scemama@ nospam.wanadoo. fr> wrote in message
news:eFNXol2sDH A.2492@TK2MSFTN GP12.phx.gbl...[color=blue]
> The Pascal Real type, is stored on 6 bytes with a very special coding.[/color]
When[color=blue]
> you write a real value in a file, 6 bytes are written to represent the[/color]
value[color=blue]
> (obviously, no language writes the string representation of the real !).[/color]
My[color=blue]
> function reads the 6 bytes and convert them to a VB double.
>
> I need the reverse function !
>
> David
>
>
> "One Handed Man" <Bombay@Duck.ne t> wrote in message
> news:bpvjji$t6n $1@titan.btinte rnet.com...[color=green]
> > I probably have not understood you correctly, but can you not simply[/color]
> convert[color=green]
> > the double to a string an then truncate the string to the correct[/color][/color]
length?[color=blue][color=green]
> >
> > 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[/color]
> around.[color=green]
> > 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:[color=darkred]
> > > 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[/color]
> >
> >[/color]
>
>[/color]