• Status: Solved
  • Priority: Medium
  • Security: Public
  • Views: 548
  • Last Modified:

Color gradient algoritms

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
davelane
Asked:
davelane
  • 4
  • 3
  • 3
  • +1
2 Solutions
 
Russell LibbySoftware Engineer, Advisory Commented:

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);

  // Return the gradient color
  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
 
Ferruccio AccalaiSenior 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
    ColorToPlot := ColorGradient(clGreen,clred,5,i);
   
0
 
Russell LibbySoftware Engineer, Advisory Commented:

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
  clMenu
  clWindow
  clWindowFrame
  clMenuText
  clWindowText
  clCaptionText
  clActiveBorder
  clInactiveBorder
  clAppWorkSpace
  clHighlight
  clHighlightText
  clBtnFace
  clBtnShadow
  clGrayText
  clBtnText
  clInactiveCaptionText
  clBtnHighlight
  cl3DDkShadow
  cl3DLight
  clInfoText
  clInfoBk

They will come out as black. ;-)

Kindest Regards,
Russell

0
Concerto's Cloud Advisory Services

Want to avoid the missteps to gaining all the benefits of the cloud? Learn more about the different assessment options from our Cloud Advisory team.

 
Ferruccio AccalaiSenior 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
 
davelaneAuthor Commented:
Excellent guys, the first one suits me better, but they are both perfect. No fighting: you both get points.
0
 
Russell LibbySoftware Engineer, Advisory Commented:

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

Thanks for the points,
Russell
0
 
davelaneAuthor Commented:
Yeah forgot the smilie :) Early morning? I'm off home for my tea... Been a long day! :)
0
 
craig_capelCommented:
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....

Function Tform1.RicheditFadeStr(Colours,Msg: String): String;
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));
//              Inc(ShadeC);
           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
 
craig_capelCommented:
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
 
davelaneAuthor Commented:
Actually the following change is required for correct functioning:
dfL:=((Value-Min) / Max);
to
dfL:=((Value-Min) / (Max - Min));
0
 
craig_capelCommented:
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
 
davelaneAuthor 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));

  // Return the gradient color
  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

Independent Software Vendors: We Want Your Opinion

We value your feedback.

Take our survey and automatically be enter to win anyone of the following:
Yeti Cooler, Amazon eGift Card, and Movie eGift Card!

  • 4
  • 3
  • 3
  • +1
Tackle projects and never again get stuck behind a technical roadblock.
Join Now