Farbunterschied erkennen/berechnen

[KHR]

Hallo miteinander,

ich suche eine Routine, mit der sich berechnen läßt, ob zwei Farben für unser Auge genug von einander abweichen, sagen wir genug "Farbkontrast" haben um deutliche Abgrenzug zu ermöglichen.

Als Beispiel habe ich hier einen Democode in XProfan, der Rechtecke mit Zufallsfarben darstellt.

Meist weichen diese Farben kräftig von einander ab. Manchmal sind sie aber leider sehr verwandt.

Wie kann ich das im Programm-Ablauf erkennen, um z.B. die Zufallsfarbe neu berechnen zu lassen??

declare farbe&, size&

cls
randomize

size& = 210

while 1

   whileloop (size&/10/2)
   
      farbe& = @rgb(@rnd(256),@rnd(256),@rnd(256))
      
      usebrush 1,farbe&
      UsePen 5,0,farbe&
      rectangle   (&loop*10),(&loop*10) - (size&-(&loop*10)),(size&-(&loop*10))
      
   
      
   endwhile
   
   waitinput 400
   cls
   
endwhile

Ich hab diese Frage auch auf XProfan.com gestellt um vielleicht ein breiteres Spektrum an Möglichkeiten zu bekommen.

Achso: Wenn ein (noch)nicht Profaner das ausprobieren will: hier der Link zum Download der Freeversion (Interpreter) XProfan 10 http://xprofan.de/download/xprofanfree.exe

[Frabbing]

So was in der Art?

declare farbe&, size&, r&, g&, b&, diff&, mix&, lastmix&

cls
randomize

size& = 210

while 1

   whileloop (size&/10/2)
   
      while 1
      
        r&=Rnd(256)
        g&=Rnd(256)
        b&=Rnd(256)
        mix&=(r&+g&+b&)/3
      
        diff&=Abs(lastmix&-mix&)

        Case diff&<48:CONTINUE
        
        lastmix&=mix&
        BREAK
        
      endwhile
      
      farbe& = @rgb(r&,g&,b&)
      
      usebrush 1,farbe&
      UsePen 5,0,farbe&
      rectangle   (&loop*10),(&loop*10) - (size&-(&loop*10)),(size&-(&loop*10))
      
   
      
   endwhile
   
   waitinput 400
   cls
   
endwhile

Hier in der Zeile kannst du bestimmen, wie hoch der Differenzwert sein muss (geh aber nicht groß über 120, weil ansonsten Situationen auftreten können, dass die Differenz nicht erreicht werden kann. Verzögert auch die Ablaufdauer):

Case diff&<48:CONTINUE

Erklärung: Die Zufallsfarbe wird in schwarz-weiß umgerechnet und mit der vorherigen Farbe verglichen. Ist der Unterschied zu gering, wird eine neue Zufallsfarbe ermittelt.

[KHR]

Hallo Frank,


danke für die fixe Antwort.

Ja, das ist es was ich gesucht habe. So kann man die Kontrast wirklich feststellen und beinflussen.

[KHR]

Hallo miteinander, Hallo Frank,

hab zum ausprobieren mal in die Radler reingestrickt.

' Fahrräder
' by Karl-Heinz Rattay / 2009
'
' einfach ausprobieren
'
' Wems gefällt der kann ja einen screensaver draus machen!
'
' Dieses Modul ist einfach so wie es ist. Wems nicht gefällt, der kann umstricken!!
'
declare  r&, g&, b&, diff&, mix&, lastmix&

declare Zaehler&

proc zeichne

    parameters c&,hpos%,vpos%, size%
    usepen   0,(size%/5),c&
    useBrush 0,c&
    ellipse (hpos%-(Size%/1.5)),(vpos%-(Size%/1.5)) - (hpos%+(Size%/1.5)),(vpos%+(Size%/1.5))
    ellipse ((hpos%+size%*2.0)-(Size%/1.5)),(vpos%-(Size%/1.5)) - ((hpos%+size%*2.0)+(Size%/1.5)),(vpos%+(Size%/1.5))
    usepen   0,(size%/8),c&
    moveto hpos%,vpos%
    lineto (hpos%+(size%/6)),(vpos% - (Size%*1.05))
    lineto (hpos%+(size%*1.7))   , (vpos% - (Size%*0.95) + (size%/6))
    lineto (hpos%+(size%*1.1))  , vpos%
    moveto (hpos%+(size%/4)),(vpos% - (Size%*1.3))
    lineto (hpos%+(size%/6)),(vpos% - (Size%*1.3))
    lineto (hpos%+(size%/6)),(vpos% - (Size%*1))
    lineto (hpos%+(size%*1.1))  , vpos%
    lineto (hpos%+(size%*2))  , vpos%
    lineto (hpos%+(size%*1.7))   , (vpos% - (Size%*1) + (size%/6))
    lineto (hpos%+(size%*1.7))   , (vpos% - (Size%*1) -(size%/7))
    moveto (hpos%+(size%*1.7)-(size%/5))   , (vpos% - (Size%*1.1) -(size%/8))
    lineto (hpos%+(size%*1.7)+(size%/5))   , (vpos% - (Size%*1.1) -(size%/8))
    moveto (hpos%+(size%*1.1))  , (vpos%-(size%*0.3))
    lineto (hpos%+(size%*1.1))  , (vpos%+(size%*0.3))

Endproc

cls
showmax

