Change a word Color in RichEdit

Hello

  this is sample from delphi help for finding a word in RichEdit, I just add one line to change the color of found text to red

unit Unit1;

interface

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

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

var
  Form1: TForm1;

implementation

{$R *.DFM}

procedure TForm1.Button1Click(Sender: TObject);

begin
  FindDialog1.Position := Point(RichEdit1.Left + RichEdit1.Width, RichEdit1.Top);
  FindDialog1.Execute;
end;

procedure TForm1.FindDialog1Find(Sender: TObject);
var
  FoundAt: LongInt;
  StartPos, ToEnd: Integer;
begin
  with RichEdit1 do
  begin
    if SelLength <> 0 then
      StartPos := SelStart + SelLength
    else
      StartPos := 0;
    ToEnd := Length(Text) - StartPos;
    FoundAt := FindText(FindDialog1.FindText, StartPos, ToEnd, [stMatchCase]);
    if FoundAt <> -1 then
    begin
      SetFocus;
      SelStart := FoundAt;
      SelLength := Length(FindDialog1.FindText);
// just add the color here
      RichEdit1.SelAttributes.color := clred;
    end;
  end;

end;

end.

i think i didn't explain my question
now i make my own Editor and i want to make RESERVED WORD with different Color.

i wish u get it.

Bakry

Here is an example:

To use it just drop a RichEdit, Button and EditBox onto a form the put the below code as the buttons OnClick Event. After just run it and enter the text you want to be changed into the EditBox and click on the Button.

procedure TForm1.Button1Click(Sender: TObject);
var
  CurPos, StartPos : PChar;
begin
  StartPos := PChar(RichEdit1.Text);
  CurPos := StartPos;
  RichEdit1.Lines.BeginUpdate;
  try
    repeat
      CurPos := AnsiStrPos(CurPos, PChar(Edit1.Text));
      if CurPos <> nil then
      begin
        with RichEdit1 do
        begin
          SelStart := CurPos - StartPos;
          SelLength := Length(Edit1.Text);
          SelAttributes.Color := clRed;
          Inc(CurPos);
        end;
      end;
    until
      CurPos = nil;
  finally
    RichEdit1.Lines.EndUpdate;
  end;
end;

Cheers,

Alan

Just put this code into your unit and a
TRichEdit on your form.

If you enter "Test" or "Variable" in your RichEdit
then they will be change to red.

Const
 ResWordCount : Cardinal = 0;

Var
 WordList     : TStrings;
 ResWordPos   : array of Cardinal;


Function WordWasReserved(ws : cardinal) : integer;
Var
 i : integer;

Begin
 Result := -1;

 For i := 0 to ResWordCount -1 do
  IF ws = ResWordPos[i] then
  Begin
   Result := i;
   BREAK;
  End;
End;

Procedure GetWordInfo(S : String; Pos : integer; VAR WordStart, WordLength : Integer);
Var
 i, l : Integer;
Begin
 l := Length(s);

 //Get word start
 If l = 0 then
 Begin
  WordStart    := 0;
  WordLength   := 0;
  Exit;
 End;

 IF pos = 1 then pos := 0;
 i := pos;
 While (S[i] <> ' ') and ((i) <> 0) do dec(i);
 WordStart := i;

 If i = l then
 Begin
  WordLength := 0;
  Exit;
 End;
 Inc(i);

 //Get word length
 While (S[i] <> ' ') and (i <> l) do Inc(i);
 WordLength := i - WordStart;
End;

Procedure ScanRichEdit(VAR RichEdit : TRichEdit; Words : TStrings);
Var
 xyPos                    : TPoint;
 WordStart, WordLength    : Integer;
 WordLineStartPos         : Integer;
 Word                     : string;
 WordCMP                  : string;
 i, RIdx                  : Integer;

 AddIT                    : Boolean;


