Solved

Color Gradient

Posted on 2003-12-06
16
730 Views
Last Modified: 2010-04-03
Ok copy and paste this code in, put a memo on the form and 2 buttons.

What this routine does, you pass it the color arguments the start color and finish color, it fades, but not correctly...
anyone know how to fix this?

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;


Function CreateRTFFadeStr(Colours,Msg: String): String;
Var
 OldCol,BuildStr,TmpCol2,TmpCol,Tmp: String;
 ColorCount,Step,N,P1,P2,CharCount: Integer;
 ResCol,Col1,Col2: TColor;
 L,SR,SG,SB: Integer;
Begin
 BuildStr:='';
 ColorCount:=0;
  CharCount:=Length(Msg);
  Tmp:=Colours+',';
  For N:=1 to Length(Tmp) do
    If Tmp[N]=',' Then
      Inc(ColorCount);
  Step:=CharCount Div ColorCount;
  N:=0;
  While (Pos(',',Tmp)>0) do
   Begin
    P1:=Pos(',',Tmp);
    TmpCol:=Copy(Tmp,1,p1-1);
    Delete(Tmp,1,P1); //TmpCol = First ColorString (e=g #FF0000)
    P1:=Pos(',',Tmp);
    TmpCol2:=Copy(Tmp,1,p1-1);
 //    Delete(Tmp,1,P1);  //TmpCol2 = Second ColorString (eg #00FF00)
    If Msg<>'' Then
      Begin
       Col1:=StrToInt('$'+Copy(TmpCol,2,Length(TmpCol)-1));
        If TmpCol2<>'' Then
       Col2:=StrToInt('$'+Copy(TmpCol2,2,Length(TmpCol2)-1));
       For N:=1 to Step Do
        Begin
           ResCol:=ColorGradient(Col1,Col2,Step,N);
           TmpCol:=IntToHex(ResCol,6);
           SR:=StrToInt('$'+Copy(TmpCol,1,2));
           SG:=StrToInt('$'+Copy(TmpCol,3,2));
           SB:=StrToInt('$'+Copy(TmpCol,5,2));
           BuildStr:=BuildStr+';'+'\red'+IntToStr(SR)+'\green'+IntToStr(SG)+'\blue'+IntToStr(SB)+'';
        End;
     End;
     TmpCol:='';
     TmpCol2:='';
     Result:=BuildStr;
  End;
End;

procedure TForm1.Button1Click(Sender: TObject);
begin
Memo1.Text:=CreateRTFFadeStr('#FF0000,#00FF00,#0000FF','TXT');
 // SHOULD produce T in RED  X in Blue and T in GReen
end;

procedure TForm1.Button2Click(Sender: TObject);
begin
 Memo1.Text:=CreateRTFFadeStr('#FF0000,#00FF00,#0000FF','AABBCC');
  // Should produce (255 of Red) then Gade between them.. etc etc
end;
0
Comment
Question by:craig_capel
  • 8
  • 5
16 Comments
 
LVL 2

Accepted Solution

by:
odissey1 earned 250 total points
Comment Utility
Hi craig_capel,

1. TMemo will not produce multicolored text, must use TRichEdit
2. Here my simple wersion of Faded Text (Clr1 -> Clr2). Ask for 'rainbow' if needed.

unit RainbowText_1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, ComCtrls;

type
  TForm1 = class(TForm)
    RichEdit1: TRichEdit;
    Button1: TButton;
    procedure Button1Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}


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

function CreateRTFFadeStr1(C1,C2: Tcolor; Msg: String): string;
Var i, L: integer;
    Clr: TColor;
    RS: string;
