Want to protect your cyber security and still get fast solutions? Ask a secure question today.Go Premium

x
Solved

# Math Problem (Not homework!)

Posted on 2003-03-26
Medium Priority
356 Views
I tried writing a routine to extract hex values of 2 or more
colours and then blend between them giving a rainbow effect i failed
can someone pleeeease help me here i spent days trying to work out the
problem...

Ok the code below is the problem, all you need to do is put on a memo
a button and paste in the gaps from below and hit the button the output
from the example below gives..

R: 255 G: 0 b: 0
R: 204 G: 51 b: 0
R: 153 G: 102 b: 0
R: 102 G: 153 b: 0
R: 51 G: 204 b: 0
R: 0 G: 255 b: 0
R: 0 G: 204 b: 51
R: 0 G: 153 b: 102
R: 0 G: 102 b: 153
R: 0 G: 51 b: 204

from

Msg:='1234567890';
Colours:='#FF0000,#00FF00,#0000FF';

So 1 should be FF0000 (255 Red 0 Green 0 Blue)
2 should be starting to merge with Green (which it does) and so on
but it messes up - helpppppp any help or anyone know where i can
get a routine to do this type of thing?

Thanks Folks....

unit eetest;

interface

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

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

var
Form1: TForm1;
R,G,B: Integer;

implementation

{\$R *.dfm}

Function ConverTToRGB(StrCol: String): Boolean;
Var
TmpCol: String;
Begin
Result:=False;
If StrCol<>'' Then
Begin
Result:=True;
TmpCol:=StrCol;
Try
R:=StrToInt('\$'+Copy(TmpCol,2,2));
G:=StrToInt('\$'+Copy(TmpCol,4,2));
B:=StrToInt('\$'+Copy(TmpCol,6,2));
Except
End;
End;
End;

Procedure Tform1.Blend;
Var
Msg,Colours,Str1,Str2: 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;
Msg:='1234567890';
Colours:='#FF0000,#00FF00,#0000FF';
Tmp:=Msg;
CharCount:=Length(Msg);
ColCount:=3;
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);
If TmpCol2='' Then Exit;
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);
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)
else
NewR:=RF+Trunc(IncR);
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
Begin
Form1.Memo1.Lines.Add('R: '+IntToStr(NewR)+' G: '+IntToStr(NewG)+' b: '+IntToStr(NewB));
//output results
End;
RF:=NewR;
GF:=NewG;
BF:=NewB;
Until N>BlendCount-1;

Delete(Msg,1,1);
IncR:=0;
IncB:=0;
IncG:=0;
End;
End;
End;

procedure TForm1.Button1Click(Sender: TObject);
begin
Blend;
end;

end.

0
Question by:craig_capel
• 7
• 4
• 2
• +1

LVL 4

Expert Comment

ID: 8210542
Craig

Take a look at my program and see if you can reason your desired colors with these color numbers.

Delphi3

unit HexColorUnit1;

interface

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

