Hi, I'm looking for an algorithm (or algorithms) that represents gradient color values. Something along the lines of

function ColorGradient(StartColor, EndColor: TColor; Min, Max: double; Value: double): TColor;

for example:

for i := 1 to 5 do
ColorToPlot := ColorGradient(clGreen, clRed, 1, 5, i);

Would give 5 colors equally spaced between green and red (to represent severity or something).
Who is Participating?

x
I wear a lot of hats...

"The solutions and answers provided on Experts Exchange have been extremely helpful to me over the last few years. I wear a lot of hats - Developer, Database Administrator, Help Desk, etc., so I know a lot of things but not a lot about one thing. Experts Exchange gives me answers from people who do know a lot about one thing, in a easy to use platform." -Todd S.

Here is what I believe your asking for. Couple of things though; you could probably just drop the Min and use max and value, or add some logic to make sure that Value is >= Min and <= Max. Also, some color transitions (ie Green to red) will return colors that look almost black, but this it to be expected due to the transition between the two. I have tested this against code that I use for gradient drawing (using msimg32.dll) and the results are inline with each other.

Hope this helps,
Russell

function ColorGradient(StartColor, EndColor: TColor; Min, Max: Double; Value: Double): TColor;
var  dwLength:   Integer;
dwIndex:    Integer;
dfL:        Double;
c1:         COLORREF;
c2:         COLORREF;
begin

// Convert to RGB
c1:=ColorToRGB(StartColor);
c2:=ColorToRGB(EndColor);

// Calculate the color modifier
dfL:=((Value-Min) / Max);

result:=RGB(Trunc(dfL * GetRValue(c2) + (1.0 - dfL) * GetRValue(c1)),
Trunc(dfL * GetGValue(c2) + (1.0 - dfL) * GetGValue(c1)),
Trunc(dfL * GetBValue(c2) + (1.0 - dfL) * GetBValue(c1)));

end;

0

Experts Exchange Solution brought to you by

Facing a tech roadblock? Get the help and guidance you need from experienced professionals who care. Ask your question anytime, anywhere, with no hassle.

Senior developer, analyst and customer assistance Commented:
very similar to the rllibbly one, just a little more clean.... :))

function ColorGradient(StartColor, EndColor: TColor; Steps,WichStep: integer): Tcolor;
var
Deltas: array [0..2] of Real; //R,G,B
begin
Deltas[0] := (GetRValue(EndColor) - GetRValue(StartColor)) / Steps;
Deltas[1] := (GetGValue(EndColor) - GetGValue(StartColor)) / Steps;
Deltas[2] := (GetBValue(EndColor) - GetBValue(StartColor)) / Steps;
result := RGB(Round(GetRValue(StartColor) + WichStep * Deltas[0]),
Round(GetGValue(StartColor) + WichStep * Deltas[1]),
Round(GetBValue(StartColor) + WichStep * Deltas[2]));

end;

for i := 1 to 5 do

0

just a little more clean.... :))  ??

Well, you might want to add ColorToRgb() in your equation then, otherwise if any of the following are used:

clScrollBar
clBackground
clActiveCaption
clInactiveCaption
clWindow
clWindowFrame
clWindowText
clCaptionText
clActiveBorder
clInactiveBorder
clAppWorkSpace
clHighlight
clHighlightText
clBtnFace
clGrayText
clBtnText
clInactiveCaptionText
clBtnHighlight
cl3DLight
clInfoText
clInfoBk

They will come out as black. ;-)

Kindest Regards,
Russell

0
Senior developer, analyst and customer assistance Commented:
yeah Russell you're absolutelly right!

I missed the ColorToRGB....

function ColorGradient(StartColor, EndColor: TColor; Steps,WichStep: integer): Tcolor;
var
Deltas: array [0..2] of Real; //R,G,B
begin
StartColor := ColorToRGB(STartColor);
EndColor := COlorToRGB(ENdColor);
Deltas[0] := (GetRValue(EndColor) - GetRValue(StartColor)) / Steps;
Deltas[1] := (GetGValue(EndColor) - GetGValue(StartColor)) / Steps;
Deltas[2] := (GetBValue(EndColor) - GetBValue(StartColor)) / Steps;
result := RGB(Round(GetRValue(StartColor) + WichStep * Deltas[0]),
Round(GetGValue(StartColor) + WichStep * Deltas[1]),
Round(GetBValue(StartColor) + WichStep * Deltas[2]));

