i having 1 delphi xe2 project change label01 font color using timer04. have written following codes:
procedure tmainform.formcreate(sender: tobject); begin timer04.enabled := true; end; .. .. .. .. .. procedure tmainform.timer04timer(sender: tobject); var startcolor, redcolor, greencolor, bluecolor: integer; begin startcolor := colortorgb(label01.font.color); redcolor := getrvalue(startcolor); greencolor := getgvalue(startcolor); bluecolor := getbvalue(startcolor); if redcolor <= 251 inc(redcolor, 1) else redcolor := 1; if greencolor <= 252 inc(greencolor, 2) else greencolor := 2; if bluecolor <= 253 inc(bluecolor, 3) else bluecolor := 3; label01.font.color := rgb(redcolor, greencolor, bluecolor); end; this codes work perfectly. label01 font color changes between different colors.
now trying implement label02 color fixed (say green) , value of brightnees increase 0 100. if value reaches 100 decreased 0 , continuous loop.
for case have chosen hue=135, saturation=85 , brightness=50. value of brightness increased 50 100 , decreased 100 0 , continued. problem there no such function available convert hsb rgb , vice versa in delphi xe2. have gooled it. have found function hsbtorgb. delphi unit availabe. have read revoews , found every 1 having bugs.
here delphi translation of c code found here: http://www.cs.rit.edu/~ncs/color/t_convert.html
function rgbfp(r, g, b: double): tcolor; const rgbmax = 255; begin result := rgb(round(rgbmax * r), round(rgbmax * g), round(rgbmax * b)); end; function hsvtorgb(h, s, v: double): tcolor; var i: integer; f, p, q, t: double; begin assert(inrange(h, 0.0, 1.0)); assert(inrange(s, 0.0, 1.0)); assert(inrange(v, 0.0, 1.0)); if s = 0.0 begin // achromatic (grey) result := rgbfp(v, v, v); exit; end; h := h * 6.0; // sector 0 5 := floor(h); f := h - i; // fractional part of h p := v * (1.0 - s); q := v * (1.0 - s * f); t := v * (1.0 - s * (1.0 - f)); case of 0: result := rgbfp(v, t, p); 1: result := rgbfp(q, v, p); 2: result := rgbfp(p, v, t); 3: result := rgbfp(p, q, v); 4: result := rgbfp(t, p, v); else result := rgbfp(v, p, q); end; end; i've given minimal testing. please feel free double check it.
Comments
Post a Comment