Here some procedures to convert between the colormodels named in the title.
Sense of those: e.g. decrease the saturation of a color by one parameter, which is hard to do in rgb directly.
3 examples are contained.
For HSV, HSL see:
http://en.wikipedia.org/wiki/HSV_color_space
http://en.wikipedia.org/wiki/HLS_color_space
Code: Select all
;- Color v1.1
;-
;- Procedures for handling colors not only in RGB, but also CMY, HSV and HSL (sometimes called HLS oder HSI)
;- Especially the last both let you modify the saturation and hue much more intuitively
;- See Wikipedia for more information on HSV and HSL
;-
;- The procedures contains all conversions between those color-types. The internal RGB-format
;- uses values in range [0.0, 1.0], so scale them manually to [0, 255] or use ColorRGB() for their usage in PB.
;-
;- Feel free to use this code for anything you want but without infringing its copyright.
;- (don't describe as it's author, don't sell itself - so just stay as nice as you are :)
;-
;- 19.09.06 by Froggerprogger
;-
;- v1.1:
;- - added example 3
;-
;- please report any bugs, etc. to Froggerprogger in the Purebasic-Forums
Enumeration
; do not change their order!
#COLOR_RGB
#COLOR_CMY
#COLOR_HSV
#COLOR_HSL
EndEnumeration
Structure Color
StructureUnion
r.f ; Red in RGB [0.0, 1.0]
c.f ; Cyan in CMY [0.0, 1.0]
h.f ; Hue in HSV/HSL [0.0, 360.0[
EndStructureUnion
StructureUnion
g.f ; Green in RGB [0.0, 1.0]
m.f ; Magenta in CMY [0.0, 1.0]
s.f ; Saturation in HSV/HSL [0.0, 1.0]
EndStructureUnion
StructureUnion
b.f ; Blue in RGB [0.0, 1.0]
y.f ; Yellow in CMY [0.0, 1.0]
v.f ; Value in HSV [0.0, 1.0]
l.f ; Lightness in HSL [0.0, 1.0]
EndStructureUnion
type.l ; gives the type. One of #COLOR_RGB, #COLOR_CMY, #COLOR_HSV, #COLOR_HSL
EndStructure
;- some neccessary declares
DeclareDLL.l Color2RGB(*c.Color)
DeclareDLL.l Color2CMY(*c.Color)
DeclareDLL.l Color2HSV(*c.Color)
DeclareDLL.l Color2HSL(*c.Color)
;- some helper-proceudures
Procedure.f Max3F(a.f, b.f, c.f)
If a > b
If a > c
ProcedureReturn a
Else
ProcedureReturn c
EndIf
Else
If b > c
ProcedureReturn b
Else
ProcedureReturn c
EndIf
EndIf
EndProcedure
Procedure.f Min3F(a.f, b.f, c.f)
If a < b
If a < c
ProcedureReturn a
Else
ProcedureReturn c
EndIf
Else
If b < c
ProcedureReturn b
Else
ProcedureReturn c
EndIf
EndIf
EndProcedure
;- some global color-procedures
ProcedureDLL.l IsColorValid(*c.Color) ; returns #True or #False whether *c specifies a valid color or not
If *c\type < #COLOR_RGB Or *c\type > #COLOR_HSL
ProcedureReturn #False
EndIf
; check r, c in [0.0, 1.0] or h in [0.0, 360.0]
If *c\type <= #COLOR_CMY
If *c\r < 0 Or *c\r > 1.0
ProcedureReturn #False
EndIf
Else
If *c\h < 0 Or *c\h >= 360.0
ProcedureReturn #False
EndIf
EndIf
; check g, m, s, b, y, v, l in [0.0, 1.0]
If *c\g < 0 Or *c\g > 1.0
ProcedureReturn #False
EndIf
If *c\b < 0 Or *c\b > 1.0
ProcedureReturn #False
EndIf
ProcedureReturn #True
EndProcedure
ProcedureDLL.l ColorCopy(*c.Color) ; copies *c and returns *copy
Protected *out = AllocateMemory(SizeOf(Color))
CopyMemory(*c, *out, SizeOf(Color))
ProcedureReturn *out
EndProcedure
ProcedureDLL.l ColorComplement(*c.Color) ; complements *c and returns *c
If *c\type <= #COLOR_CMY
; if #COLOR_RGB or #COLOR_CMY
*c\r = 1.0 - *c\r
*c\g = 1.0 - *c\g
*c\b = 1.0 - *c\b
Else
; if #COLOR_HSV or #COLOR_HSL
If *c\h >= 180.0
*c\h - 180.0
Else
*c\h + 180.0
EndIf
EndIf
EndProcedure
ProcedureDLL.l ColorChangeType(*c.Color, type.l) ; changes the type of *c to the new type and returns *c. type = #COLOR_*
Select type
Case #COLOR_RGB : Color2RGB(*c)
Case #COLOR_CMY : Color2CMY(*c)
Case #COLOR_HSV : Color2HSV(*c)
Case #COLOR_HSL : Color2HSL(*c)
EndSelect
EndProcedure
ProcedureDLL.l IsSameColors(*c1.Color, *c2.Color, tolerance.f) ; compares the two colors (of any type) without modifiing them and returns #True if they describe the same color equal, #False otherwise
Protected same.l
; compare in RGB to easy treat special cases in HSL, HSV
*c1c.Color = ColorCopy(*c1)
*c2c.Color = ColorCopy(*c2)
Color2RGB(*c1c)
Color2RGB(*c2c)
If tolerance = 0
same = CompareMemory(*c1c, *c2c, SizeOf(Color))
Else
same = #True
If Abs(*c1c\r - *c2c\r) > tolerance
same = #False
EndIf
If Abs(*c1c\g - *c2c\g) > tolerance
same = #False
EndIf
If Abs(*c1c\b - *c2c\b) > tolerance
same = #False
EndIf
EndIf
FreeMemory(*c1c)
FreeMemory(*c2c)
ProcedureReturn same
EndProcedure
ProcedureDLL.s ColorToStr(*c.Color)
Protected s.s
Select *c\type
Case #COLOR_RGB : s = "RGB"
Case #COLOR_CMY : s = "CMY"
Case #COLOR_HSV : s = "HSV"
Case #COLOR_HSL : s = "HSL"
EndSelect
s + ": " + StrF(*c\r, 2) + ", " + StrF(*c\g, 2) + ", " + StrF(*c\b, 2)
ProcedureReturn s
EndProcedure
;- change color to RGB
ProcedureDLL.l CMY2RGB(*c.Color) ; converts CMY-color *c to RGB and returns *c. No check if CMY is made!
*c\r = 1.0 - *c\c
*c\g = 1.0 - *c\m
*c\b = 1.0 - *c\y
*c\type = #COLOR_RGB
ProcedureReturn *c
EndProcedure
ProcedureDLL.l HSV2RGB(*c.Color) ; converts HSV-color *c to RGB and returns *c. No check if HSV is made!
Protected h.f, s.f, v.f
Protected f.f, p.f, q.f, t.f, i.l
h = *c\h
s = *c\s
v = *c\v
If s = 0
; it's a gray-tone
*c\r = v
*c\g = v
*c\b = v
Else
h / 60.0
i = Round(h, 0)
f = h-i
p = v*(1.0-s)
q = v*(1.0-s*f)
t = v*(1.0-s*(1.0-f))
Select i
Case 0 : *c\r = v : *c\g = t : *c\b = p
Case 1 : *c\r = q : *c\g = v : *c\b = p
Case 2 : *c\r = p : *c\g = v : *c\b = t
Case 3 : *c\r = p : *c\g = q : *c\b = v
Case 4 : *c\r = t : *c\g = p : *c\b = v
Case 5 : *c\r = v : *c\g = p : *c\b = q
EndSelect
EndIf
*c\type = #COLOR_RGB
ProcedureReturn *c
EndProcedure
Procedure.f HSL2RGBHelper(q1.f, q2.f, h.f)
If h >= 360.0
h - 360.0
ElseIf h < 0.0
h + 360.0
EndIf
If h < 60.0
ProcedureReturn q1+(q2-q1)*h/60.0
ElseIf h < 180.0
ProcedureReturn q2
ElseIf h < 240.0
ProcedureReturn q1+(q2-q1)*(240.0-h)/60.0
Else
ProcedureReturn q1
EndIf
EndProcedure
ProcedureDLL.l HSL2RGB(*c.Color) ; converts HSL-color *c to RGB and returns *c. No check if HSL is made!
Protected h.f, l.f, s.f
Protected f.f, p1.f, p2.f, t.f
Protected i.l
h = *c\h
l = *c\l
s = *c\s
If l<=0.5
p2 = l*(1.0+s)
Else
p2 = l+s-l*s
EndIf
p1 = 2.0*l-p2
If s=0.0
; it's a gray-tone
*c\r = l
*c\g = l
*c\b = l
Else
*c\r = HSL2RGBHelper(p1, p2, h+120.0)
*c\g = HSL2RGBHelper(p1, p2, h)
*c\b = HSL2RGBHelper(p1, p2, h-120.0)
EndIf
*c\type = #COLOR_RGB
ProcedureReturn *c
EndProcedure
ProcedureDLL.l Color2RGB(*c.Color) ; converts *c from any color-type to RGB and returns *c
Select *c\type
Case #COLOR_RGB : ProcedureReturn *c
Case #COLOR_CMY : ProcedureReturn CMY2RGB(*c)
Case #COLOR_HSV : ProcedureReturn HSV2RGB(*c)
Case #COLOR_HSL : ProcedureReturn HSL2RGB(*c)
EndSelect
EndProcedure
ProcedureDLL.l ColorSetRGB(*c.Color, r.f, g.f, b.f) ; sets *c to the RGB-color given by r,g,b, each in range [0.0, 1.0] (no check is made) and returns *c
*c\r = r
*c\g = g
*c\b = b
*c\type = #COLOR_RGB
ProcedureReturn *c
EndProcedure
;- change color to CMY
ProcedureDLL.l RGB2CMY(*c.Color) ; converts RGB-color *c to CMY and returns *c. No check if RGB is made!
*c\c = 1.0 - *c\r
*c\m = 1.0 - *c\g
*c\y = 1.0 - *c\b
*c\type = #COLOR_CMY
ProcedureReturn *c
EndProcedure
ProcedureDLL.l HSV2CMY(*c.Color) ; converts HSV-color *c to CMY and returns *c. No check if HSV is made!
; complement
If *c\h >= 180.0
*c\h - 180.0
Else
*c\h + 180.0
EndIf
HSV2RGB(*c) ; HSV2RGB of complement
*c\type = #COLOR_CMY
ProcedureReturn *c
EndProcedure
ProcedureDLL.l HSL2CMY(*c.Color) ; converts HSL-color *c to CMY and returns *c. No check if HSL is made!
; complement
If *c\h >= 180.0
*c\h - 180.0
Else
*c\h + 180.0
EndIf
HSL2RGB(*c) ; HSL2RGB of complement
*c\type = #COLOR_CMY
ProcedureReturn *c
EndProcedure
ProcedureDLL.l Color2CMY(*c.Color) ; converts *c from any color-type to CMY and returns *c
Select *c\type
Case #COLOR_RGB : ProcedureReturn RGB2CMY(*c)
Case #COLOR_CMY : ProcedureReturn *c
Case #COLOR_HSV : ProcedureReturn HSV2CMY(*c)
Case #COLOR_HSL : ProcedureReturn HSL2CMY(*c)
EndSelect
EndProcedure
ProcedureDLL.l ColorSetCMY(*c.Color, c.f, m.f, y.f) ; sets *c to the CMY-color given by c,m,y, each in range [0.0, 1.0] (no check is made) and returns *c
*c\c = c
*c\m = m
*c\y = y
*c\type = #COLOR_CMY
ProcedureReturn *c
EndProcedure
;- change color to HSV
ProcedureDLL.l RGB2HSV(*c.Color) ; converts RGB-color *c to HSV and returns *c. No check if RGB is made!
Protected r.f, g.f, b.f, max.f, min.f, delta.f
r = *c\r
g = *c\g
b = *c\b
max = Max3F(r,g,b)
min = Min3F(r,g,b)
; get value
*c\v = max
If max <> 0.0
delta = max - min
; get saturation
*c\s = delta/max
; get hue
If delta <> 0.0
If r = max
*c\h = (g-b)/delta
ElseIf g = max
*c\h = 2.0 + (b-r)/delta
ElseIf b = max
*c\h = 4.0 + (r-g)/delta
EndIf
*c\h * 60.0
If *c\h<0.0
*c\h + 360.0
EndIf
Else
; it's a gray-tone
*c\h = 0 ; *c\h is even undefined
EndIf
Else
; it's black
*c\s = 0
*c\h = 0 ; *c\h is even undefined
EndIf
*c\type = #COLOR_HSV
ProcedureReturn *c
EndProcedure
ProcedureDLL.l CMY2HSV(*c.Color) ; converts CMY-color *c to HSV and returns *c. No check if CMY is made!
; treat as RGB-color
RGB2HSV(*c)
; complement
If *c\h >= 180.0
*c\h - 180.0
Else
*c\h + 180.0
EndIf
ProcedureReturn *c
EndProcedure
ProcedureDLL.l HSL2HSV(*c.Color) ; converts HSL-color *c to HSV and returns *c. No check if HSL is made!
ProcedureReturn RGB2HSV(HSL2RGB(*c)) ; it's the easiest, though not fastet way
EndProcedure
ProcedureDLL.l Color2HSV(*c.Color) ; converts *c from any color-type to HSV And returns *c
Select *c\type
Case #COLOR_RGB : ProcedureReturn RGB2HSV(*c)
Case #COLOR_CMY : ProcedureReturn CMY2HSV(*c)
Case #COLOR_HSV : ProcedureReturn *c
Case #COLOR_HSL : ProcedureReturn HSL2HSV(*c)
EndSelect
EndProcedure
ProcedureDLL.l ColorSetHSV(*c.Color, h.f, s.f, v.f) ; sets *c to the HSV-color given by h in range [0.0, 360.0] and s,v in range [0.0, 1.0] (no check is made) and returns *c
If h = 360.0
h = 0
EndIf
*c\h = h
*c\s = s
*c\v = v
*c\type = #COLOR_HSV
ProcedureReturn *c
EndProcedure
;- change color to HSL
ProcedureDLL.l RGB2HSL(*c.Color) ; converts RGB-color *c to HSL and returns *c. No check if RGB is made!
Protected r.f, g.f, b.f, max.f, min.f, delta.f
r = *c\r
g = *c\g
b = *c\b
max = Max3F(r,g,b)
min = Min3F(r,g,b)
delta = max - min
If delta <> 0.0
; get lightness
*c\l = (max + min) / 2.0
; get saturation
If *c\l <= 0.5
*c\s = delta/(max+min)
Else
*c\s = delta/(2-max-min)
EndIf
; get hue
If r = max
*c\h = (g-b)/delta
ElseIf g = max
*c\h = 2.0 + (b-r)/delta
ElseIf b = max
*c\h = 4.0 + (r-g)/delta
EndIf
*c\h * 60.0
If *c\h<0.0
*c\h + 360.0
EndIf
Else
; it's black
*c\s = 0
*c\h = 0 ; *c\h is even undefined
EndIf
*c\type = #COLOR_HSL
ProcedureReturn *c
EndProcedure
ProcedureDLL.l CMY2HSL(*c.Color) ; converts CMY-color *c to HSL and returns *c. No check if CMY is made!
; treat as RGB-color
RGB2HSL(*c)
; complement
If *c\h >= 180.0
*c\h - 180.0
Else
*c\h + 180.0
EndIf
ProcedureReturn *c
EndProcedure
ProcedureDLL.l HSV2HSL(*c.Color) ; converts HSV-color *c to HSL and returns *c. No check if HSV is made!
ProcedureReturn RGB2HSL(HSV2RGB(*c)) ; it's the easiest, though not fastet way
EndProcedure
ProcedureDLL.l Color2HSL(*c.Color) ; converts *c from any color-type to HSL and returns *c
Select *c\type
Case #COLOR_RGB : ProcedureReturn RGB2HSL(*c)
Case #COLOR_CMY : ProcedureReturn CMY2HSL(*c)
Case #COLOR_HSV : ProcedureReturn HSV2HSL(*c)
Case #COLOR_HSL : ProcedureReturn *c
EndSelect
EndProcedure
ProcedureDLL.l ColorSetHSL(*c.Color, h.f, l.f, s.f) ; sets *c to the HSL-color given by h in range [0.0, 360.0[ and l,s in range [0.0, 1.0] (no check is made) and returns *c
*c\h = h
*c\l = l
*c\s = s
*c\type = #COLOR_HSL
ProcedureReturn *c
EndProcedure
;- change color to PureBasic's RGB
ProcedureDLL.l ColorRGBFast(*c.Color) ; converts *c to RGB and returns a Purebasic-RGB-colorcode same as returned by PB's RGB()
Color2RGB(*c)
ProcedureReturn RGB(255 * *c\r, 255 * *c\g, 255 * *c\b)
EndProcedure
ProcedureDLL.l ColorRGB(*c.Color) ; converts an internal copy of *c to RGB and returns a Purebasic-RGB-colorcode same as returned by PB's RGB()
Protected *cc.Color, rgb.l
*cc = ColorCopy(*c)
Color2RGB(*cc)
rgb = RGB(255 * *cc\r, 255 * *cc\g, 255 * *cc\b)
FreeMemory(*cc)
ProcedureReturn rgb
EndProcedure
;-
;- debug test functionality
;-
Procedure.l DebugTestFunctionality()
; RGB <-> CMY
For i=0 To 10000
ColorSetRGB(c.Color, Random(100)/100.0, Random(100)/100.0, Random(100)/100.0)
*c2.Color = Color2RGB(Color2CMY(ColorCopy(c)))
If IsSameColors(c, *c2, 0.1) = #False
Debug "ERROR RGB <-> CMY"
End
EndIf
FreeMemory(*c2)
Next
; RGB <-> HSV
For i=0 To 10000
ColorSetRGB(c.Color, Random(100)/100.0, Random(100)/100.0, Random(100)/100.0)
*c2.Color = Color2RGB(Color2HSV(ColorCopy(c)))
If IsSameColors(c, *c2, 0.1) = #False
Debug "ERROR RGB <-> HSV"
End
EndIf
FreeMemory(*c2)
Next
; RGB <-> HSL
For i=0 To 10000
ColorSetRGB(c.Color, Random(100)/100.0, Random(100)/100.0, Random(100)/100.0)
*c2.Color = Color2RGB(Color2HSL(ColorCopy(c)))
If IsSameColors(c, *c2, 0.1) = #False
Debug "ERROR RGB <-> HSL"
End
EndIf
FreeMemory(*c2)
Next
; CMY <-> HSV
For i=0 To 10000
ColorSetCMY(c.Color, Random(100)/100.0, Random(100)/100.0, Random(100)/100.0)
*c2.Color = Color2CMY(Color2HSV(ColorCopy(c)))
If IsSameColors(c, *c2, 0.1) = #False
Debug "ERROR CMY <-> HSV"
End
EndIf
FreeMemory(*c2)
Next
; CMY <-> HSL
For i=0 To 10000
ColorSetCMY(c.Color, Random(100)/100.0, Random(100)/100.0, Random(100)/100.0)
*c2.Color = Color2CMY(Color2HSL(ColorCopy(c)))
If IsSameColors(c, *c2, 0.1) = #False
Debug "ERROR CMY <-> HSL"
End
EndIf
FreeMemory(*c2)
Next
; HSV <-> HSL
For i=0 To 10000
ColorSetHSV(c.Color, Random(360)/100.0, Random(100)/100.0, Random(100)/100.0)
*c2.Color = Color2HSV(Color2HSL(ColorCopy(c)))
If IsSameColors(c, *c2, 0.1) = #False
Debug "ERROR HSV <-> HSL"
End
EndIf
FreeMemory(*c2)
Next
Debug "All Tests done."
EndProcedure
;Goto example3
;-
;- example 1
;-
example1:
ColorSetRGB(rgbCol.Color, 0.0, 0.0, 1.0) ; full blue
s.s = "Create blue, decrease its saturation towards gray and move it" + #CRLF$
s.s + "slightly towards green without changing it's intensity" + #CRLF$ + #CRLF$
s.s + "Original color: " + ColorToStr(rgbCol) + #CRLF$
; we dont' like this green, we want to make it a little bit darker and remove it's saturation
Color2HSL(rgbCol)
s.s + "Original color: " + ColorToStr(rgbCol) + #CRLF$
rgbCol\h - 30 ; be careful to stay in range [0, 360[. Here we know h is 240
rgbCol\s = 0.5
s.s + "Modified color: " + ColorToStr(rgbCol) + #CRLF$
Color2RGB(rgbCol)
s.s + "Modified color: " + ColorToStr(rgbCol) + #CRLF$
MessageRequester("Color example 1/3:", s)
MessageRequester("Color example 2/3:", "Click OK to run a HSL-demonstration in fullscreen.")
;-
;- example 2
;-
example2:
InitSprite()
InitKeyboard()
OpenScreen(1024, 768, 32, "Color-example")
framecounter = 0
fps = 0
lastFrametimer = 0
Repeat
; fps-calculation
framecounter+1
If ElapsedMilliseconds() - lastFrametimer > 1000
fps = framecounter
framecounter = 0
lastFrametimer = ElapsedMilliseconds()
EndIf
; draw the colorbars
ClearScreen(RGB(0, 0, 50))
StartDrawing(ScreenOutput())
FrontColor(RGB(255,255,255))
DrawingMode(1)
DrawText(10,10, "HSL-colors for 1.440.000 individual colored pixels at " + Str(fps) + " fps. Press ESC to exit.")
; create 1.440.000 combinations of hue, sat and lightness and display them
sat.f = 0.05
While sat <= 1.0
lig.f = 0
While lig <= 1.0
hue.f = 0
While hue < 360.0
; create a new hsl-colored pixel (you might fill your structure manually, too)
ColorSetHSL(HSLCol.Color, hue, sat, lig)
; draw it on the screen after converting to PB's RGB
Plot(152 + 2*hue, 180 + 20*lig + 400*sat, ColorRGBFast(HSLCol))
hue + 0.5
Wend
lig + 0.05
Wend
sat + 0.1
Wend
StopDrawing()
FlipBuffers()
Delay(10)
ExamineKeyboard()
Until KeyboardPushed(#PB_Key_Escape)
CloseScreen()
;-
;- example 3
;-
example3:
Procedure.l GetContrastedPBColor(red.l, green.l, blue.l)
Protected col.Color
ColorSetRGB(col.Color, red/255.0, green/255.0, blue/255.0)
Color2HSV(col)
ColorComplement(col) ; build the normal complement
; modify saturation and value
; you might experiment with those to achieve other results
col\s + 0.5
If col\s > 1.0
col\s - 1.0
EndIf
col\v + 0.5
If col\v > 1.0
col\v - 1.0
EndIf
Color2RGB(col)
ProcedureReturn RGB(col\r*255, col\g*255, col\b*255)
EndProcedure
CreateImage(0, 500, 500)
For i=0 To 9
Select i
Case 0 : col.l = $000000
Case 1 : col.l = $FFFFFF
Case 2 : col.l = $7F7F7F
Case 3 : col.l = $660000
Case 4 : col.l = $00FF00
Case 5 : col.l = $000033
Case 6 : col.l = $FF9900
Case 7 : col.l = $FF33FF
Case 8 : col.l = $3754A9
Case 9 : col.l = $9F3F20
EndSelect
contrCol = GetContrastedPBColor(Red(col), Green(col), Blue(col))
StartDrawing(ImageOutput(0))
Box(0, i*50, 500, 50, col)
DrawingMode(#PB_2DDrawing_Transparent)
DrawText(10, i*50 + 20, "This is just an example-text in a color contrasted to the background", contrCol)
StopDrawing()
Next
OpenWindow(0, 0, 0, 500, 500, "Color example 3/3:")
CreateGadgetList(WindowID(0))
ImageGadget(0, 0, 0, 500, 500, ImageID(0))
Repeat
Until WaitWindowEvent() = #PB_Event_CloseWindow