end;

BTW with 'clean' i mean just about code understanding...Don't worry....points must be yours :))

F68 ;-)
0
Author Commented:
Excellent guys, the first one suits me better, but they are both perfect. No fighting: you both get points.
0

Only a little early morning humor, no fighting ;-)

Thanks for the points,
Russell
0
Author Commented:
Yeah forgot the smilie :) Early morning? I'm off home for my tea... Been a long day! :)
0
Commented:
Oh man, where were u 2 years ago when i asked the same question, if i can find the post i made asking someone how to do that, i will post it, either of u can have the points for it because this is what i need, here's the damn routine i put together to do this thing....

Var
Col,Col2: Tcolor;
ScreenState,FF1,FF2,FF3: Boolean;
Str1,Str2,MyC,MyC2: String;
BuildStr,TmpCol,TmpCol2,Tmp,Tmp2: String;
IncR, IncG, IncB: Integer;
N: Integer;
BlendCount,Rcmp,GCmp,BCmp,RS,GS,BS,RF,GF,BF,P1,P2: Integer;
ColDif,ColCount,CharCount,NewR,NewB,NewG: Integer;
Begin
BuildStr:='';
N:=0;
NewR:=0; NewB:=0; NewG:=0; RS:=0; GS:=0; BS:=0;
RF:=0; GF:=0; BF:=0; P1:=0; P2:=0; IncR:=0; IncG:=0; IncB:=0;
CharCount:=Length(Msg);
ColCount:=ColourCount(Colours);
If ColCount=1 Then
Colours:=Colours+','+Colours;
If Colcount=1 Then inc(ColCount);
BlendCount:=Trunc(CharCount div (ColCount-1));
ColDif:=ColCount*BlendCount;
Tmp2:=Msg;
Tmp:=Colours+',';
While (Pos(',',Tmp)>0) do
Begin
NewR:=0; NewB:=0; NewG:=0; RS:=0; GS:=0; BS:=0;
RF:=0; GF:=0; BF:=0; P1:=0; P2:=0;
P1:=Pos(',',Tmp);
TmpCol:=Copy(Tmp,1,p1-1);
Delete(Tmp,1,P1); //TmpCol = First ColorString (e=g #FF0000)
P1:=Pos(',',Tmp);
N:=0;
TmpCol2:=Copy(Tmp,1,p1-1);
Result:=BuildStr;
If TmpCol2='' Then Exit;
//    Delete(Tmp,1,P1);  //TmpCol2 = Second ColorString (eg #00FF00)
If ConvertToRGB(TmpCol)=True Then
Begin
RF:=R;
GF:=G;
BF:=B;
End;
If ConvertToRGB(TmpCol2)=True Then
Begin
RS:=R;
GS:=G;
BS:=B;
End;
If Msg<>'' Then
Begin
//
Repeat
Inc(N);
FF1:=False;
FF2:=False;
FF3:=False;
if n=2 then
begin
RCmp:=RF-Rs;
GCmp:=GF-GS;
BCmp:=BF-BS;
if RCmp <=0 then
begin
RCmp:=-RCmp;
IncR:=Trunc((RCmp/BlendCount));
end
else
IncR:=Trunc((RCmp/(BlendCount)));
if GCmp <=0 then
begin
GCmp:= -GCmp;
IncG:=Trunc((GCmp/BlendCount));
end
else
IncG:=Trunc((GCmp/(BlendCount)));
if BCmp <=0 then
begin
BCmp:= -1*(BCmp);
IncB:=Trunc((BCmp/BlendCount));
end
else
IncB:=Trunc(BCmp/(BlendCount));
end;
RCmp:=RF-Rs;
IF Rcmp>=0 Then
NewR:=RF-Trunc(IncR)
//NewR:=RF-(RCmp div ColCount)
else
begin
NewR:=RF+Trunc(IncR);
//NewR:=RF+((-1*RCmp) div (ColCount));
//if NewR<=0 then
// NewR:=-1*NewR;
end;
GCmp:=GF-GS;
IF Gcmp>=0 Then
NewG:= GF-Trunc(IncG)
//NewG:=GF-(GCmp div (Blendcount))
else
begin
NewG:=GF+Trunc(IncG);
//NewG:=GF+((-1*GCmp) div (BlendCount));
//if NewG<=0 then
//  NewG:=-1*NewG;
end;
BCmp:=BF-Bs;
IF Bcmp>=0 Then
NewB:=BF-Trunc(IncB)
//NewB:=BF-(BCmp div (Blendcount))
else
begin
NewB:=BF+Trunc(IncB);
//NewB:=BF+((-1*BCmp) div (BlendCount));
//if NewB<=0 then
//NewB:=-1*NewB;
end;
If N<=Length(Msg) Then
Begin
BuildStr:=BuildStr+';'+'\red'+IntToStr(NewR)+'\green'+IntToStr(NewG)+'\blue'+IntToStr(NewB)+'';
//              Richedit1.Lines.Add('R: '+IntToStr(NewR)+' G: '+IntToStr(NewG)+' b: '+IntToStr(NewB));
End;
RF:=NewR;
GF:=NewG;
BF:=NewB;

