>A fully VFP-based resource - not relying on API. Great to have fox-based alternative versions.
>
>I'll test it in case the API that Carlos mentioned is not workable:)
>
>Do you know starting what Windows version was the resources in (ColorHLSToRGB and ColorRGBToHLS) shlwapi.Dll were available. For this application, I have to cope with OS running from W2K upwards.

I test all the Windows API functions I use against W2K, WXP, W7, all fully updated with latest IE and patches. By the way I made a mistake, the value range for HSL of those API functions is 240 for all.


By the way, while checking this, notices another API function that I think is right on spot for what you want:

ColorAdjustLuma Function
Changes the luminance of a RGB value. Hue and saturation are not affected.
http://msdn.microsoft.com/en-us/library/bb773848%28VS.85%29.aspx

And just in case you want to convert RGB to/from HSL with no dependencies, the colorpicker has a color class, in this case H is 0-360, and S/L is 0-100. I think 100 is too small a scale and you cant get all of the RGB colors with such a small scale for S/L, but its so practical to think in terms of %. Maybe if I redid this today I would use 0-3600, 0-1000, 0-1000 for HSL.

**************************************************
*-- Class:        _color
*-- ParentClass:  container
*-- BaseClass:    container
*-- Time Stamp:   05/30/10 07:19:10 PM
*
DEFINE CLASS _color AS container


	Width = 36
	Height = 38
	Visible = .F.
	_red = 0
	_green = 0
	_blue = 0
	_hue = 0
	_sat = 0
	_lum = 0
	_rgb = 0
	_display = .F.
	Name = "_color"

	*-- XML Metadata for customizable properties
	_memberdata = .F.


	PROCEDURE getgreen
		*!* GetGreen(nRgbColor)

		Lparameters pnRgb As Integer

		Return Bitrshift(Bitand(m.pnRgb, 0x00FF00), 8)
	ENDPROC


	PROCEDURE getred
		*!* GetRed(nRgbColor)

		Lparameters pnRgb As Integer

		Return Bitrshift(Bitand(m.pnRgb, 0x0000FF), 0)
	ENDPROC


	PROCEDURE gethue
		*!* GetHue(nRgbColor)

		Lparameters pnR, pnG, pnB

		Local ;
			lnRgb, ;
			lnR, ;
			lnG, ;
			lnB

		If Pcount() = 1 Then
			m.lnRgb = m.pnR
			m.lnR = This.GetRed(m.lnRgb)
			m.lnG = This.GetGreen(m.lnRgb)
			m.lnB = This.GetBlue(m.lnRgb)
		Else
			m.lnRgb = Rgb(m.pnR, m.pnG, m.pnB)
			m.lnR = m.pnR
			m.lnG = m.pnG
			m.lnB = m.pnB
		Endif

		If This._Rgb # m.lnRgb Then
			This._RgbToHsl(m.lnR, m.lnG, m.lnB)
		Endif

		Return This._Hue
	ENDPROC


	PROCEDURE getlum
		*!* GetLum(nRgbColor)

		Lparameters pnR, pnG, pnB

		Local ;
			lnRgb, ;
			lnR, ;
			lnG, ;
			lnB

		If Pcount() = 1 Then
			m.lnRgb = m.pnR
			m.lnR = This.GetRed(m.lnRgb)
			m.lnG = This.GetGreen(m.lnRgb)
			m.lnB = This.GetBlue(m.lnRgb)
		Else
			m.lnRgb = Rgb(m.pnR, m.pnG, m.pnB)
			m.lnR = m.pnR
			m.lnG = m.pnG
			m.lnB = m.pnB
		Endif

		If This._Rgb # m.lnRgb Then
			This._RgbToHsl(m.lnR, m.lnG, m.lnB)
		Endif

		Return This._Lum
	ENDPROC


	PROCEDURE getsat
		*!* GetSat(nRgbColor)

		Lparameters pnR, pnG, pnB

		Local ;
			lnRgb, ;
			lnR, ;
			lnG, ;
			lnB

		If Pcount() = 1 Then
			m.lnRgb = m.pnR
			m.lnR = This.GetRed(m.lnRgb)
			m.lnG = This.GetGreen(m.lnRgb)
			m.lnB = This.GetBlue(m.lnRgb)
		Else
			m.lnRgb = Rgb(m.pnR, m.pnG, m.pnB)
			m.lnR = m.pnR
			m.lnG = m.pnG
			m.lnB = m.pnB
		Endif

		If This._Rgb # m.lnRgb Then
			This._RgbToHsl(m.lnR, m.lnG, m.lnB)
		Endif

		Return This._Sat
	ENDPROC


	PROCEDURE getblue
		*!* GetBlue(nRgbColor)

		Lparameters pnRgb As Integer

		Return Bitrshift(Bitand(m.pnRgb, 0xFF0000), 16)
	ENDPROC


	*-- RGB TO HSL
	PROCEDURE _rgbtohsl
		Lparameters pnR, pnG, pnB

		This._Red 	= m.pnR
		This._Green = m.pnG
		This._Blue 	= m.pnB
		This._Rgb = Rgb(m.pnR, m.pnG, m.pnB)

		Local ;
			lnR, ;
			lnG, ;
			lnB, ;
			lnMin, ;
			lnMax, ;
			pnL, ;
			pnH, ;
			pnS

		*!* Convert the RBG values to the range 0-1
		m.lnR 	= m.pnR / 255
		m.lnG 	= m.pnG / 255
		m.lnB 	= m.pnB / 255

		*!* Find min and max values of R, G, B
		m.lnMin = Min(m.lnR, m.lnG, m.lnB)
		m.lnMax = Max(m.lnR, m.lnG, m.lnB)
		m.pnL = (m.lnMax + m.lnMin) / 2

		*!* If the max and min colors are the same (ie the color is some kind of grey),
		*!* Saturation is defined to be 0, and Hue is undefined but in programs usually written as 0
		If m.lnMax - m.lnMin = 0
			m.pnH = 0
			m.pnS = 0
		Else
			If m.pnL < 0.5
				m.pnS = (m.lnMax - m.lnMin) / (m.lnMax + m.lnMin)
			Else
				m.pnS = (m.lnMax - m.lnMin) / ( 2 - m.lnMax - m.lnMin )
			Endif

			*!*	If R=maxcolor, H = (G-B)/(maxcolor-mincolor)
			*!*	If G=maxcolor, H = 2.0 + (B-R)/(maxcolor-mincolor)
			*!*	If B=maxcolor, H = 4.0 + (R-G)/(maxcolor-mincolor)

			Do Case
				Case m.lnR = m.lnMax
					m.pnH = (m.lnG - m.lnB) / (m.lnMax - m.lnMin)
				Case m.lnG = m.lnMax
					m.pnH = 2 + (m.lnB - m.lnR) / (m.lnMax - m.lnMin)
				Case m.lnB = m.lnMax
					m.pnH = 4 + (m.lnR - m.lnG) / (m.lnMax - m.lnMin)
			Endcase

			If ( m.pnH < 0 )
				m.pnH = m.pnH + 6
			Endif

		Endif

		m.pnH = m.pnH * 60
		m.pnS = m.pnS * 100
		m.pnL = m.pnL * 100

		This._Hue = Round(m.pnH, 0)
		This._Sat = Round(m.pnS, 0)
		This._Lum = Round(m.pnL, 0)

		Return
	ENDPROC


	PROCEDURE hsl
		*!* Hsl()
		*!* Returns an RGB integer from a set of HSL values

		Lparameters pnH, pnS, pnL

		Local ;
			lnH, ;
			lnS, ;
			lnL, ;
			lnR, ;
			lnG, ;
			lnB, ;
			lnTemp2, ;
			lnTemp1, ;
			lnTemp3

		m.lnH = Mod(m.pnH, 360) / 360
		m.lnS = Min(Max(m.pnS, 0), 100) / 100
		m.lnL = Min(Max(m.pnL, 0), 100) / 100

		If  m.lnS  = 0
			m.lnR 	= Ceiling(m.lnL * 255)
			m.lnG 	= Ceiling(m.lnL * 255)
			m.lnB 	= Ceiling(m.lnL * 255)

		Else

			If m.lnL < 0.5 Then
				m.lnTemp2 = m.lnL * (1 + m.lnS)
			Else
				m.lnTemp2 = (m.lnL + m.lnS) - (m.lnS * m.lnL)
			Endif

			m.lnTemp1 = 2 * m.lnL - m.lnTemp2

			*!* Red
			m.lnTemp3 = m.lnH + 1/3

			If m.lnTemp3 < 0 Then
				m.lnTemp3 = m.lnTemp3 + 1
			Endif

			If m.lnTemp3 > 1 Then
				m.lnTemp3 = m.lnTemp3 - 1
			Endif

			Do Case

				Case 6 * m.lnTemp3 < 1
					m.lnR = m.lnTemp1 + (m.lnTemp2 - m.lnTemp1) * 6 * m.lnTemp3
				Case 2 * m.lnTemp3 < 1
					m.lnR = m.lnTemp2
				Case 3 * m.lnTemp3 < 2
					m.lnR = m.lnTemp1 + (m.lnTemp2 - m.lnTemp1) * ((2/3) - m.lnTemp3) * 6
				Otherwise
					m.lnR = m.lnTemp1
			Endcase

			*!* Green
			m.lnTemp3 = m.lnH

			If m.lnTemp3 < 0 Then
				m.lnTemp3 = m.lnTemp3 + 1
			Endif

			If m.lnTemp3 > 1 Then
				m.lnTemp3 = m.lnTemp3 - 1
			Endif

			Do Case

				Case 6 * m.lnTemp3 < 1
					m.lnG = m.lnTemp1 + (m.lnTemp2 - m.lnTemp1) * 6 * m.lnTemp3
				Case 2 * m.lnTemp3 < 1
					m.lnG = m.lnTemp2
				Case 3 * m.lnTemp3 < 2
					m.lnG = m.lnTemp1 + (m.lnTemp2 - m.lnTemp1) * ((2/3) - m.lnTemp3) * 6
				Otherwise
					m.lnG = m.lnTemp1
			Endcase

			*!* Blue
			m.lnTemp3 = m.lnH - 1/3

			If m.lnTemp3 < 0 Then
				m.lnTemp3 = m.lnTemp3 + 1
			Endif

			If m.lnTemp3 > 1 Then
				m.lnTemp3 = m.lnTemp3 - 1
			Endif

			Do Case

				Case 6 * m.lnTemp3 < 1
					m.lnB = m.lnTemp1 + (m.lnTemp2 - m.lnTemp1) * 6 * m.lnTemp3
				Case 2 * m.lnTemp3 < 1
					m.lnB = m.lnTemp2
				Case 3 * m.lnTemp3 < 2
					m.lnB = m.lnTemp1 + (m.lnTemp2 - m.lnTemp1) * ((2/3) - m.lnTemp3) * 6
				Otherwise
					m.lnB = m.lnTemp1
			Endcase

			m.lnR 	= Round(255 * m.lnR, 0)
			m.lnG 	= Round(255 * m.lnG, 0)
			m.lnB 	= Round(255 * m.lnB, 0)

		Endif

		m.lnR = Min(Max(m.lnR, 0), 255)
		m.lnG = Min(Max(m.lnG, 0), 255)
		m.lnB = Min(Max(m.lnB, 0), 255)

		Return Rgb(m.lnR, m.lnG, m.lnB)
	ENDPROC


	PROCEDURE getsafe
		*!* GetSafe(nRgbColor)

		Lparameters pnRgb

		Local ;
			lnR, ;
			lnG, ;
			lnB

		m.lnR = This.GetRed(m.pnRgb)
		m.lnG = This.GetGreen(m.pnRgb)
		m.lnB = This.GetBlue(m.pnRgb)

		m.lnR = Round(m.lnR / 0x33, 0) * 0x33
		m.lnG = Round(m.lnG / 0x33, 0) * 0x33
		m.lnB = Round(m.lnB / 0x33, 0) * 0x33

		Return Rgb(m.lnR, m.lnG, m.lnB)
	ENDPROC


	PROCEDURE Init
		*!* Init
	ENDPROC


ENDDEFINE
*
*-- EndDefine: _color
**************************************************