Begin
    RS:=  '{\rtf1\ansi\ansicpg1252\deff0\deflang1033{\fonttbl{\f0\fswiss\fcharset0 Arial;}}'
          +'\viewkind4\uc1\pard\f0\fs20 ';

    //create clortable
    RS:=RS+ '{\colortbl; ';
    L:=Length(msg);
    for i:=1  to L do begin
      Clr:= ColorGradient(C1,C2,L,i);
      RS:=RS+ '\red'  +IntToStr(GetRValue(Clr))
            + '\green'+IntToStr(GetGValue(Clr))
            + '\blue' +IntToStr(GetBValue(Clr))+ '; ';
    end;
    RS:=RS+ '}';

    //add string
    for i:=1  to L do begin
      RS:=RS+ '\cf'+IntToStr(i)+' '+copy(msg,i,1);
    end;

    //finalize
    RS:=RS+'\cf0\par}'; // default color +LF+CR

    result:=RS;
End;

procedure TForm1.Button1Click(Sender: TObject);
begin
 //shows faded color text from clRed to clBlue
 RichEdit1.Text:=CreateRTFFadeStr1(clRed,clBlue,'1234567890');
end;

end.


end of dirty job,

regards,
odissey1
0
 
LVL 2

Expert Comment

by:odissey1
Comment Utility
Hi craig_capel,

Here is 3-color example.

unit RainbowText_1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, ComCtrls,
  Math;

type
  TForm1 = class(TForm)
    Memo1: TMemo;
    RichEdit1: TRichEdit;
    Button1: TButton;
    procedure Button1Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

function AdjustGamma(Color: double): Integer;
//const Gamma = 0.5;
begin
     if Color = 0 then result := 0 //don't want 0^x = 1 for x <> 0
//     else result := round(255 * Power(Color/255, Gamma) );
     else result := round(255 * sqrt(Color/255) );
end;

function Palette3 (C1,C2,C3: TColor; iMax, i: integer): TColor;
var R, G, B: double;
    R1,R2,R3,G1,G2,G3,B1,B2,B3: byte;
    StartColor,MiddleColor,EndColor: TColor;
    i2: integer;
begin

     StartColor :=C1;
     MiddleColor:=C2;
     EndColor   :=C3;
     R1:=GetRValue(StartColor);
     G1:=GetGValue(StartColor);
     B1:=GetBValue(StartColor);
     R2:=GetRValue(MiddleColor);
     G2:=GetGValue(MiddleColor);
     B2:=GetBValue(MiddleColor);
     R3:=GetRValue(EndColor);
     G3:=GetGValue(EndColor);
     B3:=GetBValue(EndColor);

     //two-color palette C1->C3
//     R := R1 + (R3-R1) * i / iMax;
//     G := G1 + (G3-G1) * i / iMax;
//     B := B1 + (B3-B1) * i / iMax;

     //3-color palette C1->C2->C3
     i2:=iMax div 2;
     if i <= i2 then begin
       R := R1 + (R2-R1) * i / i2;
       G := G1 + (G2-G1) * i / i2;
       B := B1 + (B2-B1) * i / i2;
     end
     else begin
       R := R2 + (R3-R2) * (i-i2) / (iMax-i2);
       G := G2 + (G3-G2) * (i-i2) / (iMax-i2);
       B := B2 + (B3-B2) * (i-i2) / (iMax-i2);
     end;

//     result:=RGB( round(R), round(G), round(B) );

     //or you can smooth transition effect
     result:=RGB( AdjustGamma(R), AdjustGamma(G), AdjustGamma(B) );

end;

function CreateRTFFadeStr1(C1,C2,C3: Tcolor; Msg: String): string;
Var i, L: integer;
    Clr: TColor;
    RS: string;
Begin
    RS:=  '{\rtf1\ansi\ansicpg1252\deff0\deflang1033{\fonttbl{\f0\fswiss\fcharset0 Arial;}}'
          +'\viewkind4\uc1\pard\f0\fs20 ';

    //create clortable
    RS:=RS+ '{\colortbl; ';
    L:=Length(msg);
    for i:=1  to L do begin
      Clr:= Palette3(C1,C2,C3,L,i);
      RS:=RS+ '\red'  +IntToStr(GetRValue(Clr))
            + '\green'+IntToStr(GetGValue(Clr))
            + '\blue' +IntToStr(GetBValue(Clr))+ '; ';
    end;
    RS:=RS+ '}';


    //add string
    for i:=1  to L do begin
      RS:=RS+ '\cf'+IntToStr(i)+' '+copy(msg,i,1);
    end;

    //finalize
    RS:=RS+'\cf0\par}'; // default color +LF+CR

    result:=RS;
