Seite 1 von 1

Farbcodierungen: RGB, CMY, HLS, HSL (HLS, HSI)

Verfasst: 19.09.2006 16:08
von Froggerprogger
Ahoi!
Hier einige hilfreiche Prozeduren, um zwischen den im Titel erwähnten Farbmodellen hin- und herzurechnen.
Sinn davon: z.B: mit einem einzigen Parameter die Sättigung zu verringern. Sowas geht direkt in RGB nur schwer.

Dazu 3 Beispiele.

Zu den Farbräumen HSV, HSL:
http://de.wikipedia.org/wiki/HSV-Farbraum
http://en.wikipedia.org/wiki/HLS_color_space

Update: 3. Beispiel hinzugefügt (ursprünglich nur 2)

Code: Alles auswählen

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

Verfasst: 20.09.2006 14:16
von Kekskiller
Kanns grad nicht ausprobieren, klingt aber sehr nützlich.
Werds mir heute abend reinziehen und ev. in mein Projekt einbauen :allright: