Tek-Tips is the largest IT community on the Internet today!

Members share and learn making Tek-Tips Forums the best source of peer-reviewed technical information on the Internet!

  • Congratulations strongm on being selected by the Tek-Tips community for having the most helpful posts in the forums last week. Way to Go!

Conversion Functions 3

Status
Not open for further replies.

DSummZZZ

Programmer
Oct 24, 2000
4,250
US
I have posted a new FAQ:
Conversion Functions: Dec,Hex,Binary,Oct Back and Forth
faq184-4461

There have been requests for conversion functions, so I lumped some together.
Please take a look and tell me what you think.
Unlike slighthaze's form version 'Bin - Dec - Hex - RGB Converter ', these are just standalone functions and methods to cut and paste.

Thanks for taking the time.


-Dave S.-
[cheers]
Even more Fox stuff at:
 
A good piece of work. Thanks for sharing (*)

Jim Osieczonek
Delta Business Group, LLC
 
Please take a minute and another look at this updated FAQ:

Conversion Functions: Dec,Hex,Binary,Oct Back and Forth
FAQ184-4461

I have added code to convert to and from BCD. Hopefully a little more precision than what I have seen to date written in VFP.
Besides the descriptions, there is also a stand-alone procedure file, and an demo form.

Thanx for taking the time.



-Dave S.-
[cheers]
Even more Fox stuff at:
 
Dave,

did you noticed that your FAQ ends in the middle of a statement

ADD OBJECT label4 AS label WITH ;

Maybe you reached some limit?

 
Dave,

As thesofty has mentioned, your last example is cut down.
But it is Greaaat!! More precision. Now I can use it for API :-D

Regards
[thumbsup2]

-- AirCon --
 
Dave,
Just for a comparison:

[tt]
(1) is Single Float Conversion on wiki
(2) Your's Single Float Conversion

123.45 :
(1) 42F6E666 -- 123.4510
(2) 42F6E666 -- 123.4500

0.5 :
(1) 3F000000 -- 1.0000 (???)
(2) 3F000000 -- 0.5000

78000.5 :
(1) 47985840 -- 78000.2500
(2) 47985840 -- 78000.5000

72355.445 (here both function lost precision):
(1) 478D51B8 -- 72355.2188
(2) 478D51B8 -- 72355.4375

Well, if you can work it out a little bit more. But it's great anyway :)

Regards

-- AirCon --
 
I see the FAQ got truncated on the form code. There is some sort of weirdness going on with FAQ's right now, I can't seem to post the shortened code which should all fit.
As soon as that gets fixed, I'll repost.
In the meantime, below is the form code to demo the conversion functions, just use the procedure file from the FAQ. Or, go to my website (link in the signature) and scroll down to the area that says 'Conversion Functions'. Click on "cvt.zip" and you will get a zip file containing the procedure file and form code.

AirCon,
The link mentioned in the FAQ comes up with some other interesting values. Below are wiki calcs (1) my calcs (2) and the calcs from which are 'Rounded' (3) and 'Not Rounded' (4), which are written using java script.:

123.45 :
(2) 42F6E666 -- 123.4500
(3) 42F6E666 -- 123.45000
(4) 42F6E666 -- 123.45000

0.5 :
(1) 3F000000 -- 1.0000 (???)
(2) 3F000000 -- 0.5000
(3) 3F000000 -- 5.0000000e-1
(4) 3F000000 -- 5.0000000e-1

78000.5 :
(1) 47985840 -- 78000.2500
(2) 47985840 -- 78000.5000
(3) 47985840 -- 78000.500
(4) 47985840 -- 78000.500

72355.445 (here both function lost precision):
(1) 478D51B8 -- 72355.2188
(2) 478D51B8 -- 72355.4375
(3) 478D51B9 -- 72355.445
(4) 478D51B8 -- 72355.438

But since single precision can only handle so many digits, when I ran this value: 355.4455 I get these results:
(1) I didn't do the wiki version
(2) 43b1b906 -- 355.445495605468800000
(3) 43B1B906 -- 355.44550
(4) 43B1B906 -- 355.44550
And Round(355.445495605468800000, 4) == 355.4455. So, I think that if one needs better precision, the thing to do is use doubles.


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'
Code:
*******************************************************************************************
*  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
**************************************************


-Dave S.-
[cheers]
Even more Fox stuff at:
 
Okay. The FAQ weirdness is gone. The complete code is now in there.

Conversion Functions: Dec,Hex,Binary,Oct Back and Forth
FAQ184-4461


-Dave S.-
[cheers]
Even more Fox stuff at:
 
Status
Not open for further replies.

Part and Inventory Search

Sponsor

Back
Top