End;

procedure TForm1.Button1Click(Sender: TObject);
begin
 //3-color transition clRed->clYellow->clBlue
 RichEdit1.Text:=CreateRTFFadeStr1(clRed,clYellow,clBlue,'1234567890');

end;

regards,
odissey1

end.
0
 
LVL 2

Author Comment

by:craig_capel
Comment Utility
Ah.... yes, but the problem is that it could be 1,2,3, 4, 5, 6 color values to be passed to produce a gradient...

the math is beyond me i think :P
0
 
LVL 2

Expert Comment

by:odissey1
Comment Utility
Hi Craig_capel,

do you want ANY color sequence, or true RAINBOW color scheme?

regards,
odissey1
0
 
LVL 2

Author Comment

by:craig_capel
Comment Utility
any sequence, so i could pass in RED, Green Blue Black and it would do a nice gradient

Red... Red/Green / Red/Green/Blue.... on the way to Black....

or Blue Black Blue Black... Blue.../Darker Blue/ Darker / Black... Lightter blue to Blue. a nice graident between..

http://chat-help.co.uk/~ymlite/screenshot.gif <<like this one i already have but the problem is once it does more than 255 char fade, it becomes really blocky and stops working and turns to one color...
0
 
LVL 2

Expert Comment

by:odissey1
Comment Utility
Hi craig_capel,

This programm does what you wants: Any colors combination, any text string.

Regards,
odissey1

unit RainbowText_3;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, ComCtrls,
  Math,//Power
  StrUtils //PosEx
  ;

type
  TForm1 = class(TForm)
    Memo1: TMemo;
    RichEdit1: TRichEdit;
    Button1: TButton;
    Button3: TButton;
    procedure Button1Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;
  NColors: integer;
  AColors: array of TColor;

const
  PaletteSteps=32; // number of colors to use in color table
                   // this will make your Text shorter

implementation

{$R *.dfm}


//------------------------------------------------------------

function AdjustGamma(Color: double): Integer;
const Gamma = 0.25; //(0...10) - smooth transition effect
begin
     if Color <= 0 then result := 0    else
     if Color > 255 then result := 255 else
//     result := round(Color);
     result := round(255 * Power(Color/255, Gamma) );
end;

function Palette (i: integer): TColor;
var R, G, B: double;
    R1,R2,G1,G2,B1,B2: integer;
    v1, v2, delta: double;
    i1,i2,k1,k2: integer;
    C1,C2: TColor;
    ch:char;
begin
     //note: total PaletteSteps are distributed between NColors
     // i-some position between 1 <= ii <= PaletteSteps
     // get mix colors

     k1:=trunc( (NColors-1) * (i-1) / (PaletteSteps-1) );
     k2:=k1+1; if k2 > Ncolors-1 then k2:=Ncolors-1;

     v1:=k1 * (PaletteSteps-1) / (NColors-1);
     v2:=k2 * (PaletteSteps-1) / (NColors-1);

     C1:=AColors[k1];
     C2:=AColors[k2];

     R1:=GetRValue(C1); G1:=GetGValue(C1); B1:=GetBValue(C1);
     R2:=GetRValue(C2); G2:=GetGValue(C2); B2:=GetBValue(C2);

     //2-color transition C1->C2
     delta := V2 - V1;
     R := R1 + (R2-R1) * (i-v1) / delta;
     G := G1 + (G2-G1) * (i-v1) / delta;
     B := B1 + (B2-B1) * (i-v1) / delta;

     result:=RGB( AdjustGamma(R), AdjustGamma(G), AdjustGamma(B) );