type
TForm1 = class(TForm)
ColorDialog1: TColorDialog;
Label1: TLabel;
Label2: TLabel;
Label3: TLabel;
Label4: TLabel;
Label5: TLabel;
Edit1: TEdit;
Edit2: TEdit;
Edit3: TEdit;
Edit4: TEdit;
Edit5: TEdit;
Button1: TButton;
Button2: TButton;
procedure Button1Click(Sender: TObject);
procedure Button2Click(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;

var
Form1: TForm1;

implementation

{\$R *.DFM}

procedure TForm1.Button1Click(Sender: TObject);
var
a, b, c: integer;
Temp2: LongInt;
HexNum: string;
begin
if (ColorDialog1.Execute) then
begin
HexNum := IntToHex(ColorDialog1.Color, 6);
Edit1.Text := HexNum;
Edit2.Text := IntToStr(ColorDialog1.Color);
Temp2 := StrToInt(Edit2.Text);
a := Temp2 div 65536;
Edit5.Text := IntToStr(a);
b := (Temp2 - a * 65536) div 256;
Edit4.Text := IntToStr(b);
c := Temp2 - a * 65536 - b * 256;
Edit3.Text := IntToStr(c);
end;
end;

procedure TForm1.Button2Click(Sender: TObject);
begin
Application.Terminate;
end;

end.

end.

//DFM as text
object Form1: TForm1
Left = 70
Top = 100
Width = 213
Height = 348
Caption = 'HexcolorNumbers'
Color = clBtnFace
Font.Charset = DEFAULT_CHARSET
Font.Color = clWindowText
Font.Height = -13
Font.Name = 'MS Sans Serif'
Font.Style = []
OldCreateOrder = False
PixelsPerInch = 120
TextHeight = 16
object Label1: TLabel
Left = 41
Top = 25
Width = 104
Height = 16
Caption = 'HexColorNumber'
end
object Label2: TLabel
Left = 41
Top = 80
Width = 71
Height = 16
Caption = 'LongInteger'
end
object Label3: TLabel
Left = 48
Top = 137
Width = 10
Height = 16
Caption = 'R'
end
object Label4: TLabel
Left = 90
Top = 137
Width = 10
Height = 16
Caption = 'G'
end
object Label5: TLabel
Left = 128
Top = 137
Width = 9
Height = 16
Caption = 'B'
end
object Edit1: TEdit
Left = 41
Top = 48
Width = 120
Height = 24
TabOrder = 0
end
object Edit2: TEdit
Left = 41
Top = 105
Width = 120
Height = 24
TabOrder = 1
end
object Edit3: TEdit
Left = 41
Top = 153
Width = 32
Height = 24
TabOrder = 2
end
object Edit4: TEdit
Left = 80
Top = 153
Width = 33
Height = 24
TabOrder = 3
end
object Edit5: TEdit
Left = 121
Top = 153
Width = 32
Height = 24
TabOrder = 4
end
object Button1: TButton
Left = 50
Top = 212
Width = 112
Height = 30
Caption = 'ColorChart'
TabOrder = 5
OnClick = Button1Click
end
object Button2: TButton
Left = 50
Top = 256
Width = 112
Height = 31
Caption = 'Close'
TabOrder = 6
OnClick = Button2Click
end
object ColorDialog1: TColorDialog
Ctl3D = True
Left = 8
Top = 168
end
end
0

LVL 2

Author Comment

ID: 8211050
The thing is the fade return can be any amount for example if i put in #FF0000,#0000FF and "Hello" it will appear
like this

hello
Red Turning to Blue

here's a Screen Shot..

http://chat-help.co.uk/~ymlite/screen.gif

What i am doing is building my own RTF string and outputting it see the highlighted part in blue, well that's what gets generated by the program i put together at the top, the only problem with it is it's supposed to render a different color for each char that gets outputted so if you type in "hello" it comes out as 5 colors, the problem is, it sometimes comes out as 4 or the wrong fade....

As you can see the routine i have "works" for for my client but when building the RTF string i have to be exact (here's my fader (above code) in action...)

http://chat-help.co.uk/~ymlite/windows1.gif

The aim is to bypass Richedit.Selattributes.Color:=X; output A Richedit.....Color:=X; Output B producing a pretty fade, i want to Build up the string but the code is simply not good enough for this...

i know it's something simple with the code as u can see it works good enough but not acurately...

- Thanks

Craig C.

0

LVL 2

Author Comment

ID: 8211798
The thing is the fade return can be any amount for example if i put in #FF0000,#0000FF and "Hello" it will appear
like this

hello
Red Turning to Blue

here's a Screen Shot..

http://chat-help.co.uk/~ymlite/screen.gif

What i am doing is building my own RTF string and outputting it see the highlighted part in blue, well that's what gets generated by the program i put together at the top, the only problem with it is it's supposed to render a different color for each char that gets outputted so if you type in "hello" it comes out as 5 colors, the problem is, it sometimes comes out as 4 or the wrong fade....

As you can see the routine i have "works" for for my client but when building the RTF string i have to be exact (here's my fader (above code) in action...)

http://chat-help.co.uk/~ymlite/windows1.gif

The aim is to bypass Richedit.Selattributes.Color:=X; output A Richedit.....Color:=X; Output B producing a pretty fade, i want to Build up the string but the code is simply not good enough for this...

i know it's something simple with the code as u can see it works good enough but not acurately...

- Thanks

Craig C.

0

LVL 4

Expert Comment

ID: 8218771
Craig,

Not to get the pot stirred too much here but I have several Q's.
What makes you believe that to achieve the rainbow color scheme that your method of getting the 'rainbow color's'? Have you read some research on (Delphi + blending) schemes?

What  my gift above was a source for color numbers. You could test out your color picks.
There are lots of (255 and less) + (255 and less)+(255 and less) other combinations that can achieve rainbow colors.

Some combinations of color can be achieved with a random pattern that is like: RandomBrightColor := RGB(Random(128) + 128,Random(128) + 128,Random(128) + 128);

Or you could make a lookup table that you have scanned a small Rainbow.jpg for a list of colors in that picture of a rainbow  looking at  something like Supernumerary Rainbows.htm.

I solved the problem using a D4 text editor, the text being scaned for individual letters in the message, referencing the color lookup table or using a random # scheme with insertions into a source coded  a html page, then to displaying as a html page. From there the text is copyable in color. But  I did not write it as you have illustrated it in your screen snaps, udp listen and udp send.

Delphi3
0

LVL 4

Expert Comment

ID: 8222828
Craig,
This list is given as a gift to you, that was sent to me by someone that I connect with from Australia.  He is a programmer of distinction from the world of video games.

copied from his email to me:
Here is a simple rainbow sequence in RRGGBB format
>
> FF0000 - Red
> FF8800
> FFFF00 - Yellow
> 88FF00
> 00FF00 - Green
> 00FF88
> 00FFFF - Cyan (light blue)
> 0088FF
> 0000FF - Blue
> 8800FF
> FF00FF - Purple (magenta)
> FF0088
>
> You can see that it follows a pattern.  Red starts at full, then green
> starts to rise until it is at full.  Then red drops to zero.  Next,
> blue starts to rise to full, after which green starts to fall to
> zero, and so on.
>
> You could put those values into an array and assign one colour in
> sequence to each character in the string.
>

Delphi3

0

LVL 2

Author Comment

ID: 8223076
Yeah i see what you are saying but i think you mis-understand if you were to compile the code i gave you you would see what i mean, you pass in a string containing the colors to fade from, have you ever seen yahoo messenger? you select the colors you could have 2 from Red To Blue and then the routine blends them together - it's actually working it's just not perfect and i think i missed something out...

take a look at

look carefully, the one at the bottom is the routine i posted near the top of the screen (the exact same code) the one on top (yahoo messenger) is also doing the same, problem is my code is off, notice how it's supposed to be bright green while my code is producing a semi bright green at the very end of the string, it's all variable and can change, in order to understand you must compile the code and change the input strings...

Msg:='1234567890';
Colours:='#FF0000,#00FF00,#0000FF';

so if i wanted to have a fade between Blue Red and Green AND Blue again i would do....

Colours:='#0000FF,#FF0000,#00FF00,#0000FF';

It will then produce 19 different colors for each of the
chars from T to e in the test string, i then feed them into richedit to produce a fade, for the last time the code WORKS (it compiles and works!) it just screws up working out the last color and for the life of me i don't know why...

0

LVL 4

Expert Comment

ID: 8223118
Hi Craig,

I'll do some more looking at/checking your work.

Will be back when I have something to contribute.

Delphi3
0

LVL 4

Expert Comment

ID: 8231702
Craig,
I have been studying your various gifs noted above. I think that the difference of your output and yahoo's output do not occur at the end of the input line but appear to happen progressively throughout the line. It is especially noticeable at the end. That is a hunch on my part.

I need to have three more various outputs of your program, the related exact string that you used that you used, the exact colors for that line that you used, and finally contrast each against the yahoo output, like you did in the fade2.gif above.

Thanks.

Delphi3

0

LVL 4

Expert Comment

ID: 8255094
Craig,
I know that you have probably moved on to the another issue. But, for the record here, testing this whole
business has been an interesting exercise. I had to literally build what you have that you didn't send along
to show the output of your program.

Your procedure blend is built on the sense that you will have to get a string of length  that is an even number or programmatically create it so that it is an even number in length.

To test your submission, and because I have D4, standard edition, I had to add to your Blend above an Edit1 which I can easily change the input of Msg and with the help of Radio group buttons easily make the various colors(6) each up to 3 possible colors arrangements. I added a full text editor with a Memo1. I added a Richedit1 (my D4 edition has no text coloring other than black)  to show a the html page being constructed, and added and IE page to display the results.

To correct the input line in Edit1.Text,  I have added a on Edit1.Exit

procedure TForm1.Edit1Exit(Sender: TObject);
var
StrLength: Integer;
begin
StrLength := Length(Edit1.Text);
Label3.Caption := IntToStr(StrLength);
if StrLength mod 2 = 1 then
begin
Edit1.Text := Edit1.Text + ' ';
Label3.Caption := 'One Space Added At End';
end;
end;

This procedure Edit1Exit by itself causes the Msg string to never reach its final selected color, because the final color is assigned to the next letter which is a space = ' ';

Hope that helps.

Delphi3

0

LVL 4

Expert Comment

ID: 8255938

Oh,

Another improvement.

Here is the Edit1Exit revised so as to stuff a space in the line should one occur within the line, if not then at the end of the line,using your Memo1 as the work area. :)

procedure TForm1.Edit1Exit(Sender: TObject);
var
OnlyOnce: Boolean;
SelPos, StrLength: Integer;
FindText, ReplaceText: string;
begin
StrLength := Length(Edit1.Text);
Label3.Caption := IntToStr(StrLength);
OnlyOnce := False;
Memo1.Clear;
Memo1.Text := Edit1.Text;
FindText := ' ';
ReplaceText := '  ';
SelPos := Pos(FindText, Memo1.Lines.Text);

if StrLength mod 2 = 1 then
begin
if ((SelPos > 0) and (OnlyOnce = False)) then
begin
Memo1.SelStart := SelPos - 1;
Memo1.SelLength := Length(FindText);
{ Replace selected text with ReplaceText }
Memo1.SelText := ReplaceText;
OnlyOnce := True;
end;
if OnlyOnce = False then
begin
Memo1.Text := Memo1.Text + ' ';
Label3.Caption := 'One Space Added At End';
end;
Edit1.Text := Memo1.Text;
Memo1.Clear;
end;
end;

Delphi3

0

Expert Comment

ID: 9316598
craig_capel:
EXPERTS:
Post your closing recommendations!  No comment means you don't care.
0

LVL 23

Accepted Solution

Ferruccio Accalai earned 260 total points
ID: 9887780
as you said in http://www.experts-exchange.com/Programming/Programming_Languages/Delphi/Q_20817451.html#9887775

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 you'd post a new question to give points to rlibby to....
0

LVL 2

Author Comment

ID: 9887904
No, i would not i never asked the question he answered in, i give the points
to whoever answers this question first come first serve basis. if both people had
0

LVL 23

Expert Comment

ID: 9887922
well it's clear...
so thanks.

F68 ;-)
0

## Featured Post

Question has a verified solution.

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

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â€¦
Introduction The parallel port is a very commonly known port, it was widely used to connect a printer to the PC, if you look at the back of your computer, for those who don't have newer computers, there will be a port with 25 pins and a small printâ€¦