[2 days left] Whatâ€™s wrong with your cloud strategy? Learn why multicloud solutions matter with Nimble Storage.Register Now

x
Solved

Posted on 2003-12-05
Medium Priority
544 Views
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).
0
Question by:davelane
[X]
###### Welcome to Experts Exchange

Add your voice to the tech community where 5M+ people just like you are talking about what matters.

• Help others & share knowledge
• Earn cash & points
• 4
• 3
• 3
• +1

LVL 26

Accepted Solution

Russell Libby earned 600 total points
ID: 9882584

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

LVL 23

Expert Comment

ID: 9882712
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

LVL 26

Expert Comment

ID: 9882772

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

LVL 23

Assisted Solution

Ferruccio Accalai earned 400 total points
ID: 9882832
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 Comment

ID: 9882863
Excellent guys, the first one suits me better, but they are both perfect. No fighting: you both get points.
0

LVL 26

Expert Comment

ID: 9882881

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

Thanks for the points,
Russell
0

Author Comment

ID: 9882917
Yeah forgot the smilie :) Early morning? I'm off home for my tea... Been a long day! :)
0

LVL 2

Expert Comment

ID: 9887529
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

LVL 2

Expert Comment

ID: 9887775
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 Comment

ID: 9903672
Actually the following change is required for correct functioning:
dfL:=((Value-Min) / Max);
to
dfL:=((Value-Min) / (Max - Min));
0

LVL 2

Expert Comment

ID: 9903835
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 Comment

ID: 9903859
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));

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

## Featured Post

Question has a verified solution.

If you are experiencing a similar issue, please ask a related question

Creating an auto free TStringList The TStringList is a basic and frequently used object in Delphi. On many occasions, you may want to create a temporary list, process some items in the list and be done with the list. In such cases, you have toâ€¦
Introduction I have seen many questions in this Delphi topic area where queries in threads are needed or suggested. I know bumped into a similar need. This article will address some of the concepts when dealing with a multithreaded delphi databaseâ€¦
Please read the paragraph below before following the instructions in the video â€” there are important caveats in the paragraph that I did not mention in the video. If your PaperPort 12 or PaperPort 14 is failing to start, or crashing, or hanging, â€¦