end;
//------------------------------------------------------------

function CreateRTFFadeStr(Msg: String): string;
Var i, L, pClr, pClr_bak: integer;
    Clr: TColor;
    RS: string;
Begin
    RS:=  '{\rtf1\ansi\ansicpg1252\deff0\deflang1033{\fonttbl{\f0\fswiss\fcharset0 Arial;}}'
          +'\viewkind4\uc1\pard\f0\fs20 ';

    // we shell limit color table to some PalletteSteps
    // there would be no more then PaletteSteps color in color table
    // create clortable

    RS:=RS+ '{\colortbl; ';

    for i:=0 to PaletteSteps-1 do begin
      Clr:= Palette(i);
      RS:=RS+ '\red'  +IntToStr(GetRValue(Clr))
            + '\green'+IntToStr(GetGValue(Clr))
            + '\blue' +IntToStr(GetBValue(Clr))+ '; ';
    end;
    RS:=RS+ '}';

    L:=Length(msg);

    //stuff string with color modifiers when needed
    pClr_bak:=-1;
    for i:=0  to L-1 do begin
      pClr:=round(1+(PaletteSteps-1) * i / (L-1) ); //find a new color edge

      if pClr <> pClr_bak then //edge found
      begin
        RS:=RS+ '\cf'+IntToStr(pClr)+' '+copy(msg,i+1,1);
        pClr_bak:=pClr;
      end
      else //no color modifier - use current color
        RS:=RS+copy(msg,i,1);

    end;

    //finalize
    RS:=RS+'\cf0\par}'; // reset to default color +LF+CR

    result:=RS;
End;

procedure SetColors(S: string);
var s1: string;
    i,i1,i2: integer;
    Strings: TStringList;
begin
//    if S = '' then exit;

    //separate ColorString into substrings (colors)
    Strings:=TStringList.Create;
    S:=S+','; //add terminator
    NColors:=0; //number of colors found
    i1:=0; i2:=0;
    while PosEx(',', S, i2+1) > 0 do begin
      i2:=PosEx(',', S, i2+1);
      s1:=MidStr(S, i1+1, i2-(i1+1) );
      Strings.Add( Trim(s1) );
      Inc(NColors);
      i1:=i2;
    end;

    SetLength(Acolors, NColors); //set dimension of colors array

    //define colors
    for i:=0 to NColors-1 do
      Acolors[i]:=StringToColor(Strings[i]);

    Strings.Free;
end;


procedure TForm1.Button1Click(Sender: TObject);
var S: string;
begin

 //set text string
 S:='';
 S:=S+'1.      GRANT OF LICENSE.' + '\par';
 S:=S+'(a)     Microsoft grants you ("Recipient") a limited, non-exclusive,';
 S:=S+' nontransferable, royalty-free license to make and use up to three (3)';
 S:=S+'    copies of the software accompanying this Agreement ("Product") on ';
 S:=S+ 'computer systems located on Recipients premises, solely to test the';
 S:=S+ 'compatibility of Recipients application or other product(s) which operate';
 S:=S+' in conjunction with the Product and to evaluate the Product for the purpose';
 S:=S+' of providing feedback thereon to Microsoft.  All other rights are reserved';
 S:=S+' to Microsoft.  Recipient shall not rent, lease, sell, sublicense, assign, ';
 S:=S+' or otherwise transfer the Product, including any accompanying printed ';
 S:=S+' materials.  Recipient shall not reverse engineer, decompile or disassemble ';
 S:=S+' the Product except to the extent that this restriction is expressly prohibited ';
 S:=S+' by applicable law.  Recipient may not disclose the results of any benchmark ';
 S:=S+' testing of the Product to any third party without Microsofts prior written';
 S:=S+' permission.  Microsoft and its suppliers shall retain title and all owner';

// S:='123456789cvbvb123407';

 SetColors('clRed,clYellow,clLime,clBlue,clFuchsia');
 RichEdit1.Text:=CreateRTFFadeStr(S);

