?
Solved

Math Problem (Not homework!)

Posted on 2003-03-26
14
Medium Priority
?
344 Views
Last Modified: 2010-04-04
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
Comment
Question by:craig_capel
[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
  • Learn & ask questions
  • 7
  • 4
  • 2
  • +1
14 Comments
 
LVL 4

Expert Comment

by:delphi3
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

by:craig_capel
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

by:craig_capel
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
Industry Leaders: 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!

 
LVL 4

Expert Comment

by:delphi3
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

by:delphi3
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

by:craig_capel
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

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

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';
Msg:='This is a test fade';

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...


Thanks for all your help....



0
 
LVL 4

Expert Comment

by:delphi3
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

by:delphi3
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.
 
If you can please:
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.


Please send that info to my email address.   bherbst65@hotmail.com

Thanks.

Delphi3

0
 
LVL 4

Expert Comment

by:delphi3
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

by:delphi3
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

by:CleanupPing
ID: 9316598
craig_capel:
This old question needs to be finalized -- accept an answer, split points, or get a refund.  For information on your options, please click here-> http:/help/closing.jsp#1 
EXPERTS:
Post your closing recommendations!  No comment means you don't care.
0
 
LVL 23

Accepted Solution

by:
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

by:craig_capel
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
posted to my thread with the answer that would be different.
0
 
LVL 23

Expert Comment

by:Ferruccio Accalai
ID: 9887922
well it's clear...
so thanks.

F68 ;-)
0

Featured Post

On Demand Webinar: Networking for the Cloud Era

Ready to improve network connectivity? Watch this webinar to learn how SD-WANs and a one-click instant connect tool can boost provisions, deployment, and management of your cloud connection.

Question has a verified solution.

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

In this tutorial I will show you how to use the Windows Speech API in Delphi. I will only cover basic functions such as text to speech and controlling the speed of the speech. SAPI Installation First you need to install the SAPI type library, th…
Hello everybody This Article will show you how to validate number with TEdit control, What's the TEdit control? TEdit is a standard Windows edit control on a form, it allows to user to write, read and copy/paste single line of text. Usua…
In this video you will find out how to export Office 365 mailboxes using the built in eDiscovery tool. Bear in mind that although this method might be useful in some cases, using PST files as Office 365 backup is troublesome in a long run (more on t…
In this video, Percona Solution Engineer Rick Golba discuss how (and why) you implement high availability in a database environment. To discuss how Percona Consulting can help with your design and architecture needs for your database and infrastr…
Suggested Courses
Course of the Month15 days, 17 hours left to enroll

743 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