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