// Memo1.Text:=CreateRTFFadeStr(S);

end;

end.
0
How your wiki can always stay up-to-date

Quip doubles as a “living” wiki and a project management tool that evolves with your organization. As you finish projects in Quip, the work remains, easily accessible to all team members, new and old.
- Increase transparency
- Onboard new hires faster
- Access from mobile/offline

 
LVL 2

Author Comment

by:craig_capel
Comment Utility
OK....

  RS:=RS+ '{\colortbl; ';

    for i:=0 to PaletteSteps-1 do begin
      Clr:= Palette(i);
      RS:=RS+ '\red'  +IntToStr(GetRValue(Clr))
            + '\green'+IntToStr(GetGValue(Clr))
            + '\blue' +IntToStr(GetBValue(Clr))+ '; ';
    end;
    RS:=RS+ '}';

    L:=Length(msg);


As you may have guessed, as a person types it renders the string on the fly and outputs it to richedit producing the fade...

problem, if i type in ABC with the colors FF 00 00 , 00 FF 00, 00 00 FF

It produces 32 steps as that's how many are in the PaletteSteps, the Palette steps should only be 3 if the length of the message is 3, or 1 or if someone types out a lengthy message, even more...

with "ABC" and the colors "Red,Green,Blue" i get 3 rows of
it all ranging from blues yellows greens red orange text from it...
0
 
LVL 2

Expert Comment

by:odissey1
Comment Utility
Hi craig_capel,

Did you tried to run the code above? I see output as requested:
 S:='123';
 SetColors('clRed,clGreen,clBlue');
result: single line '123'; 1 (Red), 2 (green), 3(blue) - no problem (used PaletteSteps=32).

In my example PaletteSteps could be any. You can put 255 -it will produce same result. I introduced this constant to reduce ColorTable size only. I figured that above 32 steps eye can not distingiush color gradation any more - just run example above and see. So the advantage that you can put color table just once - and then staff RichEdit with strings. But if you want you can change it also on-the-fly (just replace declaration to
var PaletteSteps: integer;)


>with "ABC" and the colors "Red,Green,Blue" i get 3 rows of
>it all ranging from blues yellows greens red orange text from it...

I don't understand what you mean. The above code gives single line 'ABC' with A in Red, B in Green and C in Blue. No blended colors.
(PaletteSteps=32).
 S:='ABC';
 SetColors('clRed,clGreen,clBlue');
RichEdit1.Text:=...

To see blended colors string must be longer like 'AaBbC' ('a', 'b' will show blended)

Do you see a rainbow-blended text (~20 lines) in my example?
 
Regards,
odissey1
P.S. I can drop you a sourcecode if needed.



0
 
LVL 2

Expert Comment

by:odissey1
Comment Utility
Hi again,

Just checked with PaletteSteps=3. 'ABC' works OK. But you really don't have to change it: 32 -gradation is good enough to satisfy any short or long string

odissey1
0
 
LVL 2

Author Comment

by:craig_capel
Comment Utility
ok, what is the RTF output you get for 'ABC' i will show you what i get...
0
 
LVL 2

Expert Comment

by:odissey1
Comment Utility
Hi Craig_capel,

As I said the code above with settings
(PaletteSteps=32).
 S:='ABC';
 SetColors('clRed,clGreen,clBlue');
RichEdit1.Text:=...

gives PERFECT output: 'ABC' with A in Red, B in Green and C in Blue.
Just copy and paste example above. If you have any problems - ask for source code. What I suspect, the way you use this code in your program is not what you asked in the forum. My suggestion is: copy/paste code above (add RichEdit1 and Button1 to the form). Check that its working. Then customize to your needs.

One more thought: do you work in 256-color resolution?

regards,
odissey1
 

 
0
 
LVL 2

Author Comment

by:craig_capel
Comment Utility
Right then... i got your demo and i am sure it's what i need so i modified the routine to make it produce the string i need, the routine you used actually puts all the stuff in my following routines do anyway.

