TRichEdit and Colors

unit Unit1_Q_21136532;

interface

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

type
  TForm1 = class(TForm)
    RichEdit: TRichEdit;
    ButtonRed: TButton;
    ButtonBlack: TButton;
    ButtonColor: TButton;
    procedure ButtonRedClick(Sender: TObject);
    procedure ButtonBlackClick(Sender: TObject);
    procedure ButtonColorClick(Sender: TObject);
  private   { Private declarations }
  public    { Public declarations }
    procedure ColoringAWord(S: string; C: TColor);
    procedure AWordInRed(S: string; C,CRest: TColor);
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

procedure TForm1.ColoringAWord(S: string; C: TColor);
var
  P:      Integer;
  L:      Integer;
  T:      string;
begin
  T := RichEdit.Text;
  L := Length(S);
  P := Pos(S, T);
  while (P>0) do
  begin
    RichEdit.SelStart := P-1;
    RichEdit.SelLength := L;
    RichEdit.SelAttributes.Color := C;
    P := PosEx(S, T, P+L);
  end;
  RichEdit.SelLength := 0;
end;

procedure TForm1.AWordInRed(S: string; C,CRest: TColor);
var
  I:      Integer;
  L:      Integer;
  N:      Integer;
  P:      Integer;
  LL:     Integer;
  PN:     Integer;
  T:      string;
begin
  LL := 0;
  PN := 0;
  T := RichEdit.Text;
  L := Length(S);
  P := Pos(S, T);
  while (P>0) do
  begin
    N := 0;
    for I := 0 to RichEdit.Lines.Count-1 do
    begin
      LL := Length(RichEdit.Lines[I]);
      N := N + LL;
      if (N>P) then
      begin
        PN := Pos(S, RichEdit.Lines[I]);
        Break;
      end;
    end;
    RichEdit.SelStart := P-1;
    RichEdit.SelLength := L;
    RichEdit.SelAttributes.Color := C;
    RichEdit.SelStart := P+Length(S)-1;
    RichEdit.SelLength := LL - L - PN + 1;
    RichEdit.SelAttributes.Color := CRest;
    P := PosEx(S, T, P+L);
  end;
  RichEdit.SelLength := 0;
end;

procedure TForm1.ButtonRedClick(Sender: TObject);
var
  T:      string;
begin
  T := RichEdit.Text;
  RichEdit.SelStart := 0;
  RichEdit.SelLength := Length(T);
  RichEdit.SelAttributes.Color := clBlack;
  RichEdit.SelLength := 0;
  AWordInRed('[BNET]', clRed, clBlue);
end;

procedure TForm1.ButtonColorClick(Sender: TObject);
var
  T:      string;
begin
  T := RichEdit.Text;
  RichEdit.SelStart := 0;
  RichEdit.SelLength := Length(T);
  RichEdit.SelAttributes.Color := clGreen;
  RichEdit.SelLength := 0;
  ColoringAWord('[BNET]', clFuchsia);
end;

procedure TForm1.ButtonBlackClick(Sender: TObject);
var
  T:      string;
begin
  T := RichEdit.Text;
  RichEdit.SelStart := 0;
  RichEdit.SelLength := Length(T);
  RichEdit.SelAttributes.Color := clBlack;
  RichEdit.SelLength := 0;
end;

end.

//........

object Form1: TForm1
  Left = 224
  Top = 128
  Width = 696
  Height = 480
  Caption = 'Coloring a word'
  Color = clBtnFace
  Font.Charset = DEFAULT_CHARSET
  Font.Color = clWindowText
  Font.Height = -11
  Font.Name = 'MS Sans Serif'
  Font.Style = []
  OldCreateOrder = False
  PixelsPerInch = 96
  TextHeight = 13
  object RichEdit: TRichEdit
    Left = 0
    Top = 38
    Width = 688
    Height = 408
    Align = alBottom
    Font.Charset = RUSSIAN_CHARSET
    Font.Color = clWindowText
    Font.Height = -11
    Font.Name = 'Courier New'
    Font.Style = []
    Lines.Strings = (
      '[BNET]Sent: SID_AUTH_INFO'
     
        '0000: FF 50 3A 00 00 00 00 00 36 38 58 49 50 58 33 57 .P:.....68' +
        'XIPX3W'
     
        '0010: 10 00 00 00 53 55 6E 65 18 BA 00 A6 F0 00 00 00 ....SUne..' +
        '......'
     
        '0020: 09 04 00 00 09 04 00 00 55 53 41 00 55 6E 69 74 ........US' +
        'A.Unit'
      '0030: 65 64 20 53 74 61 74 65 73 00 ed States. '
      '[BNET]Recv: SID_PING'
      '0000: FF 25 08 00 55 12 05 BE .%..U... ')
    ParentFont = False
    TabOrder = 0
  end
  object ButtonRed: TButton
    Left = 8
    Top = 8
    Width = 80
    Height = 25
    Caption = 'Red'
    TabOrder = 1
    OnClick = ButtonRedClick
  end
  object ButtonBlack: TButton
    Left = 192
    Top = 8
    Width = 80
    Height = 25
    Caption = 'Black'
    TabOrder = 2
    OnClick = ButtonBlackClick
  end
  object ButtonColor: TButton
    Left = 100
    Top = 8
    Width = 80
    Height = 25
    Caption = 'Color'
    TabOrder = 3
    OnClick = ButtonColorClick
  end
end

download example from:
page:        http://www.geocities.com/esoftbg/
  link:        Q_21136532.zip

I found plenty of examples on how to search and change the color of items at a specific line, but I really want something that will let me change the color of just one line of text as I add it on and let is stay that color as it scrolls up.

Also, is there a way to make it so that only the 0000: 00 00 00 00 lines are mono spaced, but the rest are not?

Ideally I'd like something like, maybe,

procedure WriteC(S: String; C : TColor = clBlack; F : TFont = SomeDefaultFont);
and a Writeln() that will do the same, but will compile the line and display it in the TRichEdit or something.

WriteC('Some Text in red, ',clRed);
WriteLnC(' and some more text in black.');

Is something like this doable?  I don't think it is very efficient to search the whole stringlist everytime a line is added.

If I do something like this, the rest of the memo changes to the same color and only the last word I set is the correct color...

procedure TForm1.Button1Click(Sender: TObject);
var
  T,S:      string;
  B: Integer;
begin

  T := RichEdit.Text;
  B := Length(T);
  S := 'Another Test';
  RichEdit.Text := T + S;
  RichEdit.SelStart := B;
  RichEdit.SelLength := Length(S);
  RichEdit.SelAttributes.Color := clRed;

  T := RichEdit.Text;
  B := Length(T);
  S := '- Another Test';
  RichEdit.Text := T + S;
  RichEdit.SelStart := B;
  RichEdit.SelLength := Length(S);
  RichEdit.SelAttributes.Color := clBlue;
  RichEdit.Lines.Add('')
end;

I'm guessing setting .text resets the color information so that the whole memo is the same color.  I'd really hate to have to make a list of where colors should start and end.

What about doing something with RTF codes {}'s?  Can that be done?

I was playing with this.  I get some results out of it, but I get an error that I don't know if I should just be suppressing with the try .. except wrap.  Plus it seems rather long way of doing things...

  S := '{\rtf1\ansi\ansicpg1252\deff0\deflang1033{\fonttbl{\f0\fswiss\fcharset0 Arial;}}'
       +'{\colortbl ;\red255\green0\blue0;}{\*\generator Msftedit 5.41.15.1507;}\viewkind4\uc1\pard\f0\fs20\par [22:27:40] <Beam[1G]> 5.61 gogogogo\par [22:27:42] <\cf1 Beam[1G]>\cf0  f00s\par [22:27:48] <StolenHitman> is it me or 5.62 lagging more?\par}';
  try
  RichEdit.Lines.Add(S);
  except
  end;

download the example again:

unit Unit1_Q_21136532;

interface

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

type
  TForm1 = class(TForm)
    RichEdit: TRichEdit;
    ButtonBlack: TButton;
    ButtonColor: TButton;
    Button1: TButton;
    Button2: TButton;
    Button3: TButton;
    Button4: TButton;
    Edit1: TEdit;
    Edit2: TEdit;
    Edit3: TEdit;
    Edit4: TEdit;
    procedure ButtonBlackClick(Sender: TObject);
    procedure ButtonColorClick(Sender: TObject);
    procedure Button1Click(Sender: TObject);
  private   { Private declarations }
  public    { Public declarations }
    procedure ColoringAWord(S: string; F: TFont);
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

procedure TForm1.ColoringAWord(S: string; F: TFont);
var
  P:      Integer;
  L:      Integer;
  T:      string;
begin
  T := RichEdit.Text;
  L := Length(S);
  P := Pos(S, T);
  while (P>0) do
  begin
    RichEdit.SelStart := P-1;
    RichEdit.SelLength := L;
    RichEdit.SelAttributes.Assign(F);
    P := PosEx(S, T, P+L);
  end;
  RichEdit.SelLength := 0;
end;

procedure TForm1.ButtonColorClick(Sender: TObject);
var
  F:      TFont;
  T:      string;
begin
  T := RichEdit.Text;
  RichEdit.SelStart := 0;
  RichEdit.SelLength := Length(T);
  RichEdit.SelAttributes.Color := clBlue;
  RichEdit.SelLength := 0;
  F := TFont.Create;
  try
    F.Name := 'Times New Roman';
    F.Height := 9;
    F.Size := -16;
    F.Color := clRed;
    F.Style := [fsBold, fsUnderline];
    ColoringAWord('[BNET]', F);
    F.Name := 'MS Sans Serif';
    F.Height := 11;
    F.Size := -12;
    F.Color := clFuchsia;
    F.Style := [fsBold,fsItalic];
    ColoringAWord('Connected to server.', F);
  finally
    F.Destroy;
  end;
end;

procedure TForm1.ButtonBlackClick(Sender: TObject);
var
  T:      string;
begin
  T := RichEdit.Text;
  RichEdit.SelStart := 0;
  RichEdit.SelLength := Length(T);
  RichEdit.SelAttributes.Color := clBlack;
  RichEdit.SelLength := 0;
end;

procedure TForm1.Button1Click(Sender: TObject);
var
  P:      Integer;
  S:      string;
  T:      string;
  R:      string;
begin
  if (Sender.ClassType=TButton) then
  begin
    case (Sender as TButton).Tag of
      1: S := Edit1.Text;
      2: S := Edit2.Text;
      3: S := Edit3.Text;
      4: S := Edit4.Text;
    end;
    P := Pos(' ', S);
    while (P>0) do
    begin
      T := S[P-2] + S[P-1];
      R := S[P+1] + S[P+2];
      if ((T='0:') or (T='00')) and (R='00') then
      begin
        Delete(S, P, 1);
        P := PosEx(' ', S, P);
      end
      else
        P := 0;
    end;
    RichEdit.Lines.Add(S);
    ButtonColorClick(Self);
  end;
end;

end.

esoftbq,

Your code looks liek it works great, but I don't want to have to re-colorized the entire memo just to add one line of text.  I'll look into both things tonight.  I do, however, appreciate any and all help and will still provide points accordingly.

As of right now, though haven't looked at recent things in detail yet, haven't found a solution.

esoftbg,
Alright, I tried it.  It seems to "work", but not very desirable.  It is extremely flickery and doesn't seem like a very practically way to do it concidering it would involve a lot of coding.

Evarest,
I haven't tried your code yet, but it looks like it doesn't allow for making a line that has many different color text on it.  I was thinking of using WriteC() to store the text and colors in the buffer, and when it does a WriteCLn() it then adds the line of text with the appropriate coloring.

Anyway,
I will see if I can take pieces of code here and put it to some good use, but for now I am still searching for a "better way", even if it does not currently exist.

Through my own experimentation, I have been able to use RTF codes instead of the selection and color process, just I get some errors that I don't know if I should ignore or not with the try...except wrapping.

Let me ask this though,
Can I add a line of text without recoloring the text that has already been added?  It just seems a waste of searching and recoloring if it does not need to do that.  Apparently it seems that as long as I don't touch the .text property, it leaves what is there alone.  I've got to be able to use that some how.

werehamster-,
It is possible to be colorized only the just-added text. I am starting to develope that ....

I have been spending the last couple of hours seeing if I could find source for forum code or something...

I was thinking if I could do something that would let me do something like...

The [color=red]apple[/color] was good.

... it would be perfect.  Maybe something a little more simple than that though.

Another thing with RichEdit control that is bugging me out is that when you add a new line of text, the screen does not follow it.  It goes off the screen while you are still looking at the first lines.

Also, I've been playing with RTF some more.  I can get it to work that way as well, but I keep getting errors everytime I put a line in.  I use try..except to suppress it, but dunno if this is the best way.  It seems rather complex.

Even if I can use something other than a RichEdit control, all i really want to do is diplay text in different colors without using any fancy keyword scheme or whatever.  Like old turbo pascal days, but can be used just like a Memo from the user's standpoint where they can cut and paste.

SetColor(Red);
Write('[BNET]');
SetColor(Black);
Writeln('Connected.');

I am sure someone has done this before.  It doesn't seem like something that would have gone unnoticed.

procedure AddColorLine (RichEdit : TRichEdit; Str : String; Color : TColor);
var
  pos_start      : Integer;
  pos_end        : Integer;
  old_SelAttr    : TTextAttributes;
begin
  // take the old SelAttributes
  old_SelAttr := RichEdit.SelAttributes;
  // get the end pos
  pos_start := length(RichEdit.Text);
  // add the text
  RichEdit.Lines.Add(Str);
  // the the new end position
  pos_end := length(RichEdit.Text);
  // colorize the text
  RichEdit.SelStart := pos_start;
  RichEdit.SelLength := pos_end - pos_start;
  RichEdit.SelAttributes.Color := Color;
  // put back the old attributes
  RichEdit.SelAttributes := old_SelAttr;
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
  AddColorLine(RichEdit1, 'Hello world!', clGreen);
  AddColorLine(RichEdit1, 'RedLine!', clRed);
end;

I just thought you may need something additional like bold or italic... This is the same produre as above, but with some more features :)))
-----------------------------------------------------------------------------------------------

procedure AddColorLine (RichEdit : TRichEdit; Str : String; Color : TColor;
  IsBold : Boolean = False; IsItalic : Boolean = False);
var
  pos_start      : Integer;
  pos_end        : Integer;
  old_SelAttr    : TTextAttributes;
begin
  // take the old SelAttributes
  old_SelAttr := RichEdit.SelAttributes;
  // get the end pos
  pos_start := length(RichEdit.Text);
  // add the text
  RichEdit.Lines.Add(Str);
  // the the new end position
  pos_end := length(RichEdit.Text);
  // colorize the text
  RichEdit.SelStart := pos_start;
  RichEdit.SelLength := pos_end - pos_start;
  RichEdit.SelAttributes.Color := Color;
  // set bold
  if IsBold then
    RichEdit.SelAttributes.Style := RichEdit.SelAttributes.Style + [fsBold];
  // set italic
  if IsItalic then
    RichEdit.SelAttributes.Style := RichEdit.SelAttributes.Style + [fsItalic];
  // put back the old attributes
  RichEdit.SelAttributes := old_SelAttr;
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
  AddColorLine(RichEdit1, 'Hello world!', clGreen, True);
  AddColorLine(RichEdit1, 'RedLine!', clRed, False, True);
end;

Anyway, fornot, I am using...

procedure TBNETReader.DoDisplayString;
begin
  FForm.OutputBox.SelAttributes.Color := fDisplayColor;
  fForm.OutputBox.Lines.Add(fDisplayString)
end;

procedure TBNETReader.DisplayString(AString:String; Color : TColor = clBlack);
begin
  fDisplayString := AString;
  fDisplayColor := Color;
  synchronize(DoDisplayString);
end;

It seems to work well for my purposes (for now), but I would still like to be able to make just part of the string one color.  maybe embed some codes into the AString which is ommited when displayed, but used after the line is displayed to add color to 1 word or something.  Plus I still want the ability to change the font spacing to monospacing when I display dumps and stuff.  Any help with this?

DisplayString('Some Text '+DoColor(clRed)+'Red'+doColor(clDefault)+' something '+doFont(myFont)+'different.');

where doColor() and doFont() are functions that return a string with embedded codes to tell where to change colors and stuff.

