delphi - How to convert HSB to RGB -


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