Begin
 AddIt := FALSE;

 With RichEdit do
 Begin
  xyPos := CaretPos;
  GetWordInfo(Lines.Strings[xyPos.Y], xyPos.x, WordStart, WordLength);
  Word := Copy(Lines.Strings[xyPos.Y], WordStart+1, WordLength);
  IF Length(word) <> 0 then
  Begin
   IF Word[1] = ' ' then Delete(Word, 1, 1);
   IF Length(word) <> 0 then
    If Word[Length(Word)] = ' ' then Delete(Word, Length(Word), 1);
  End;

  WordLineStartPos := 0;

  For i := 0 to xyPos.Y -1 do
   WordLineStartPos := WordLineStartPos + Length(Lines.Strings[i]) +2;

  WordStart := WordLineStartPos + WordStart;



  For i := 0 to Words.Count -1 do
  Begin
   WordCMP := LowerCase(Words.Strings[i]);
   Word    := LowerCase(Word);
   //not case sensitive
   IF CompareSTR(Word, WordCMP) = 0 then
   Begin

    SetFocus;
    SelStart            := WordStart;
    SelLength           := Length(Word);
    SelAttributes.color := clred;

    SelStart            := WordLineStartPos + xyPos.x;
    SelLength           := 0;
    SelAttributes.color := clblack;

    ADDIt := TRUE
   End else
   Begin
    RIDx := WordWasReserved(wordStart);
    If (RIDx <> -1)and(not AddIT) then
    Begin
     IF RIDx < ResWordCount -1 then
      Move(ResWordPos[RIDx +1], ResWordPos[RIDx], ResWordCount -1 - RIDx);

     Dec(ResWordCount);
     SetLength(ResWordPos, ResWordCount);

     SetFocus;
     SelStart := WordStart;
     SelLength := Length(Word);
     SelAttributes.color := clblack;

     SelStart := WordLineStartPos + xyPos.x;
     SelLength := 0;
     SelAttributes.color := clblack;
    End;
   End;
  End;
 End;
 IF AddIt then
 Begin
  Inc(ResWordCount);
  SetLength(ResWordPos, ResWordCount);
  ResWordPos[ResWordCount -1] := WordStart;
 End;
End;

procedure TForm1.FormCreate(Sender: TObject);
begin
 WordList := TStringList.Create;
 With WordList do
 Begin
  Add('Test');
  Add('Variable');
 End;
end;

procedure TForm1.FormDestroy(Sender: TObject);
begin
 WordList.Free;
end;

procedure TForm1.RichEdit1Change(Sender: TObject);
begin
 ScanRichEdit(RichEdit1, WordList);
end;

You could try the below if you wanted to change text whilst it was being yped into the RichEdit:

procedure TForm1.RichEdit1Change(Sender: TObject);
var
  S : string;
  Line, I, StartPos : Integer;
const
  RWord = 'TEST';
begin
  with RichEdit1 do
  begin
    I := 0;
    StartPos := 0;
    Line := CaretPos.Y;
    S := Copy(Lines[Line], CaretPos.X - Length(RWord) + 1, Length(RWord));
    if UpperCase(S) = RWord then
    begin
      if Line > 0 then
      begin
        repeat
          StartPos := StartPos + Length(Lines[I]) + CaretPos.X - Length(RWord);
          SelStart := StartPos;
          Inc(I);
        until
          I = Line;
      end
      else
        SelStart := CaretPos.X - Length(RWord);
      SelLength := Length(RWord);
      SelAttributes.Color := clRed;
      I := 0;
      StartPos := 0;
      if Line > 0 then
      begin
        repeat
          StartPos := StartPos + Length(Lines[I]) + CaretPos.X;
          SelStart := StartPos;
          Inc(I);
        until
          I = Line;
      end
      else
        SelStart := CaretPos.X;
      SelAttributes.Color := clBlack;
    end;
  end;
end;

listening

ok guys
  a minute to Test your code

bakry

bugroger : ur Code is good. but what about end of words?
i mean if the word is Reserved and end of it is non alpha char eg :
  Variable (Colored)
  Varable, (not colored)
  .Variable (Not Colored)
ect..

bakry
 

heeeeeeeeeeeeeey
where r u?

This will be my last comment.
I reduce the flicker.
But there is still another way.
-> look at delphi !



USes RichEdit;

Const
 EnterPressed : Boolean = FALSE;
 SpacePressed : Boolean = FALSE;


Var
 WordList                 : TStrings;

Procedure GetWordInfo(S : String; Pos : integer; VAR WordStart, WordLength : Integer);
Var
 i, l : Integer;
Begin
 l := Length(s);

 //Get word start
 If l = 0 then
 Begin
  WordStart    := 0;
  WordLength   := 0;
  Exit;
 End;

 IF pos = 1 then pos := 0;
 i := pos;
 //              vvvvvvvvvvvvvvvvv can be highlighted
 While (S[i] in ['a'..'z','A'..'Z']) and ((i) <> 0) do dec(i);
 WordStart := i;

 If i = l then
 Begin
  WordLength := 0;
  Exit;
 End;
 Inc(i);

 //Get word length
 //              vvvvvvvvvvvvvvvvv can be highlighted
 While (S[i] in ['a'..'z','A'..'Z']) and (i <> l) do Inc(i);
 WordLength := i - WordStart;