what it does now is, pass in the colors, get back just the red/blue/green like this..


Var i, L, pClr, pClr_bak: integer;
    Clr: TColor;
    RS: string;
Begin
    // we shell limit color table to some PalletteSteps
    // there would be no more then PaletteSteps color in color table
    // create clortable

{    PaletteSteps:=32;

    If Length(Msg)<32 Then
       PaletteSteps:=Length(Msg);}

    PaletteSteps:=Length(Msg) Div NColors;


    for i:=0 to PaletteSteps-1 do begin
      Clr:= Palette(i);
      RS:=RS+ ';\red'+IntToStr(GetBValue(Clr))+'\green'+IntToStr(GetGValue(Clr))+'\blue'+IntToStr(GetRValue(Clr));

//   BuildStr:=BuildStr+';'+'\red'+IntToStr(NewR)+'\green'+IntToStr(NewG)+'\blue'+IntToStr(NewB)+'';
    end;
    L:=Length(msg);

    //stuff string with color modifiers when needed
    pClr_bak:=-1;

{    for i:=0  to L-1 do begin
      pClr:=round(1+(PaletteSteps-1) * i / (L-1) ); //find a new color edge

      if pClr <> pClr_bak then //edge found
      begin
        RS:=RS+ '\cf'+IntToStr(pClr)+' '+copy(msg,i+1,1);
        pClr_bak:=pClr;
      end
      else //no color modifier - use current color
        RS:=RS+copy(msg,i+1,1);

    end;

    //finalize}
//    RS:=RS+'\cf0\par}'; // reset to default color +LF+CR

    result:=RS;


That's exactly the string i need to pass back, just the RGB and since Tcolor is BGR and not RGB i swapped them around..

the problem it's having now is that it stops short, my old routine would produce stuff like this

 //my routine

RicheditFadeStr('$FF0000,$00FF00,$0000FF','abc'); =
;\red255\green0\blue0;\red0\green255\blue0

//Now your routine

 SetColors2('$FF0000,$00FF00,$0000FF'); // new one
 Data:=RicheditFadeStrold('abc'); =
;\red255\green0\blue0;\red0\green255\blue0;\red0\green0\blue255

//this is perfect great, that's how i wished mine went, RGB ;)

but then i start getting into the problems you see, sticking 32 colors into richedits stream for the color table for your version is great, my version i have to go and add RTF smiley faces and fonts and other stuff, that's why i produce JUST the RGB values (the color table)...

//My Routine for "abcabc"
('$FF0000,$00FF00,$0000FF','abcabc'); =
;\red255\green0\blue0;\red170\green85\blue0;\red85\green170\blue0;\red0\green255\blue0;\red0\green170\blue85;\red0\green85\blue170

//Now your routine "abcabc"
 SetColors2('$FF0000,$00FF00,$0000FF'); // new one
 Data:=RicheditFadeStrold('abcabc');

;\red255\green0\blue0;\red224\green203\blue0;\red171\green241\blue0;\red0\green255\blue0;\red0\green203\blue224;\red0\green0\blue255

----------------------HERE IMPORTANT------------------

And again, still works :) it does the end colors and all, but for a longer message then it starts going funny..


//MyRoutine
 Data:=RicheditFadeStr('$FF0000,$00FF00,$0000FF','abcabc12345'); =
;\red255\green0\blue0;\red204\green51\blue0;\red153\green102\blue0;\red102\green153\blue0;\red51\green204\blue0;\red0\green255\blue0;\red0\green204\blue51;\red0\green153\blue102;\red0\green102\blue153;\red0\green51\blue204

//YourRoutine for above
 SetColors2('$FF0000,$00FF00,$0000FF'); // new one
 Data:=RicheditFadeStrold('abcabc12345'); =
;\red255\green0\blue0;\red241\green171\blue0;\red224\green203\blue0;\red203\green224\blue0;\red171\green241\blue0;\red0\green255\blue0;\red0\green241\blue171;\red0\green224\blue203;\red0\green203\blue224;\red0\green171\blue241;\red0\green0\blue255