download example again from:
page:        http://www.geocities.com/esoftbg/
  link:        Q_21136532.zip

//........

unit Unit1_Q_21136532;

interface

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

type
  TForm1 = class(TForm)
    RichEdit: TRichEdit;
    Button1: TButton;
    Button2: TButton;
    Button3: TButton;
    Button4: TButton;
    Edit1: TEdit;
    Edit2: TEdit;
    Edit3: TEdit;
    Edit4: TEdit;
    procedure Button1Click(Sender: TObject);
  private   { Private declarations }
    OldLinesCount:    Integer;
    OldLegth:         Integer;
  public    { Public declarations }
    procedure AWordColoring(S: string; F: TFont; FR: TFont);
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

procedure TForm1.AWordColoring(S: string; F: TFont; FR: TFont);
var
  C:      Integer;
  L:      Integer;
  P:      Integer;
  T:      string;
begin
  C := 0;
  T := RichEdit.Text;
  L := Length(S);
  P := Pos(S, T);
  while (P>0) do
  begin
    if (P>OldLegth) then
    begin
      Inc(C);
      RichEdit.SelStart := P - 1;
      RichEdit.SelLength := L;
      RichEdit.SelAttributes.Assign(F);
      RichEdit.SelStart := P + L - 1;
      RichEdit.SelLength := Length(T) - OldLegth - L + 1;
      RichEdit.SelAttributes.Assign(FR);
      OldLegth := OldLegth + L;
    end;
    P := PosEx(S, T, P+L);
  end;
  if (C=0) then
  begin
    RichEdit.SelStart := OldLegth+1;
    RichEdit.SelLength := Length(T) - OldLegth + 1;
    RichEdit.SelAttributes.Assign(FR);
  end;
  RichEdit.SelLength := 0;
end;

procedure TForm1.Button1Click(Sender: TObject);
var
  P:      Integer;
  F:      TFont;
  FR:     TFont;
  S:      string;
  T:      string;
  R:      string;
begin
  if (Sender.ClassType=TButton) then
  begin
    case (Sender as TButton).Tag of
      1: S := Edit1.Text;
      2: S := Edit2.Text;
      3: S := Edit3.Text;
      4: S := Edit4.Text;
    end;
    P := Pos(' ', S);
    while (P>0) do
    begin
      T := S[P-2] + S[P-1];
      R := S[P+1] + S[P+2];
      if ((T='00') and (R='00')) then
      begin
        Delete(S, P, 1);
        P := PosEx(' ', S, P);
      end
      else
        P := 0;
    end;

    OldLegth := Length(RichEdit.Text);
    OldLinesCount := RichEdit.Lines.Count;
    RichEdit.Lines.Add(S);

    F := TFont.Create;
    try
      FR := TFont.Create;
      try
        FR.Size := 12;
        FR.Color := clBlue;
        FR.Style := [fsBold];

        F.Name := 'Times New Roman';
        F.Size := 12;
        F.Color := clRed;
        F.Style := [fsBold, fsUnderline];
        AWordColoring('[BNET]', F, FR);
        F.Name := 'MS Sans Serif';
        F.Size := 12;
        F.Color := clFuchsia;
        F.Style := [fsBold,fsItalic];
        AWordColoring('Connected to server.', F, FR);
      finally
        FR.Destroy;
      end;
    finally
      F.Destroy;
    end;
  end;
end;

end.

It is looking more promising now actually.  Though I still have some problems with it.  It is keeping the view at the top of the memo and not automatically scrolling down after a line is added.

Also, instead of searching for fixed words like 'BNET' and stuff, i think it could probalbly be changed to look between keywords in the string.

So what if we had a string

'The quick brown fox jumps over the lazy dog. The quick brown fox jumps over the lazy dog.'

if we wanted the word 'dog' to be colorized, we could do something like this...

'The quick brown fox jumps over the lazy dog. The quick brown fox jumps over the lazy [$C00FF000000]dog[$C...].'

'... the lazy '+DoColor(clBlue)+'dog'+DoColor(clDefault)+'.'

which would do a WordColoring('dog',...);

but if I had more than one of the say word, but only wanted one colorized, there would be a problem with your function I think.

