Navigation
Install the app
How to install the app on iOS
Follow along with the video below to see how to install our site as a web app on your home screen.
Note: This feature may not be available in some browsers.
More options
-
Congratulations Mike Lewis on being selected by the Tek-Tips community for having the most helpful posts in the forums last week. Way to Go!
You are using an out of date browser. It may not display this or other websites correctly.
You should upgrade or use an alternative browser.
You should upgrade or use an alternative browser.
Bin - Dec - Hex - RGB Converter
Usefull Functions & Procedures
Bin - Dec - Hex - RGB Converter
by
craigsboyd
Posted
(Edited
)
Slighthaze = [color blue]NULL[/color]
[img http://www.sweetpotatosoftware.com/ttimages/converter.gif]
In thread184-658948 other members and I were discussing the possibilities for converting an RGB value to Hex. I decided to expand on that and the following is what I came up with, a form class that converts Binary, Decimal, Hexadecimal, and RGB values all at the same time. (Cut-N-Paste the code below into a prg file and run it from within VFP 7+)
[img http://www.sweetpotatosoftware.com/ttimages/converter.gif]
In thread184-658948 other members and I were discussing the possibilities for converting an RGB value to Hex. I decided to expand on that and the following is what I came up with, a form class that converts Binary, Decimal, Hexadecimal, and RGB values all at the same time. (Cut-N-Paste the code below into a prg file and run it from within VFP 7+)
Code:
PUBLIC oForm
oForm = CREATEOBJECT("clsconverter")
oForm.show()
DEFINE CLASS clsconverter AS form
Top = 0
Left = 0
Height = 201
Width = 337
DoCreate = .T.
Caption = "NUMERIC CONVERTER"
Name = "clsconverter"
ADD OBJECT txtbin AS textbox WITH ;
Alignment = 1, ;
Value = ("0"), ;
Height = 23, ;
Left = 108, ;
TabIndex = 1, ;
Top = 36, ;
Width = 204, ;
Name = "txtBin"
ADD OBJECT txtdec AS textbox WITH ;
Alignment = 3, ;
Value = 0, ;
Height = 23, ;
InputMask = "###,###,###,###,###", ;
Left = 108, ;
TabIndex = 2, ;
Top = 72, ;
Width = 204, ;
Name = "txtDec"
ADD OBJECT txtr AS textbox WITH ;
Alignment = 3, ;
Value = 0, ;
Height = 23, ;
InputMask = "###", ;
Left = 108, ;
TabIndex = 4, ;
Top = 144, ;
Width = 48, ;
Name = "txtR"
ADD OBJECT txtg AS textbox WITH ;
Alignment = 3, ;
Value = 0, ;
Height = 23, ;
InputMask = "###", ;
Left = 158, ;
TabIndex = 5, ;
Top = 144, ;
Width = 48, ;
Name = "txtG"
ADD OBJECT txtb AS textbox WITH ;
Alignment = 3, ;
Value = 0, ;
Height = 23, ;
InputMask = "###", ;
Left = 208, ;
TabIndex = 6, ;
Top = 144, ;
Width = 48, ;
Name = "txtB"
ADD OBJECT txthex AS textbox WITH ;
Alignment = 1, ;
Value = ("0x0"), ;
Height = 23, ;
Left = 108, ;
TabIndex = 3, ;
Top = 108, ;
Width = 204, ;
Name = "txtHex"
ADD OBJECT label1 AS label WITH ;
AutoSize = .T., ;
BackStyle = 0, ;
Caption = "Binary", ;
Height = 17, ;
Left = 24, ;
Top = 36, ;
Width = 36, ;
Name = "Label1"
ADD OBJECT label2 AS label WITH ;
AutoSize = .T., ;
BackStyle = 0, ;
Caption = "Decimal", ;
Height = 17, ;
Left = 24, ;
Top = 72, ;
Width = 48, ;
Name = "Label2"
ADD OBJECT label3 AS label WITH ;
AutoSize = .T., ;
BackStyle = 0, ;
Caption = "Hexadecimal", ;
Height = 17, ;
Left = 24, ;
Top = 108, ;
Width = 74, ;
Name = "Label3"
ADD OBJECT label4 AS label WITH ;
AutoSize = .T., ;
BackStyle = 0, ;
Caption = "RGB", ;
Height = 17, ;
Left = 24, ;
Top = 144, ;
Width = 28, ;
Name = "Label4"
ADD OBJECT cmdcolor AS commandbutton WITH ;
Top = 145, ;
Left = 259, ;
Height = 23, ;
Width = 53, ;
Caption = "COLOR", ;
Name = "cmdColor"
PROCEDURE dec2hex
LPARAMETERS lnValue
Return(TRANSFORM(lnValue, '@0'))
ENDPROC
PROCEDURE dec2bin
LPARAMETERS lnValue
LOCAL cBinString, i, nLen, nVal, TempString, TempVal, cReturnString
cBinString = ""
nVal = lnValue
DO WHILE .T.
nVal = (nVal / 2)
If OCCURS(".", transform(nVal)) > 0
cBinString = cBinString + "1"
nVal = INT(nVal)
If nVal < 1
exit
EndIf
Else
cBinString = cBinString + "0"
If nVal < 1
exit
EndIf
EndIf
ENDDO
cReturnString = ""
nLen = Len(cBinString)
For i = nLen To 1 Step -1
cReturnString = cReturnString + SUBSTR(cBinString, I, 1)
ENDFOR
Return(cReturnString)
ENDPROC
PROCEDURE dec2rgb
LPARAMETERS lnValue
*!* To give credit where credit is due
*!* This procedure copied almost verbatim from MS site
*!* http://support.microsoft.com/default.aspx?scid=http://support.microsoft.com:80/support/kb/articles/Q140/8/48.asp&NoWebContent=1
lTalk=IIF(SET('TALK')='ON',.T.,.F.)
SET TALK OFF
* Determine the hexadecimal equivalent of the decimal parameter passed
lcHex = ""
lnFactor = 24 && set up factor value one exponent greater than used
FOR lnPos = 6 TO 1 STEP -1
lnFactor = lnFactor - 4 && decrement factorial
lnExp = 2 ^ lnFactor && extrapolate next least power of two
FOR lnOrd = 15 TO 1 STEP -1
IF lnValue < lnExp && no value greater than current one,
lcHex = lcHex + "0" && so store a zero in this position
EXIT && go back for the next value
ENDIF
IF lnValue >= lnExp * lnOrd && is value greater than or equal to?
* find the matching hex value from its ordinal position
lcHex = lcHex + SUBSTR('123456789ABCDEF', lnOrd, 1)
EXIT
ENDIF
ENDFOR
lnValue = lnValue % lnExp && leave remainder of exponential division
ENDFOR
* reverse the order of the individual color indicators
lcHex = RIGHT(lcHex, 2) + SUBSTR(lcHex, 3, 2) + LEFT(lcHex, 2)
* convert the pairs into decimal values
lnPick = 2 && offset to determine which pair to convert
lcRGB = "" && start of string delineator
* parse each color indicator and convert to decimal
FOR lnColor = 1 TO 3
lcHue = SUBSTR(lcHex, (lnPick * lnColor) - 1, 2) && pull out color
lnMSB = ASC(LEFT(lcHue, 1)) && "Most Significant Bit"
lnLSB = ASC(RIGHT(lcHue, 1)) && "Least Significant Bit"
* subtract appropriate value from each to get decimal equivalent
lnMSB = lnMSB - IIF(lnMSB > 57, 55, 48)
lnLSB = lnLSB - IIF(lnLSB > 57, 55, 48)
* then add decimals together
lcRGB = lcRGB + TRANSFORM( lnMSB * 16 + lnLSB, '999') + ", "
ENDFOR
lcRGB = LEFT(lcRGB, LEN(lcRGB) - 2)
RETURN ALLTRIM(lcRGB)
ENDPROC
PROCEDURE hex2dec
LPARAMETERS lcValue
RETURN(VAL(ALLTRIM(lcValue)))
ENDPROC
PROCEDURE bin2dec
LPARAMETERS lcValue
LOCAL i, nLen, nReturn, nPower
lcValue = ALLTRIM(lcValue)
nReturn = 0
nLen =LEN(lcValue) - 1
FOR i = 1 TO nLen
nPower = nLen - i + 1
IF SUBSTR(lcValue,i,1) = "1"
nReturn = nReturn + (2 ^ nPower)
ENDIF
ENDFOR
nReturn = nReturn + VAL(RIGHT(lcValue,1))
return(nReturn)
ENDPROC
PROCEDURE rgb2dec
LPARAMETERS nlRValue, nlGValue, nlBValue
return(RGB(nlRValue, nlGValue, nlBValue))
ENDPROC
PROCEDURE txtbin.InteractiveChange
LOCAL lnValue, lcValue
if LEN(ALLTRIM(this.Value)) < 1
this.Value = "0"
ENDIF
lnValue = thisform.bin2dec(this.Value)
thisform.txtDec.value = lnValue
thisform.txthex.value = thisform.dec2hex(lnValue)
lcValue = thisform.dec2rgb(lnValue)
thisform.txtR.value = VAL(GETWORDNUM(lcValue, 1, ","))
thisform.txtG.value = VAL(GETWORDNUM(lcValue, 2, ","))
thisform.txtB.value = VAL(GETWORDNUM(lcValue, 3, ","))
ENDPROC
PROCEDURE txtdec.InteractiveChange
LOCAL lnValue, lcValue
lnValue = this.value
thisform.txtBin.value = thisform.dec2bin(lnValue)
thisform.txthex.value = thisform.dec2hex(lnValue)
lcValue = thisform.dec2rgb(lnValue)
thisform.txtR.value = VAL(GETWORDNUM(lcValue, 1, ","))
thisform.txtG.value = VAL(GETWORDNUM(lcValue, 2, ","))
thisform.txtB.value = VAL(GETWORDNUM(lcValue, 3, ","))
ENDPROC
PROCEDURE txtdec.RangeLow
RETURN 0
ENDPROC
PROCEDURE txtdec.GotFocus
ON READERROR MESSAGEBOX("Negative entries are not allowed")
ENDPROC
PROCEDURE txtdec.LostFocus
ON READERROR
ENDPROC
PROCEDURE txtr.InteractiveChange
LOCAL lnValue
lnValue = thisform.rgb2dec(thisform.txtR.Value,thisform.txtG.Value, thisform.txtB.Value)
thisform.txtDec.value = lnValue
thisform.txtBin.value = thisform.dec2bin(lnValue)
thisform.txthex.value = thisform.dec2hex(lnValue)
ENDPROC
PROCEDURE txtr.LostFocus
ON READERROR
ENDPROC
PROCEDURE txtr.GotFocus
ON READERROR MESSAGEBOX("Valid Entry 0 - 255")
ENDPROC
PROCEDURE txtr.RangeHigh
RETURN 255
ENDPROC
PROCEDURE txtr.RangeLow
RETURN 0
ENDPROC
PROCEDURE txtg.InteractiveChange
LOCAL lnValue
lnValue = thisform.rgb2dec(thisform.txtR.Value,thisform.txtG.Value, thisform.txtB.Value)
thisform.txtDec.value = lnValue
thisform.txtBin.value = thisform.dec2bin(lnValue)
thisform.txthex.value = thisform.dec2hex(lnValue)
ENDPROC
PROCEDURE txtg.RangeLow
RETURN 0
ENDPROC
PROCEDURE txtg.RangeHigh
RETURN 255
ENDPROC
PROCEDURE txtg.GotFocus
ON READERROR MESSAGEBOX("Valid Entry 0 - 255")
ENDPROC
PROCEDURE txtg.LostFocus
ON READERROR
ENDPROC
PROCEDURE txtb.InteractiveChange
LOCAL lnValue
lnValue = thisform.rgb2dec(thisform.txtR.Value,thisform.txtG.Value, thisform.txtB.Value)
thisform.txtDec.value = lnValue
thisform.txtBin.value = thisform.dec2bin(lnValue)
thisform.txthex.value = thisform.dec2hex(lnValue)
ENDPROC
PROCEDURE txtb.RangeLow
RETURN 0
ENDPROC
PROCEDURE txtb.RangeHigh
RETURN 255
ENDPROC
PROCEDURE txtb.LostFocus
ON READERROR
ENDPROC
PROCEDURE txtb.GotFocus
ON READERROR MESSAGEBOX("Valid Entry 0 - 255")
ENDPROC
PROCEDURE txthex.InteractiveChange
LOCAL lnValue
if LEN(ALLTRIM(this.Value)) < 3 OR LEFT(ALLTRIM(this.Value),2) != "0x"
this.Value = "0x0"
ENDIF
lnValue = thisform.hex2dec(this.Value)
thisform.txtDec.value = lnValue
thisform.txtBin.value = thisform.dec2bin(lnValue)
lcValue = thisform.dec2rgb(lnValue)
thisform.txtR.value = VAL(GETWORDNUM(lcValue, 1, ","))
thisform.txtG.value = VAL(GETWORDNUM(lcValue, 2, ","))
thisform.txtB.value = VAL(GETWORDNUM(lcValue, 3, ","))
ENDPROC
PROCEDURE cmdcolor.Click
LOCAL lnValue, lcValue
lnValue = GETCOLOR()
IF lnValue >= 0
thisform.txtDec.value = lnValue
thisform.txtbin.value = thisform.dec2bin(lnValue)
thisform.txthex.value = thisform.dec2hex(lnValue)
lcValue = thisform.dec2rgb(lnValue)
thisform.txtR.value = VAL(GETWORDNUM(lcValue, 1, ","))
thisform.txtG.value = VAL(GETWORDNUM(lcValue, 2, ","))
thisform.txtB.value = VAL(GETWORDNUM(lcValue, 3, ","))
ENDIF
ENDPROC
ENDDEFINE
Please Note: 1 is Bad, 10 is Good :-)
Part and Inventory Search
-
This site uses cookies to help personalise content, tailor your experience and to keep you logged in if you register.
By continuing to use this site, you are consenting to our use of cookies.