First Part Red  second Green third Blue - Perfect, great, now watch what happens..

OK I just discovered what the problem was i was doing all this testing, the problem comes when i hit more than 32 (graident steps)

 Data:=RicheditFadeStr('$FF0000,$00FF00,$0000FF','abcabc12345678901234567890123456789012345678901234567890');
 Richedit1.Lines.Add(Data);

should look something like...

;\red255\green0\blue0;\red246\green9\blue0;\red237\green18\blue0;\red228\green27\blue0;\red219\green36\blue0;\red210\green45\blue0;\red201\green54\blue0;\red192\green63\blue0;\red183\green72\blue0;\red174\green81\blue0;\red165\green90\blue0;\red156\green99\blue0;\red147\green108\blue0;\red138\green117\blue0;\red129\green126\blue0;\red120\green135\blue0;\red111\green144\blue0;\red102\green153\blue0;\red93\green162\blue0;\red84\green171\blue0;\red75\green180\blue0;\red66\green189\blue0;\red57\green198\blue0;\red48\green207\blue0;\red39\green216\blue0;\red30\green225\blue0;\red21\green234\blue0;\red12\green243\blue0;\red0\green255\blue0;\red0\green246\blue9;\red0\green237\blue18;\red0\green228\blue27;\red0\green219\blue36;\red0\green210\blue45;\red0\green201\blue54;\red0\green192\blue63;\red0\green183\blue72;\red0\green174\blue81;\red0\green165\blue90;\red0\green156\blue99;\red0\green147\blue108;\red0\green138\blue117;\red0\green129\blue126;\red0\green120\blue135;\red0\green111\blue144;\red0\green102\blue153;\red0\green93\blue162;\red0\green84\blue171;\red0\green75\blue180;\red0\green66\blue189;\red0\green57\blue198;\red0\green48\blue207;\red0\green39\blue216;\red0\green30\blue225;\red0\green21\blue234;\red0\green12\blue243

Your routine only gives this..

;\red255\green0\blue0;\red251\green129\blue0;\red246\green153\blue0;\red242\green169\blue0;\red237\green182\blue0;\red231\green192\blue0;\red226\green201\blue0;\red219\green209\blue0;\red213\green216\blue0;\red205\green223\blue0;\red197\green229\blue0;\red187\green234\blue0;\red176\green239\blue0;\red162\green244\blue0;\red142\green249\blue0;\red108\green253\blue0;\red0\green255\blue0;\red0\green249\blue142;\red0\green244\blue162;\red0\green239\blue176;\red0\green234\blue187;\red0\green229\blue197;\red0\green223\blue205;\red0\green216\blue213;\red0\green209\blue219;\red0\green201\blue226;\red0\green192\blue231;\red0\green182\blue237;\red0\green169\blue242;\red0\green153\blue246;\red0\green129\blue251;\red0\green0\blue255

Because it's more than 32 steps


OK, so this is a simple problem to fix then surely,

Thanks for ALL your help, really appreciated.. i only had this problem for the last 2 years :)



0
 
LVL 2

Expert Comment

by:odissey1
Comment Utility
Hi Craig_capel,

I hope my input was helpful.

sincerely,
odissey1

comments:

1.
..That's exactly the string i need to pass back, just the RGB and since Tcolor is BGR and not RGB i swapped them around..

-Do we have different graphic boards? I didn't have to swap them

2.
//My Routine for "abcabc"
('$FF0000,$00FF00,$0000FF','abcabc'); = \red255\green0\blue0;\red170\green85.... <- here G=85
//Now your routine "abcabc"
 SetColors2('$FF0000,$00FF00,$0000FF');
 Data:=RicheditFadeStrold('abcabc');