So what if we did some kind of list of positions based on keywords in the string that get ommited before added, and then colorized.  But only on the last line added and not the whole memo field, but retained the prior colors?  Perhaps something with font data instead of just color.  The function could strip the data of all the codes, add the line, then use the codes to colorize it.  If I'm repeating myself it is because it is 3am.  :)

Take a look at:

    if (P>OldLegth) then
    begin
      Inc(C);
This means that my code works only with new added line ....

And about the 'dog' lazy or not it is possible to be colorized only the first ot the specified count of it ....
Just wait a little bit ....

Just and idea ... you can use TWebBrowser + regular expressions...

with the regular expression you can replace
[B]some text[/B]

with
<STRONG>some text</STRONG>

just like this is done in the Forums and Bulletin Boards. This practise is called "BBCodes"...

pleaese download the example again.... it can select 1 or two 'dogs' ....

I can understand your code and how it works, but it seems to be something that will be cumbersome to actually use in a program that uses all sorts of different colors and stuff.  You are making me add like 12 lines of code to like 100 spots in my program.

I need simplicity.

I supposed I could do some of it in a wrapper somehow.

TC('Blah',Color, TC(' more blah',Color2,NIL));

bah, too complicated.  :)

I am going to make the code more simply. I have an idea ....

I see the quick changes you made, just the AWordColoring is not practical if you are trying to colorize all different parts of the program and there is a possiblity that a user can manually type in keywords and stuff that would normally be colorized, but shouldn't be in certain situations and stuff.

It is, however, giving me ideas to improve upon.  I'm just not good with string manipulation in delphi all that much.

Ok, this is largely untested as I wrote this in this topic instead of in the editor, but tell me what you think about this...  Perhaps if it looks promising, someone could fix it up.  I got some other work I gotta do now.  :)

procedure DisplayString(S: String);
var
  SelStart, SelLength,P : Integer;
  Stripped : String;
  C : TColor;
repeat
  P := PosEx('[$',AString,1) ; // [$00000000]
  If P > 0 then
    begin
      Stripped := Left(S,P) + Right(S, Length(S)-(P+11)  // prolly errors on this line
      SelStart :- OldLength + P;
      SelLength := Length(stripped) - P;
      P := PosEx('[$',Stripped,1);

      TByteArray(C)[0] := ord(S[P+2]);
      TByteArray(C)[1] := ord(S[P+3]);
      TByteArray(C)[2] := ord(S[P+4]);
      TByteArray(C)[3] := ord(S[P+5]);

      If P = 0 then P := Length(Stripped);
      DisplayString(Stripped);
     
      RE.SelStart := SelStart;
      RE.Length := SelLength;
      RE.Color := C;
end;

oh, forgot something like...

    end
    else addline(S);

If ya got ICQ 33957229 or AIM/MSN: stevenjmorales@aol or yahoo:korotish, feel free to drop me a chat.

Hmm, if I am using Ords() would only be 4 bytes long I guess, not 8.  which would make the stripped right be like P+7 instead of 11.  Anyway, I am going to see if I can make this work.

Recursive stuff can be funny sometimes, so if ya got a better way, I'm all eyes.

pleaese download the example again.... it is a super simply example ....

But you don't must to use the example with TEdits, I am using it this way to be more easy the testing ....
On FormCreate event it fills the dynamic array of 3 words (you can change it in your needs)....
Then every call of the procedure is very, very simple:

    AWordColoring(ColorWordArr, NewS, N);

ColorWordArr is filled at FormCreate();
You send only 2 params:
  -  NewS - string to be added and colored
  -  How many times to be colored

Emil

ok, check this out....  :)


unit Unit1;

interface

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

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

  TByteArray = array[word] of byte;

var
  Form1: TForm1;

implementation

{$R *.dfm}



procedure DisplayString(S: String; Offset : integer = 0);
var
  SelStart, SelLength,P : Integer;
  Stripped : String;
  AColor : TColor;
  OldLength : Integer;