while 1

   inc zaehler&

   if zaehler& > 80
       
      while 1
    
         r&    = Rnd(256)
         g&    = Rnd(256)
         b&    = Rnd(256)
         mix&  =(r&+g&+b&)/3
       
         diff& = Abs(lastmix&-mix&)
 
         Case diff&<40   :  CONTINUE
         
         lastmix& = mix&
         BREAK
         
         
      endwhile
      
      zeichne  @rgb(r&,g&,b&) , \
      ((%maxx*0.6) + @rnd(%maxx/4)) , \
      (100+@rnd(@rnd(%maxy*0.85))) ,  \
      (15+@rnd(40))
      zaehler& = 1

   endif

   copyBmp 1,0 - %maxx,%maxy > 0,0;0
   
   
   case @IsKey(27) : end '   ESC gedrückt
  

endwhile

Für (noch)nicht Profaner dies auprobieren wollen der Link zum Download der Freeversion (Interpreter) XProfan 10 http://xprofan.de/download/xprofanfree.exe

[iF_]

Ich glaube er meint eher sowas:

proc FARBAEHNLICHKEIT ' RGB-linearer (nicht wie unsere Augen!) Gleichheitsfaktor zu Schwarz

    PARAMETERS FARBE1&,FARBE2&
    RETURN (ABS(GETRVALUE(FARBE1&)-GETRVALUE(FARBE2&))+ABS(GETGVALUE(FARBE1&)-GETGVALUE(FARBE2&))+ABS(GETBVALUE(FARBE1&)-GETBVALUE(FARBE2&))) * 0.001307189542483660130718954248 ' = 1/(255*3)

endproc

Die Lösung von ganz oben, R+G+B zu addieren, ist leider farbenblind.

[Frabbing]

Die Lösung von ganz oben, R+G+B zu addieren, ist leider farbenblind.

Die Lösung basiert auf einer Mittlung. Ich hatte beschrieben, wie sie funktioniert.

[KHR]

Hallo miteinander,


so jetzt hab ich auch Davids Lösung in die Fahrräder reingebaut.

Also ich glaube einen Unterschied zu erkennen. Ihr auch?

' Fahrräder
' by Karl-Heinz Rattay / 2009
'
' einfach ausprobieren
'
' Wems gefällt der kann ja einen screensaver draus machen!
'
' Dieses Modul ist einfach so wie es ist. Wems nicht gefällt, der kann umstricken!!
'
declare  r&, g&, b&, diff&, mix&, lastmix&

declare Zaehler&

proc zeichne

    parameters c&,hpos%,vpos%, size%
    usepen   0,(size%/5),c&
    useBrush 0,c&
    ellipse (hpos%-(Size%/1.5)),(vpos%-(Size%/1.5)) - (hpos%+(Size%/1.5)),(vpos%+(Size%/1.5))
    ellipse ((hpos%+size%*2.0)-(Size%/1.5)),(vpos%-(Size%/1.5)) - ((hpos%+size%*2.0)+(Size%/1.5)),(vpos%+(Size%/1.5))
    usepen   0,(size%/8),c&
    moveto hpos%,vpos%
    lineto (hpos%+(size%/6)),(vpos% - (Size%*1.05))
    lineto (hpos%+(size%*1.7))   , (vpos% - (Size%*0.95) + (size%/6))
    lineto (hpos%+(size%*1.1))  , vpos%
    moveto (hpos%+(size%/4)),(vpos% - (Size%*1.3))
    lineto (hpos%+(size%/6)),(vpos% - (Size%*1.3))
    lineto (hpos%+(size%/6)),(vpos% - (Size%*1))
    lineto (hpos%+(size%*1.1))  , vpos%
    lineto (hpos%+(size%*2))  , vpos%
    lineto (hpos%+(size%*1.7))   , (vpos% - (Size%*1) + (size%/6))
    lineto (hpos%+(size%*1.7))   , (vpos% - (Size%*1) -(size%/7))
    moveto (hpos%+(size%*1.7)-(size%/5))   , (vpos% - (Size%*1.1) -(size%/8))
    lineto (hpos%+(size%*1.7)+(size%/5))   , (vpos% - (Size%*1.1) -(size%/8))
    moveto (hpos%+(size%*1.1))  , (vpos%-(size%*0.3))
    lineto (hpos%+(size%*1.1))  , (vpos%+(size%*0.3))

Endproc

proc FARBAEHNLICHKEIT

    PARAMETERS FARBE1&,FARBE2&
    RETURN (ABS(GETRVALUE(FARBE1&)-GETRVALUE(FARBE2&))+ABS(GETGVALUE(FARBE1&)-GETGVALUE(FARBE2&))+ABS(GETBVALUE(FARBE1&)-GETBVALUE(FARBE2&))) * 0.001307189542483660130718954248

endproc


cls
showmax

randomize

while 1

   inc zaehler&

   if zaehler& > 80
       
      while 1
    
      
        r&=Rnd(256)
        g&=Rnd(256)
        b&=Rnd(256)
        mix&=@rgb(r&,g&,b&)

        Case FARBAEHNLICHKEIT (lastmix&,mix&) :CONTINUE
        
        lastmix&=mix&
        BREAK
 
         
      endwhile
      
      zeichne  @rgb(r&,g&,b&) , \
      ((%maxx*0.6) + @rnd(%maxx/4)) , \
      (100+@rnd(@rnd(%maxy*0.85))) ,  \
      (15+@rnd(40))
      zaehler& = 1

   endif

   copyBmp 1,0 - %maxx,%maxy > 0,0;0
   
   
   case @IsKey(27) : end '   ESC gedrückt
  

endwhile

[Frabbing]

Davids Lösung basiert auf einer Fliesskommazahl von 0 bis 1. Du kannst die Lösungen so nicht kombinieren.

[iF_]

Er müsste die Zeile

Case FARBAEHNLICHKEIT (lastmix&,mix&) :continue

ersetzen in

Case FARBAEHNLICHKEIT(lastmix&,mix&)<0.37 :continue

was dann ganz hübsch wirkt.