\red255\green0\blue0;\red224\green203...<---here G=203. this 'color curve' is controlled by GAMMA. you can tweak 0.5-0.8-1.0 to get desirable smoothness of color transition. This is the same image GAMMA as e.g. in Corel Photopoint.

3.
Data:=RicheditFadeStr('$FF0000,$00FF00,$0000FF','abcabc12345678901234567890123456789012345678901234567890');
 Richedit1.Lines.Add(Data);

should look something like...

;\red255\green0\blue0;\red246\green9\blue0;\red237\green18\blue0;\red228\green27\blue0;\red219\green36\blue0;\red210\green45\blue0;\red201\green54\blue0;\red192\green63\blue0;\red183\green72\blue0;\red174\green81\blue0;\red165\green90\blue0;\red156\green99\blue0;\red147\green108\blue0;\red138\green117\blue0;\red129\green126\blue0;\red120\green135\blue0;\red111\green144\blue0;\red102\green153\blue0;\red93\green162\blue0;\red84\green171\blue0;\red75\green180\blue0;\red66\green189\blue0;\red57\green198\blue0;\red48\green207\blue0;\red39\green216\blue0;\red30\green225\blue0;\red21\green234\blue0;\red12\green243\blue0;\red0\green255\blue0;\red0\green246\blue9;\red0\green237\blue18;\red0\green228\blue27;\red0\green219\blue36;\red0\green210\blue45;\red0\green201\blue54;\red0\green192\blue63;\red0\green183\blue72;\red0\green174\blue81;\red0\green165\blue90;\red0\green156\blue99;\red0\green147\blue108;\red0\green138\blue117;\red0\green129\blue126;\red0\green120\blue135;\red0\green111\blue144;\red0\green102\blue153;\red0\green93\blue162;\red0\green84\blue171;\red0\green75\blue180;\red0\green66\blue189;\red0\green57\blue198;\red0\green48\blue207;\red0\green39\blue216;\red0\green30\blue225;\red0\green21\blue234;\red0\green12\blue243

Your routine only gives this..

;\red255\green0\blue0;\red251\green129\blue0;\red246\green153\blue0;\red242\green169\blue0;\red237\green182\blue0;\red231\green192\blue0;\red226\green201\blue0;\red219\green209\blue0;\red213\green216\blue0;\red205\green223\blue0;\red197\green229\blue0;\red187\green234\blue0;\red176\green239\blue0;\red162\green244\blue0;\red142\green249\blue0;\red108\green253\blue0;\red0\green255\blue0;\red0\green249\blue142;\red0\green244\blue162;\red0\green239\blue176;\red0\green234\blue187;\red0\green229\blue197;\red0\green223\blue205;\red0\green216\blue213;\red0\green209\blue219;\red0\green201\blue226;\red0\green192\blue231;\red0\green182\blue237;\red0\green169\blue242;\red0\green153\blue246;\red0\green129\blue251;\red0\green0\blue255

Because it's more than 32 steps

-True.  I introduced PaletteSteps to experiment with colors perception and to make output text shorter. Just increase desirable PaletteSteps = 128, 256... could be done on-the-fly.  Personally, I  don't see color gradations with >=32. But this is subjective.
0

Featured Post

How to run any project with ease

Manage projects of all sizes how you want. Great for personal to-do lists, project milestones, team priorities and launch plans.
- Combine task lists, docs, spreadsheets, and chat in one
- View and edit from mobile/offline
- Cut down on emails

Join & Write a Comment

This article explains how to create forms/units independent of other forms/units object names in a delphi project. Have you ever created a form for user input in a Delphi project and then had the need to have that same form in a other Delphi proj…
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…
Here's a very brief overview of the methods PRTG Network Monitor (https://www.paessler.com/prtg) offers for monitoring bandwidth, to help you decide which methods you´d like to investigate in more detail.  The methods are covered in more detail in o…
This tutorial demonstrates a quick way of adding group price to multiple Magento products.

771 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question

Need Help in Real-Time?

Connect with top rated Experts

16 Experts available now in Live!

Get 1:1 Help Now