INTELLIGENT WORK FORUMS
FOR COMPUTER PROFESSIONALS

Log In

Come Join Us!

Are you a
Computer / IT professional?
Join Tek-Tips Forums!
  • Talk With Other Members
  • Be Notified Of Responses
    To Your Posts
  • Keyword Search
  • One-Click Access To Your
    Favorite Forums
  • Automated Signatures
    On Your Posts
  • Best Of All, It's Free!

*Tek-Tips's functionality depends on members receiving e-mail. By joining you are opting in to receive e-mail.

Posting Guidelines

Promoting, selling, recruiting, coursework and thesis posting is forbidden.

Jobs

Usefull Functions & Procedures

Conversion Functions: Dec,Hex,Binary,Oct Back and Forth by DSummZZZ
Posted: 19 Nov 03 (Edited 5 Dec 03)

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:

?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:

?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

*..............................................................................
*   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.  

*..................................................................
*   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.

?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:
?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.

*..............................................................................
*   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...
-or here:-
http://www.trotek.ec-lyon.fr/~muller/cours/numeration/f...

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:
*..............................................................................  
*   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?outl...=


*..............................................................................  
*   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 .....
*..............................................................................
*   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.

*..............................................................................
*   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.
*..............................................................................  
*   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
*..............................................................................
*   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
*..............................................................................
*   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, 16), 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
**************************************************

Back to Microsoft: Visual FoxPro FAQ Index
Back to Microsoft: Visual FoxPro Forum

My Archive

Resources

Close Box

Join Tek-Tips® Today!

Join your peers on the Internet's largest technical computer professional community.
It's easy to join and it's free.

Here's Why Members Love Tek-Tips Forums:

Register now while it's still free!

Already a member? Close this window and log in.

Join Us             Close