Until N>BlendCount-1;
Delete(Msg,1,1);

R:=NewR;
G:=NewG;
B:=NewB;
{    If N>=BlendCount Then
Begin
BuildStr:=BuildStr+';'+'\red'+IntToStr(NewR)+'\green'+IntToStr(NewG)+'\blue'+IntToStr(NewB)+'';
Richedit1.Lines.Add('R: '+IntToStr(NewR)+' G: '+IntToStr(NewG)+' b: '+IntToStr(NewB));
End;}
IncR:=0;
IncB:=0;
IncG:=0;
RCmp:=0;
GCmp:=0;
BCmp:=0;
End;
End;
End;

You know how much faster and easier this is now going to be, i can do a quick conversion from  B G R the way Delphi does it to R G B and TADA!!

oh man.... thank you....

Just look in my questions asked section, when i get back home i will look myself, providing the bullies @ EE never forced me to give points to someone who did not deserve them, i will gladly give them you....
0
Commented:
http://www.experts-exchange.com/Programming/Programming_Languages/Delphi/Q_20563756.html

Just make copy and paste the code into it and i can finally end it and award someone the points, suits both me and EE that way.
0
Author Commented:
Actually the following change is required for correct functioning:
dfL:=((Value-Min) / Max);
to
dfL:=((Value-Min) / (Max - Min));
0
Commented:
Ok you got me, where do i put that?

RCmp:=RF-Rs;
GCmp:=GF-GS;
BCmp:=BF-BS;
if RCmp <=0 then
begin
RCmp:=-RCmp;
IncR:=Trunc((RCmp/BlendCount));
end
else
IncR:=Trunc((RCmp/(BlendCount)));
if GCmp <=0 then
begin
GCmp:= -GCmp;
IncG:=Trunc((GCmp/BlendCount));
end
else
IncG:=Trunc((GCmp/(BlendCount)));
if BCmp <=0 then
begin
BCmp:= -1*(BCmp);
IncB:=Trunc((BCmp/BlendCount));
end
else
IncB:=Trunc(BCmp/(BlendCount));
end;
RCmp:=RF-Rs;
IF Rcmp>=0 Then
NewR:=RF-Trunc(IncR)
else
begin
NewR:=RF+Trunc(IncR);
end;
GCmp:=GF-GS;
IF Gcmp>=0 Then
NewG:= GF-Trunc(IncG)
else
NewG:=GF+Trunc(IncG);
BCmp:=BF-Bs;
IF Bcmp>=0 Then
NewB:=BF-Trunc(IncB)
else
NewB:=BF+Trunc(IncB);

If N<=Length(Msg) Then
BuildStr:=BuildStr+';'+'\red'+IntToStr(NewR)+'\green'+IntToStr(NewG)+'\blue'+IntToStr(NewB)+'';

I tried it and i get patchy colors out
0
Author Commented:
I was referring to the solution from rlibby, i.e. it should read:
function ColorGradient(StartColor, EndColor: TColor; Min, Max: Double; Value: Double): TColor;
var  dwLength:   Integer;
dwIndex:    Integer;
dfL:        Double;
c1:         COLORREF;
c2:         COLORREF;
begin

// Convert to RGB
c1:=ColorToRGB(StartColor);
c2:=ColorToRGB(EndColor);

// Calculate the color modifier
dfL:=((Value-Min) / (Max - Min));