End;


Function GetWordLineStartPos(VAR RichEdit : TRichEdit; Y : integer) : integer;
Var
 i : Integer;

Begin
 Result := 0;
 For i := 0 to Y -1 do
  Result := Result + Length(RichEdit.Lines.Strings[i]) +2;
End;


Procedure ScanRichEdit(VAR RichEdit : TRichEdit; Words : TStrings; _xyPos : TPoint);
Var
 xyPos                    : TPoint;
 WordStart, WordLength    : Integer;
 WordLineStartPos         : Integer;
 Word                     : string;
 WordCMP                  : string;
 i, RIdx                  : Integer;

 AddIT                    : Boolean;


Begin
 AddIt := FALSE;

 With RichEdit do
 Begin
  xyPos := _xyPos;
  GetWordInfo(Lines.Strings[xyPos.Y], xyPos.x, WordStart, WordLength);
  Word := Copy(Lines.Strings[xyPos.Y], WordStart+1, WordLength);
  IF Length(word) <> 0 then
  Begin
   IF Word[1] = ' ' then Delete(Word, 1, 1);
   IF Length(word) <> 0 then
    If Word[Length(Word)] = ' ' then Delete(Word, Length(Word), 1);
  End;

  WordLineStartPos := GetWordLineStartPos(RichEdit, xyPos.y);
  WordStart := WordLineStartPos + WordStart;


  ADDIt := FALSE;
  For i := 0 to Words.Count -1 do
  Begin
   WordCMP := LowerCase(Words.Strings[i]);
   Word    := LowerCase(Word);
   //not case sensitive
   IF CompareSTR(Word, WordCMP) = 0 then
   Begin

    SelStart            := WordStart;
    SelLength           := Length(Word);
    SelAttributes.Style := [fsBold];
    SelAttributes.color := clred;

    ADDIt := TRUE
   End else
   IF not ADDit then
   Begin

     //Set normal Color, Style

     SelStart := WordStart;
     SelLength := Length(Word);
     SelAttributes.Style := [];
     SelAttributes.color := clblack;
    End;
   End;
 End;
End;


procedure TForm1.FormCreate(Sender: TObject);
begin
 WordList := TStringList.Create;
 With WordList do
 Begin
  Add('procedure');
  Add('function');
  Add('with');
  Add('do');
  Add('for');
  Add('while');
  Add('begin');
  Add('end');
  Add('repeat');
  Add('until');
  Add('to');
 End;
end;

procedure TForm1.FormDestroy(Sender: TObject);
begin
 WordList.Free;
end;

procedure TForm1.RichEdit1Change(Sender: TObject);
Var
 P, OldP : TPoint;
 OldSel, OldSelLen : Integer;

begin
 lockwindowupdate(richedit1.handle);                   //do not update
// richedit1.Perform(EM_HIDESELECTION,Integer(true),0);  //show no selection

 With RichEdit1 do
 Begin
  SetFocus;
  P         := CaretPos;
  OldP      := P;
  OldSel    := SelStart;
  OldSelLen := SelLength;


  ScanRichEdit(RichEdit1, WordList, P);

  IF EnterPressed then
  Begin
   EnterPressed := FALSE;
   P.y := P.y -1;
   P.x := Length(Lines.Strings[P.y]);
   ScanRichEdit(RichEdit1, WordList, P);
  End else
  IF SpacePressed then
  Begin
   SpacePressed := FALSE;
   Dec(P.x);
   ScanRichEdit(RichEdit1, WordList, P);
  End;

  //Set Old Position, normal Color, Style

  SelStart  := OldSel;
  SelLength := OldSelLen;

  SelAttributes.Style := [];
  SelAttributes.color := clblack;
 End;
// richedit1.Perform(EM_HIDESELECTION,Integer(False),0);
 lockwindowupdate(0);
end;

procedure TForm1.RichEdit1KeyDown(Sender: TObject; var Key: Word;
  Shift: TShiftState);
begin
 IF Key = vk_Return then EnterPressed := TRUE;
 IF Key = vk_Space  then SpacePressed := TRUE;
end;

it's a good answer but i have some notes
there is a delay , it work only while typing in RichEdit... i mean if you paste atext from other memo it doesn't work (or LoadFromFile).

thanks full
bakry