Here are a few conversion functions. Some of which have already been convered in threads, but I thought I would put them in an FAQ for easier reference.
1- Hex->Decimal
Convert Hexadecimal values to Decimal
2- Decimal->Hex
Convert Decimal values to Hexadecimal
3- So. What if we need bigger? Different base?
4- Dec2BasX
Convert Decimal values to any base from binary to hex (2-16)
5- Binary->Decimal
Convert 1's and 0's to whole number
6- Binary->Hex
Convert 1's and 0's to hex number
7- Another Hex->Decimal
For grins, here's a manual hex->dec conversion function
8- Float->Binary->BCD
Take a float (e.g. 123.45) and convert it to binary string which can then be converted to hex bcd using bin2hex.
9- .Decimal->Binary
Convert floating point fraction to binary string
10- Binary->Hexadecimal
Convert binary string to bcd hex in groups of 4
11- BCD->Hexidecimal->Binary
Convert hex bcd number to binary representation of bcd number
12- Binary->Float
Converts binary to floating point decimal number, whole portion and fraction.
13- Binary->Decimal
Convert binary string to whole number
14- Binary->.Decimal
Convert binary string to decimal fraction
15- Tie 'em together
Let's do some converting now
16- Complete procedure file CVT.PRG
This is a complete listing of the functions with no tutorials, so it should compile error free if you cut and paste to a procedure file.
17- Form code to demo conversions
This is a demo form. Input a number and hit Enter or click the 'Convert' button. It will do the converting, then convert it back for comparison. Not that you need the aforementioned procedure file laying around so the program can grab it.
First, let's look at the built in ones.
1- Hex->Decimal
Natively, VFP can do hex to decimal conversion like this:
Code:
?0xffff
-or-
STORE 0xffff TO nVar
And so on. The result is an integer value, 65535.
2- Decimal->Hex
VFP can also convert decimal to hex:
Code:
?Transform(65535, '@0x')
-or-
STORE Transform(65535, '@0x') TO cHexStr
Notice that the return value is character, but you get a hex representation of 65535 as 0x0000FFFF.
Note: The largest hex value that can be returned by this method is 4294967295, or 0xFFFFFFFF
3- So. What if we need bigger? Different base?
Following are a couple functions I wrote for previous apps. One function that will take a whole number in the range of 0-9007199254740992 and convert it to any base, as long as it is base 2 to 16. That includes binary, octal, or any useless base in between.
The biggest number it can handle is 9007199254740992, as VFP docs point out, that is the biggest number VFP can handle.
4- Dec2BasX
Code:
*..............................................................................
* Function: DEC2BASX
* Purpose: Convert whole number 0-?, to base 2-16
*
* Parameters: nTempNum - number to convert (0-9007199254740992)
* base - base to convert to i.e., 2 4 8 16...
* returns: string
* Usage: cresult=Dec2BasX(nParm1, nParm2)
* STORE Dec2BasX(255, 16) TO cMyString &&... cMyString contains 'ff'
*..............................................................................
FUNCTION dec2basx
PARAMETERS nTempNum, nNewBase
STORE 0 TO nWorkVal,;
remainder,;
dividend,;
nextnum,;
digit
nWorkVal = nTempNum
ret_str = '
DO WHILE .T.
digit = MOD(nWorkVal, nNewBase)
dividend = nWorkVal / nNewBase
nWorkVal = INT(dividend)
DO CASE
CASE digit = 10
ret_str = 'a' + ret_str
CASE digit = 11
ret_str = 'b' + ret_str
CASE digit = 12
ret_str = 'c' + ret_str
CASE digit = 13
ret_str = 'd' + ret_str
CASE digit = 14
ret_str = 'e' + ret_str
CASE digit = 15
ret_str = 'f' + ret_str
OTHERWISE
ret_str = LTRIM(STR(digit)) + ret_str
ENDCASE
IF nWorkVal = 0
EXIT
ENDIF ( nWorkVal = 0 )
ENDDO ( .T. )
RETURN ret_str
*: eof dec2basx
5- Binary->Decimal
Now, we want to convert binary to decimal. This function will take a binary string between '0' and
'11111111111111111111111111111111111111111111111111111'
(53 1's, or 9007199254740991) and convert it to decimal.
Code:
*..................................................................
* Function: bin2dec
* Purpose: convert binary string to decimal number
* Parameters: pbinnum - string to convert i.e.,
* '0' - '11111111111111111111111111111111111111111111111111111'
* '0' - (53 1's)
* returns: integer data type
* Usage: nresult = Bin2Dec(cParm1)
* STORE Bin2Dec('11111111') TO nMyNum &&... nMyNum contains 255
*..................................................................
FUNCTION bin2dec
PARAMETERS pbinnum
PRIVATE retval, bindex
STORE 0 TO retval
pbinnum = Alltrim(pbinnum)
STORE Len(pbinnum) TO nDigits
FOR bindex = 0 TO nDigits
IF SUBSTR(pbinnum, nDigits - bindex, 1) = '1'
retval = retval + 2^bindex
ENDIF
NEXT
RETURN Int(retval)
*: eof bin2dec
6- Binary->Hex
Now, let's convert binary to hex. We'll just use the two above funtions and combine them.
Code:
?Dec2BasX(Bin2Dec('11111111'), 16) &&... returns 'ff'
-or-
STORE Dec2BasX(Bin2Dec('1111111111111111'), 16) TO cHexNum &&... cHexNum contains 'ffff'
We can also combine that with the VFP functions:
Code:
?Transform(Bin2Dec('1111111111111111'), '@0x')
-or-
STORE Transform(Bin2Dec('1111111111111111'), '@0x') TO cHexNum
Now, cHexNum contains '0x0000FFFF'
7- For grins, here's a manual hex->dec conversion function
I wrote this function because I needed one for FoxPro 2.x. Before it was included in the built-in functions of FoxPro.
Code:
*..............................................................................
* Function: convert HEX STRING to decimal number
* i.e., '0001' returns 1 and
* 'ffff' returns 65535
* Parameters: hexnum - a string valued '0000' to 'ffff'
* decnum - initialized to 0 returns the value of the conversion
* Usage: nresult=hex2dec(cHexNum)
* STORE hex2dec('FFFF') TO nMyNum &&... nMyNum contains 65535
*..............................................................................
FUNCTION hex2dec
PARAMETERS hexnum
STORE 0 TO decnum
STORE ' TO tempnum
IF LEN(ALLTRIM(hexnum)) < 4
hexnum = PADL(hexnum, 4, '0')
ENDIF ( LEN(ALLTRIM(hexnum)) < 4 )
STORE LEN(hexnum)-1 TO indx
FOR i = 1 TO LEN(hexnum)
DO CASE
CASE SUBSTR(UPPER(hexnum), i, 1) == "F"
tempnum = '15'
CASE SUBSTR(UPPER(hexnum), i, 1) == "E"
tempnum = '14'
CASE SUBSTR(UPPER(hexnum), i, 1) == "D"
tempnum = '13'
CASE SUBSTR(UPPER(hexnum), i, 1) == "C"
tempnum = '12'
CASE SUBSTR(UPPER(hexnum), i, 1) == "B"
tempnum = '11'
CASE SUBSTR(UPPER(hexnum), i, 1) == "A"
tempnum = '10'
OTHERWISE
tempnum = SUBSTR(hexnum, i, 1)
ENDCASE
decnum = decnum + (VAL(tempnum) * (16^indx))
indx = indx - 1
ENDFOR ( i )
RETURN decnum
*: EOF hex2dec
8- Float->Binary
So before we can convert a number to bcd, we need to get it into binary format. For a better explanation than I can provide, go here:
http://capsicum.me.utexas.edu/ChE210/docs/IEEE_Floating_Point.pdf
-or here:-
http://www.trotek.ec-lyon.fr/~muller/cours/numeration/flp_ieee.html.en
But basically, the number needs to be converted from a 'regular' number to scientific notation, (123.45 == 1.2345E-2), so we can drop the leading '1' as it will always be in the number somewhere. Then we figure out whether the number is '-' or '+' and use a sign bit for that. We figure out what the value of 'E' is, and implement that into the number. Then we break up the whole number and fractional and turn that into binary. Then take four bit chunks of the binary and convert that to hex digits, combine them and there it is. BCD. (At least that's the way I understand it.) To convert the BCD number back, one basically reverses the process. (Duh.)
So let's start with converting the float (or double) to binary:
Code:
*..............................................................................
* Function: float2bin
* Purpose: This function will take a float, 0.?, and convert it to binary
* representation which can then be converted to hex bcd using bin2hex.
*
* Parameters: nValue - float numer i.e., 123.45
* nWordSize: either 8 or 16 bit. 16 is default for better precision
* Calls: Dec2BasX() and Dec2Bin()
* returns: string
* Usage: cresult=float2bin(nValue)
* STORE float2bin(123.45) TO cMyBin
* cMyBin == '0100000001011110110111001100110011001100110011001100110011001101'
*..............................................................................
FUNCTION float2bin
PARAMETERS nValue, nWordSize
*... we'll default the wordsize to 16 if not specified.
IF Vartype(nWordSize) # 'N'
STORE 16 TO nWordSize
ENDIF
STORE IIF(nValue > 0, '0', '1') TO cSignBit
STORE 0 TO nExponent
STORE ABS(nValue) TO nCalcValue, nValue
STORE INT(nValue) TO nInt
IF nInt > 0
STORE MOD(nValue, INT(nValue)) TO nMantissa
ELSE
STORE nValue TO nMantissa
ENDIF
IF nInt > 1
cBinString = SUBSTR(dec2basx(nInt, 2) + dec2bin(nMantissa, nWordSize), 2)
ELSE
cBinString = dec2bin(nMantissa, nWordSize)
ENDIF
*... calc exponent
DO WHILE !(nCalcValue >= 1 AND nCalcValue < 2)
nCalcValue = nValue / (2 ^ nExponent) &&... start with +E
IF !(nCalcValue >= 1 AND nCalcValue < 2)
nExponent = nExponent * -1 &&... flip sign then try -E
nCalcValue = nValue / (2 ^ nExponent)
IF (nCalcValue >= 1 AND nCalcValue < 2)
EXIT
ENDIF
ELSE
EXIT
ENDIF
nExponent = ABS(nExponent) + 1 &&... keep going?
ENDDO
nMantissa = 1 + (1 / (2^nExponent))
IF nInt < 1
cBinString = SUBSTR(cBinString, ABS(nExponent) + 1)
ENDIF
IF nWordSize = 8
nBiased = 127
cExpBits = PADL(dec2basx(nExponent + nBiased, 2), 8, '0')
ELSE
nBiased = 1023
cExpBits = PADL(dec2basx(nExponent + nBiased, 2), 11, '0')
ENDIF
cBits = cSignBit + cExpBits + cBinString
IF nWordSize = 8
RETURN PADR(cBits, 32, '0')
ELSE
RETURN PADR(cBits, 64, '0')
ENDIF
*:EOF float2bin
9- .Decimal->Binary
Then we need to take the decimal portion and convert it to binary.
Logic:
multiply decimal by 2
IF decimal number > 1
put 1 in binary fraction
subtract 1 from decimal
multiply result by 2
ELSE
put 0 in binary fraction
multiply decimal number by 2
ENDIF
For a great demo of how this works, go here: Try .875 to start with. (Flash required)
http://scholar.hw.ac.uk/site/computing/topic20.asp?outline=
Code:
*..............................................................................
* Function: dec2bin
* Purpose: convert floating point fraction to binary string -
* i.e. .75 = '11', .25 = '01' and .075 =
* '0001001100110011001100110011001100110011001100110011'
* Parameters: nDecimal - Float number i.e. .45
* nWordSize: either 8 or 16 bit. 16 is default for better precision
* returns: string data type
* Usage: nresult=dec2bin(nDecNum)
* STORE dec2bin(.45) TO nMyNum
* nMyNum == '0111001100110011001100110011001100110011001100110011'
*..............................................................................
FUNCTION dec2bin
PARAMETERS nDecimal, nWordSize
STORE ' TO cBinString
STORE nDecimal TO nWork
STORE 0 TO nCounter
*... we'll default the wordsize to 16 if not specified.
IF Vartype(nWordSize) # 'N'
STORE 16 TO nWordSize
ENDIF
IF nWordSize = 8
STORE 22 TO nMax
ELSE
STORE 51 TO nMax
ENDIF
DO WHILE nWork # 0 AND nCounter <= nMax &&... nMax precision bits
nWork = nWork * 2
IF nWork >= 1
cBinString = cBinString + '1'
nWork = MOD(nWork, INT(nWork))
ELSE
cBinString = cBinString + '0'
ENDIF
nCounter = nCounter + 1
ENDDO
RETURN cBinString
*: EOF dec2bin
10- Binary->Hexadecimal
Here we take our converted binary number, and convert it to bcd hex in groups of 4.
I.e., 0100 0000 0101 1110.... = 4 0 5 E .....
Code:
*..............................................................................
* Function: bin2hex
* Purpose: convert binary representation of bcd number to hex
* Parameters: string data type. 123.45 =
* '0100000001011110110111001100110011001100110011001100110011001101'
* = 0x '405EDD2F1A9FBE77'
* Takes each segment of four binary digits and converts to hex digit
* Example: 0100 0000 0101 1110.... = 4 0 5 E .....
* returns: string data type
* Usage: cresult=bin2hex(cBinNum)
* STORE bin2hex('0100') TO nMyNum
* nMyNum == '4'
*..............................................................................
FUNCTION bin2hex
PARAMETERS cBinString
STORE ' TO cHexString
STORE Len(cBinString) TO nStrLen
FOR zzz = 1 TO nStrLen STEP 4
cHexString = cHexString + ;
dec2basx(bin2dec(SUBSTR(cBinString, zzz, 4)), 16)
NEXT
RETURN cHexString
*: EOF bin2hex
11- Hexidecimal->Binary
So we have the BCD hex number. We need to convert it back to float or double. Start with taking each hex digit and converting it to it's binary representation. Then separate the whole portion and decimal portion, and convert back to number.
Code:
*..............................................................................
* Function: hex2bin
* Purpose: convert hex bcd number to binary representation of bcd number
* Parameters: string data type
* Takes each hex digit and converts to four binary digits
* Example: 4 = 0100, 0 = 0000, 5 = 0101 etc.
* returns: string data type
* Usage: cresult=hex2bin(cHexString)
* STORE hex2bin('405EDD2F1A9FBE77') TO nMyNum
* nMyNum == '0100000001011110110111010010111100011010100111111011111001110111'
*..............................................................................
FUNCTION hex2bin
PARAMETERS cHexString
STORE ' TO cBinString, cBinString1
STORE Len(cHexString) TO nStrLen
FOR zzz = 1 TO nStrLen
cBinString = cBinString + ;
Padl(dec2basx(Int(Val('0x' + Substr(cHexString, zzz, 1))), 2), 4, '0')
NEXT
RETURN cBinString
*: EOF hex2bin
12- Binary->Float
Converts binary to floating point decimal number, whole portion and fraction.
Code:
*..............................................................................
* Function: bin2float
* Purpose: convert bcd binary to floating point decimal number
* Parameters: string data type of binary representation of bcd number
* '0100000001011110110111001100110011001100110011001100110011001101' = 123.45
* nWordSize: either 8 or 16 bit. 16 is default for better precision
* Calls: bin2dec() and bin2dec2()
* returns: string data type
* Usage: nresult=bin2float(cBinString)
* STORE bin2float('0111001100110011001100110011001100110011001100110011') ;
* TO nMyNum
* nMyNum == 123.45
*..............................................................................
FUNCTION bin2float
PARAMETERS cBinNum, nWordSize
IF Vartype(nWordSize) # 'N'
IF Len(cBinNum) = 32
STORE 8 TO nWordSize
ELSE &&... len better be 64
STORE 16 TO nWordSize
ENDIF
ENDIF
STORE IIF(LEFT(cBinNum, 1) = '1', '-', '+') + '1' TO cSign
IF nWordSize = 8
STORE SUBSTR(cBinNum, 2, 8) TO cExponent
STORE SUBSTR(cBinNum, 10) TO cMantissa
ELSE
STORE SUBSTR(cBinNum, 2, 11) TO cExponent
STORE SUBSTR(cBinNum, 13) TO cMantissa
ENDIF
IF nWordSize = 8
nExponent = bin2dec(cExponent) - 127
ELSE
nExponent = bin2dec(cExponent) - 1023
ENDIF
IF nExponent < 0
cDec = REPLICATE('0', ABS(nExponent)-1) + '1' + cMantissa
nDec = bin2dec2(cDec)
nInt = 0
ELSE
cInt = '1' + SUBSTR(cMantissa, 1, nExponent)
cDec = SUBSTR(cMantissa, nExponent + 1)
nInt = bin2dec(cInt)
nDec = bin2dec2(cDec)
ENDIF
nValue = nInt + nDec
nValue = nValue * VAL(cSign)
RETURN nValue
*: EOF bin2float
13- Binary->Decimal
Code:
*..............................................................................
* Function: bin2dec
* Purpose: convert binary string to decimal number
* Parameters: pbinnum - string to convert i.e.,
* '0' - '11111111111111111111111111111111111111111111111111111'
* '0' - (53 1's)
* returns: integer data type
* Usage: nresult=bin2dec(cBinString)
* STORE bin2dec('11111111') TO nMyNum
* nMyNum == 255
*..............................................................................
FUNCTION bin2dec
PARAMETERS pbinnum
PRIVATE retval, bindex
STORE 0 TO retval
pbinnum = ALLTRIM(pbinnum)
STORE LEN(pbinnum) TO nDigits
FOR bindex = 0 TO nDigits
IF SUBSTR(pbinnum, nDigits - bindex, 1) = '1'
retval = retval + 2^bindex
ENDIF
NEXT
RETURN INT(retval)
*: eof bin2dec
14- Binary->.Decimal
Code:
*..............................................................................
* Function: bin2dec2
* Purpose: convert binary string to floating point fraction - i.e. .123
* Parameters: pbinnum - string to convert i.e.,
* '0' - '11111111111111111111111111111111111111111111111111' (50 1's)
* returns: float data type
* Usage: nresult=bin2dec2(cBinString)
* STORE bin2dec2('111') TO nMyNum
* nMyNum == .875
*..............................................................................
FUNCTION bin2dec2
PARAMETERS pbinnum
PRIVATE retval, bindex
STORE 0 TO retval
pbinnum = ALLTRIM(pbinnum)
STORE LEN(pbinnum) TO nDigits
FOR bindex = 1 TO nDigits
IF SUBSTR(pbinnum, bindex, 1) = '1'
retval = retval + 2^(-bindex)
ENDIF
NEXT
RETURN retval
*: eof bin2dec2
15- Tie 'em together
Start with setting decimals to 18. Lot's better precision that way.
SET DECIMALS TO 18
So. If we take 123.45 and run it through Float2Bin() as Float2Bin(123.45, 8), we get:
01000010111101101110011001100110.
If we take 01000010111101101110011001100110 and run it through bin2hex(), we get 42f6e666, which is single precision.
Convert 42f6e666 back to binary using hex2bin('42f6e666'), and we get 01000010111101101110011001100110. Convert 01000010111101101110011001100110 to float using bin2float('01000010111101101110011001100110'), and we get 123.449996948242200000.
Not quite 123.45. So we need more accuracy.
Let's try double precision.
Take 123.45 and run it through Float2Bin() as Float2Bin(123.45, [color red]16[/color]), we get:
0100000001011110110111001100110011001100110011001100110011001101.
Take 0100000001011110110111001100110011001100110011001100110011001101 and run it through bin2hex(), and we get 405edccccccccccd.
If we take 405edccccccccccd and run it through hex2bin(), we get
0100000001011110110111001100110011001100110011001100110011001101.
If we take 0100000001011110110111001100110011001100110011001100110011001101 and run it through bin2float() we get 123.45. (Hopefully :O). Actually, I get back 123.450000000000000000. That's fine with me.
Here is where I tested/verified my results:
http://babbage.cs.qc.edu/courses/cs341/IEEE-754.html
16- Complete procedure file CVT.PRG
Copy and paste from here down to the form code into a procedure file. I have removed tutorial comments so it should compile error free.
*.............................. CVT.PRG ........................................
* Function: DEC2BASX
* Purpose: Convert whole number 0-?, to base 2-16
* Parameters: nTempNum - number to convert (0-9007199254740992)
* base - base to convert to i.e., 2 4 8 16...
* returns: string
* Usage: cresult=Dec2BasX(nParm1, nParm2)
* STORE Dec2BasX(255, 16) TO cMyString &&... cMyString contains 'ff'
*..............................................................................
FUNCTION dec2basx
PARAMETERS nTempNum, nNewBase
STORE 0 TO nWorkVal,;
remainder,;
dividend,;
nextnum,;
digit
nWorkVal = nTempNum
ret_str = '
DO WHILE .T.
digit = MOD(nWorkVal, nNewBase)
dividend = nWorkVal / nNewBase
nWorkVal = INT(dividend)
DO CASE
CASE digit = 10
ret_str = 'a' + ret_str
CASE digit = 11
ret_str = 'b' + ret_str
CASE digit = 12
ret_str = 'c' + ret_str
CASE digit = 13
ret_str = 'd' + ret_str
CASE digit = 14
ret_str = 'e' + ret_str
CASE digit = 15
ret_str = 'f' + ret_str
OTHERWISE
ret_str = LTRIM(STR(digit)) + ret_str
ENDCASE
IF nWorkVal = 0
EXIT
ENDIF ( nWorkVal = 0 )
ENDDO ( .T. )
RETURN ret_str
*: eof dec2basx
*..................................................................
* Function: bin2dec
* Purpose: convert binary string to decimal number
* Parameters: pbinnum - string to convert i.e.,
* '0' - '11111111111111111111111111111111111111111111111111111'
* '0' - (53 1's)
* returns: integer data type
* Usage: nresult = Bin2Dec(cParm1)
* STORE Bin2Dec('11111111') TO nMyNum &&... nMyNum contains 255
*..................................................................
FUNCTION bin2dec
PARAMETERS pbinnum
PRIVATE retval, bindex
STORE 0 TO retval
pbinnum = Alltrim(pbinnum)
STORE Len(pbinnum) TO nDigits
FOR bindex = 0 TO nDigits
IF SUBSTR(pbinnum, nDigits - bindex, 1) = '1'
retval = retval + 2^bindex
ENDIF
NEXT
RETURN Int(retval)
*: eof bin2dec
*..............................................................................
* Function: convert HEX STRING to decimal number
* i.e., '0001' returns 1 and
* 'ffff' returns 65535
* Parameters: hexnum - a string valued '0000' to 'ffff'
* decnum - initialized to 0 returns the value of the conversion
* Usage: nresult=hex2dec(cHexNum)
* STORE hex2dec('FFFF') TO nMyNum &&... nMyNum contains 65535
*..............................................................................
FUNCTION hex2dec
PARAMETERS hexnum
STORE 0 TO decnum
STORE ' TO tempnum
IF LEN(ALLTRIM(hexnum)) < 4
hexnum = PADL(hexnum, 4, '0')
ENDIF ( LEN(ALLTRIM(hexnum)) < 4 )
STORE LEN(hexnum)-1 TO indx
FOR i = 1 TO LEN(hexnum)
DO CASE
CASE SUBSTR(UPPER(hexnum), i, 1) == "F"
tempnum = '15'
CASE SUBSTR(UPPER(hexnum), i, 1) == "E"
tempnum = '14'
CASE SUBSTR(UPPER(hexnum), i, 1) == "D"
tempnum = '13'
CASE SUBSTR(UPPER(hexnum), i, 1) == "C"
tempnum = '12'
CASE SUBSTR(UPPER(hexnum), i, 1) == "B"
tempnum = '11'
CASE SUBSTR(UPPER(hexnum), i, 1) == "A"
tempnum = '10'
OTHERWISE
tempnum = SUBSTR(hexnum, i, 1)
ENDCASE
decnum = decnum + (VAL(tempnum) * (16^indx))
indx = indx - 1
ENDFOR ( i )
RETURN decnum
*: EOF hex2dec
*..............................................................................
* Function: float2bin
* Purpose: This function will take a float, 0.?, and convert it to binary
* representation which can then be converted to hex bcd using bin2hex.
*
* Parameters: nValue - float numer i.e., 123.45
* nWordSize: either 8 or 16 bit. 16 is default for better precision
* Calls: Dec2BasX() and Dec2Bin()
* returns: string
* Usage: cresult=float2bin(nValue)
* STORE float2bin(123.45) TO cMyBin
* nMyNum == '0100000001011110110111001100110011001100110011001100110011001101'
*..............................................................................
FUNCTION float2bin
PARAMETERS nValue, nWordSize
*... we'll default the wordsize to 16 if not specified.
IF Vartype(nWordSize) # 'N'
STORE 16 TO nWordSize
ENDIF
STORE IIF(nValue > 0, '0', '1') TO cSignBit
STORE 0 TO nExponent
STORE ABS(nValue) TO nCalcValue, nValue
STORE INT(nValue) TO nInt
IF nInt > 0
STORE MOD(nValue, INT(nValue)) TO nMantissa
ELSE
STORE nValue TO nMantissa
ENDIF
IF nInt > 1
cBinString = SUBSTR(dec2basx(nInt, 2) + dec2bin(nMantissa, nWordSize), 2)
ELSE
cBinString = dec2bin(nMantissa, nWordSize)
ENDIF
*... calc exponent
DO WHILE !(nCalcValue >= 1 AND nCalcValue < 2)
nCalcValue = nValue / (2 ^ nExponent) &&... start with +E
IF !(nCalcValue >= 1 AND nCalcValue < 2)
nExponent = nExponent * -1 &&... flip sign then try -E
nCalcValue = nValue / (2 ^ nExponent)
IF (nCalcValue >= 1 AND nCalcValue < 2)
EXIT
ENDIF
ELSE
EXIT
ENDIF
nExponent = ABS(nExponent) + 1 &&... keep going?
ENDDO
nMantissa = 1 + (1 / (2^nExponent))
IF nInt < 1
cBinString = SUBSTR(cBinString, ABS(nExponent) + 1)
ENDIF
IF nWordSize = 8
nBiased = 127
cExpBits = PADL(dec2basx(nExponent + nBiased, 2), 8, '0')
ELSE
nBiased = 1023
cExpBits = PADL(dec2basx(nExponent + nBiased, 2), 11, '0')
ENDIF
cBits = cSignBit + cExpBits + cBinString
IF nWordSize = 8
RETURN PADR(cBits, 32, '0')
ELSE
RETURN PADR(cBits, 64, '0')
ENDIF
*:EOF float2bin
*..............................................................................
* Function: dec2bin
* Purpose: convert floating point fraction to binary string -
* i.e. .75 = '11', .25 = '01' and .075 =
* '0001001100110011001100110011001100110011001100110011'
* Parameters: nDecimal - Float number i.e. .45
* nWordSize: either 8 or 16 bit. 16 is default for better precision
* returns: string data type
* Usage: nresult=dec2bin(nDecNum)
* STORE dec2bin(.45) TO nMyNum
* nMyNum == '0111001100110011001100110011001100110011001100110011'
*
*..............................................................................
FUNCTION dec2bin
PARAMETERS nDecimal, nWordSize
STORE ' TO cBinString
STORE nDecimal TO nWork
STORE 0 TO nCounter
*... we'll default the wordsize to 16 if not specified.
IF Vartype(nWordSize) # 'N'
STORE 16 TO nWordSize
ENDIF
IF nWordSize = 8
STORE 22 TO nMax
ELSE
STORE 51 TO nMax
ENDIF
DO WHILE nWork # 0 AND nCounter <= nMax &&... nMax precision bits
nWork = nWork * 2
IF nWork >= 1
cBinString = cBinString + '1'
nWork = MOD(nWork, INT(nWork))
ELSE
cBinString = cBinString + '0'
ENDIF
nCounter = nCounter + 1
ENDDO
RETURN cBinString
*: EOF dec2bin
*..............................................................................
* Function: bin2hex
* Purpose: convert binary representation of bcd number to hex
* Parameters: string data type. 123.45 =
* '0100000001011110110111001100110011001100110011001100110011001101'
* = 0x '405EDD2F1A9FBE77'
* Takes each segment of four binary digits and converts to hex digit
* Example: 0100 0000 0101 1110.... = 4 0 5 E .....
* returns: string data type
* Usage: cresult=bin2hex(cBinNum)
* STORE bin2hex('0100') TO nMyNum &&... nMyNum == '4'
*..............................................................................
FUNCTION bin2hex
PARAMETERS cBinString
STORE ' TO cHexString
STORE Len(cBinString) TO nStrLen
FOR zzz = 1 TO nStrLen STEP 4
cHexString = cHexString + ;
dec2basx(bin2dec(SUBSTR(cBinString, zzz, 4)), 16)
NEXT
RETURN cHexString
*: EOF bin2hex
*..............................................................................
* Function: hex2bin
* Purpose: convert hex bcd number to binary representation of bcd number
* Parameters: string data type
* Takes each hex digit and converts to four binary digits
* Example: 4 = 0100, 0 = 0000, 5 = 0101 etc.
* returns: string data type
* Usage: cresult=hex2bin(cHexString)
* STORE hex2bin('405EDD2F1A9FBE77') TO nMyNum nMyNum ==
* '0100000001011110110111010010111100011010100111111011111001110111'
*..............................................................................
FUNCTION hex2bin
PARAMETERS cHexString
STORE ' TO cBinString, cBinString1
STORE Len(cHexString) TO nStrLen
FOR zzz = 1 TO nStrLen
cBinString = cBinString + ;
Padl(dec2basx(Int(Val('0x' + Substr(cHexString, zzz, 1))), 2), 4, '0')
NEXT
RETURN cBinString
*: EOF hex2bin
*..............................................................................
* Function: bin2float
* Purpose: convert bcd binary to floating point decimal number
* Parameters: string data type of binary representation of bcd number
* '0100000001011110110111001100110011001100110011001100110011001101'
* = 123.45
* nWordSize: either 8 or 16 bit. 16 is default for better precision
* Calls: bin2dec() and bin2dec2()
* returns: string data type
* Usage: nresult=bin2float(cBinString)
* STORE bin2float('0111001100110011001100110011001100110011001100110011') ;
* TO nMyNum &&... nMyNum == 123.45
*..............................................................................
FUNCTION bin2float
PARAMETERS cBinNum, nWordSize
IF Vartype(nWordSize) # 'N'
IF Len(cBinNum) = 32
STORE 8 TO nWordSize
ELSE &&... len better be 64
STORE 16 TO nWordSize
ENDIF
ENDIF
STORE IIF(LEFT(cBinNum, 1) = '1', '-', '+') + '1' TO cSign
IF nWordSize = 8
STORE SUBSTR(cBinNum, 2, 8) TO cExponent
STORE SUBSTR(cBinNum, 10) TO cMantissa
ELSE
STORE SUBSTR(cBinNum, 2, 11) TO cExponent
STORE SUBSTR(cBinNum, 13) TO cMantissa
ENDIF
IF nWordSize = 8
nExponent = bin2dec(cExponent) - 127
ELSE
nExponent = bin2dec(cExponent) - 1023
ENDIF
IF nExponent < 0
cDec = REPLICATE('0', ABS(nExponent)-1) + '1' + cMantissa
nDec = bin2dec2(cDec)
nInt = 0
ELSE
cInt = '1' + SubStr(cMantissa, 1, nExponent)
cDec = SUBSTR(cMantissa, nExponent + 1)
nInt = bin2dec(cInt)
nDec = bin2dec2(cDec)
ENDIF
nValue = nInt + nDec
nValue = nValue * VAL(cSign)
RETURN nValue
*: EOF bin2float
*..............................................................................
* Function: bin2dec
* Purpose: convert binary string to decimal number
* Parameters: pbinnum - string to convert i.e.,
* '0' - '11111111111111111111111111111111111111111111111111111'
* '0' - (53 1's)
* returns: integer data type
* Usage: nresult=bin2dec(cBinString)
* STORE bin2dec('11111111') TO nMyNum &&... nMyNum == 255
*..............................................................................
FUNCTION bin2dec
PARAMETERS pbinnum
PRIVATE retval, bindex
STORE 0 TO retval
pbinnum = ALLTRIM(pbinnum)
STORE LEN(pbinnum) TO nDigits
FOR bindex = 0 TO nDigits
IF SUBSTR(pbinnum, nDigits - bindex, 1) = '1'
retval = retval + 2^bindex
ENDIF
NEXT
RETURN INT(retval)
*: eof bin2dec
*..............................................................................
* Function: bin2dec2
* Purpose: convert binary string to floating point fraction - i.e. .123
* Parameters: pbinnum - string to convert i.e.,
* '0' - '11111111111111111111111111111111111111111111111111' (50 1's)
* returns: float data type
* Usage: nresult=bin2dec2(cBinString)
* STORE ?bin2dec2('111') TO nMyNum &&... nMyNum == .875
*..............................................................................
FUNCTION bin2dec2
PARAMETERS pbinnum
PRIVATE retval, bindex
STORE 0 TO retval
pbinnum = ALLTRIM(pbinnum)
STORE LEN(pbinnum) TO nDigits
FOR bindex = 1 TO nDigits
IF SUBSTR(pbinnum, bindex, 1) = '1'
retval = retval + 2^(-bindex)
ENDIF
NEXT
RETURN retval
*: eof bin2dec2
*******************************************************************************************
17- Form code to demo conversions
Run this little prg, to call the form code below. Make sure you have already cut and pasted the above code into a procedure file named 'cvt.prg', or change the SET PROCEDURE TO line below to reflect the name of the procedure file you're using. Save the fllowing code as CVTFORM.PRG, then,
DO cvtform
*******************************************************************************************
* CVTFORM.PRG
SET PROCEDURE TO cvt
SET DECIMALS TO 18
PUBLIC oForm
oForm = CreateObject("cvt")
oForm.Visible = .T.
*
DEFINE CLASS cvt AS form
Top = 0
Left = 0
Height = 341
Width = 547
DoCreate = .T.
Caption = "Conversion Demo Form"
Autocenter = .T.
Name = "Form1"
ADD OBJECT txtoriginal AS textbox WITH ;
Height = 23, ;
Left = 36, ;
TabIndex = 1, ;
Top = 21, ;
Width = 120, ;
Name = "txtOriginal"
ADD OBJECT txtbin8 AS textbox WITH ;
Height = 23, ;
Left = 36, ;
TabIndex = 3, ;
Top = 67, ;
Width = 264, ;
Name = "txtbin8"
ADD OBJECT txthex8 AS textbox WITH ;
Height = 23, ;
Left = 36, ;
TabIndex = 4, ;
Top = 107, ;
Width = 84, ;
Name = "txthex8"
ADD OBJECT txtdec8 AS textbox WITH ;
Height = 23, ;
Left = 36, ;
TabIndex = 5, ;
Top = 146, ;
Width = 179, ;
Name = "txtdec8"
ADD OBJECT txtbin16 AS textbox WITH ;
Height = 23, ;
Left = 36, ;
TabIndex = 6, ;
Top = 199, ;
Width = 480, ;
Name = "txtbin16"
ADD OBJECT txthex16 AS textbox WITH ;
Height = 23, ;
Left = 36, ;
TabIndex = 7, ;
Top = 244, ;
Width = 120, ;
Name = "txthex16"
ADD OBJECT txtdec16 AS textbox WITH ;
Height = 23, ;
Left = 36, ;
TabIndex = 8, ;
Top = 283, ;
Width = 179, ;
Name = "txtdec16"
ADD OBJECT label1 AS label WITH ;
AutoSize = .T., ;
Alignment = 0, ;
Caption = "Binary Single Precision:", ;
Height = 17, ;
Left = 36, ;
Top = 51, ;
Width = 132, ;
TabIndex = 9, ;
Name = "Label1"
ADD OBJECT label2 AS label WITH ;
AutoSize = .T., ;
Alignment = 0, ;
Caption = "Hex Single Precision:", ;
Height = 17, ;
Left = 36, ;
Top = 90, ;
Width = 119, ;
TabIndex = 10, ;
Name = "Label2"
ADD OBJECT label3 AS label WITH ;
AutoSize = .T., ;
Alignment = 0, ;
Caption = "Converted back:", ;
Height = 17, ;
Left = 36, ;
Top = 130, ;
Width = 90, ;
TabIndex = 11, ;
Name = "Label3"
ADD OBJECT label4 AS label WITH ;
AutoSize = .T., ;
Alignment = 0, ;
Caption = "Binary Double Precision:", ;
Height = 17, ;
Left = 36, ;
Top = 183, ;
Width = 137, ;
TabIndex = 12, ;
Name = "Label4"
ADD OBJECT label5 AS label WITH ;
AutoSize = .T., ;
Alignment = 0, ;
Caption = "Hex Double Precision:", ;
Height = 17, ;
Left = 36, ;
Top = 228, ;
Width = 124, ;
TabIndex = 13, ;
Name = "Label5"
ADD OBJECT label6 AS label WITH ;
AutoSize = .T., ;
Alignment = 0, ;
Caption = "Converted back:", ;
Height = 17, ;
Left = 36, ;
Top = 267, ;
Width = 90, ;
TabIndex = 14, ;
Name = "Label6"
ADD OBJECT command1 AS commandbutton WITH ;
Top = 21, ;
Left = 173, ;
Height = 23, ;
Width = 84, ;
Cancel = .F., ;
Caption = "Convert", ;
Default = .T., ;
TabIndex = 2, ;
Name = "Command1"
PROCEDURE QueryUnload
CLEAR EVENTS
ENDPROC
PROCEDURE command1.Click
WITH THISFORM
IF VAL(.txtOriginal.VALUE) = 0
MESSAGEBOX("Value equals 0. Try again.",0,"Boo Boo")
ELSE
.txtbin8.VALUE = float2bin(VAL(.txtOriginal.VALUE), 8)
.txthex8.VALUE = bin2hex(.txtbin8.VALUE)
.txtdec8.VALUE = bin2float(hex2bin(.txthex8.VALUE))
.txtbin16.VALUE = float2bin(VAL(.txtOriginal.VALUE), 16)
.txthex16.VALUE = bin2hex(.txtbin16.VALUE)
.txtdec16.VALUE = bin2float(hex2bin(.txthex16.VALUE))
ENDIF
.txtOriginal.SETFOCUS
ENDWITH
RETURN
ENDPROC
ENDDEFINE
*-- EndDefine: cvt
**************************************************