begin
  OldLength := Length(Form1.RichEdit1.text);
  P := PosEx('[$',S,1) ; // [$00000000]
  If P > 0 then
    begin
      SelStart := OldLength+P-1;
      AColor := StrToInt(MidStr(S,P+1,9));
      Stripped := LeftStr(S,P-1)+RightStr(S, Length(S)-(P+10));  // prolly errors on this line
      SelLength := PosEx('[$',Stripped,1)-1;
      If SelLength <= 0 then SelLength := Length(stripped);

      DisplayString(Stripped,SelLength);

      Form1.RichEdit1.SelStart := SelStart-Offset;
      Form1.RichEdit1.SelLength := SelLength;
      Form1.RichEdit1.SelAttributes.Color := AColor;
    end
    else Form1.RichEdit1.Lines.Add(S);

end;



function doColor(C:TColor) : string;
begin
  result := '[$'+IntToHex(C,8)+']';
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
  DisplayString(Edit1.Text);
  DisplayString(doColor(clGreen)+'test green');
  DisplayString(doColor(clblue)+'test blue '+doColor(clRed)+'test red '+doColor(clskyblue)+'test skyblue ');
end;

end.

Ivanov_G,
To solve your ever changing string length, just use recursion with a returned offset like I did.

esoftbg,
Your examples pretty much taught me how to use the richedit methods correctly.  Kinda inspired me to make my idea work.

I just need to know how to get the damn thing to scroll to the bottom when a line is added instead of just seeing the beginning the whole time and having to scroll down yourself.

The fixed and proportional fonts need some working with also.  But i suppose I could set the font to it before I call dodisplay and then set it back afterwards for the few times that I actually would use it.  I just am still not sure how to even change to fixed and proportional fonts.  I know it can be changed in the memo fields, but can I have both?

Also, I gotta make this thread safe too.  :)

> I just need to know how to get the damn thing to scroll to the bottom when a line is added instead of just seeing the  beginning the whole time and having to scroll down yourself.


didn't you see my last example ?
This code solves the problem with scrolling down to the end of the text:

  RichEdit.HideSelection := False; // This I made at design time by ObjectInspector
  RichEdit.SelStart := Length(RichEdit.Text);
  RichEdit.SelLength := 0;

>> This code solves the problem with scrolling down to the end of the text:

Actually, I *WANT* it to scroll to the end of the text.  I want to always see the last newly made line if it was at the last line.  I might want it not to do that if I scrolled up myself to look at what has been logged.

Ignore last comment.  :)  Didn't realize it worked in the last sample.  Let me see how it was done.

Anyway, feel free to download my version at...
www.datazap.net/ftp/werehamster/MyBot/REColor.zip

It still needs some work.

Just gonna keep the topic open a little longer just incase anyone wants to toss in a few ideas.

Oooops,
It is needed for the scrolling down to the end of the text:
  RichEdit.ScrollBars := ssBoth; // or RichEdit.ScrollBars := ssVertical;

I am still not getting it to stay at the bottom.  Hmm.

Please remove this line below. It is work fine whithout it ....
      Form1.RichEdit1.SetFocus;

You can break up the text (i.e. referring to you write and writeln type examples) using the #13#10 pair in your string e.g.  passing this as your string will add the text in two separate lines:

SomeText:= 'Line1'#13#10'Line2';

To scroll the Richedit control to the caretpos after inserting text, change the above function to the following:

procedure AddRTFString(r: TRichEdit; F: TFont; T: string; Overwrite, AddEOL: Boolean);
var SaveStart, SaveLen, sPos, wPrm: integer;
begin
  if Overwrite then r.SelText:= '';
  if AddEOL then t:= t+#13#10;
  r.SelLength:= 0;
  SaveStart:= r.SelStart;
  r.Perform(EM_REPLACESEL, LongInt(TRUE), LongInt(pchar(T)));
  SaveLen:= r.SelStart - SaveStart;
  r.SelStart:= SaveStart; r.SelLength:= SaveLen;
  r.SelAttributes.Assign(F);
  r.SetFocus;

  sPos:= r.Perform(EM_LINEINDEX, -1, 0);
  wPrm:= SB_THUMBPOSITION +                     //scrollCode in low word
         sPos SHL 16; //line number in high word
  if (SetScrollPos(r.Handle, SB_VERT, sPos, True) <>-1)
    then r.Perform(EM_SCROLLCARET,0,0);
end;



Also, I'm just curious. My solution is everything you asked for, why only 25 of the 500 points?