Solved

Change a word Color in RichEdit

Posted on 2001-06-10
12
1,049 Views
Last Modified: 2013-11-22
hi all
i want a simple procedure to change a word or wards color in RichEdit.
simple procedure or other:)
bakry
0
Comment
Question by:bakry99
  • 5
  • 3
  • 2
  • +2
12 Comments
 
LVL 22

Expert Comment

by:mnasman
ID: 6172902
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.
0
 
LVL 1

Author Comment

by:bakry99
ID: 6172958
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
0
 
LVL 5

Expert Comment

by:alanwhincup
ID: 6173338
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
0
 
LVL 2

Expert Comment

by:bugroger
ID: 6173572
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;
0
 
LVL 5

Expert Comment

by:alanwhincup
ID: 6173595
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;
0
 
LVL 3

Expert Comment

by:lopem
ID: 6174314
listening
0
Top 6 Sources for Identifying Threat Actor TTPs

Understanding your enemy is essential. These six sources will help you identify the most popular threat actor tactics, techniques, and procedures (TTPs).

 
LVL 1

Author Comment

by:bakry99
ID: 6176049
ok guys
  a minute to Test your code

bakry
0
 
LVL 1

Author Comment

by:bakry99
ID: 6176491
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
 
0
 
LVL 1

Author Comment

by:bakry99
ID: 6180640
heeeeeeeeeeeeeey
where r u?
0
 
LVL 2

Accepted Solution

by:
bugroger earned 100 total points
ID: 6180917
Here is my new code.

There must be another way to change the
text format to reduce the flicker.



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

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

    ADDIt := TRUE
   End else
   IF not ADDit then
   Begin

     //Set normal Color, Style
     SetFocus;
     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;

begin
 With RichEdit1 do
 Begin
  P    := CaretPos;
  OldP := P;

  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            := GetWordLineStartPos(RichEdit1, OldP.Y) + OldP.X;
  SelLength           := 0;
  SelAttributes.Style := [];
  SelAttributes.color := clblack;
 End;
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;

0
 
LVL 2

Expert Comment

by:bugroger
ID: 6181000
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;
0
 
LVL 1

Author Comment

by:bakry99
ID: 6181431
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
0

Featured Post

Find Ransomware Secrets With All-Source Analysis

Ransomware has become a major concern for organizations; its prevalence has grown due to past successes achieved by threat actors. While each ransomware variant is different, we’ve seen some common tactics and trends used among the authors of the malware.

Join & Write a Comment

The uses clause is one of those things that just tends to grow and grow. Most of the time this is in the main form, as it's from this form that all others are called. If you have a big application (including many forms), the uses clause in the in…
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…
Internet Business Fax to Email Made Easy - With eFax Corporate (http://www.enterprise.efax.com), you'll receive a dedicated online fax number, which is used the same way as a typical analog fax number. You'll receive secure faxes in your email, fr…
Illustrator's Shape Builder tool will let you combine shapes visually and interactively. This video shows the Mac version, but the tool works the same way in Windows. To follow along with this video, you can draw your own shapes or download the file…

706 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

18 Experts available now in Live!

Get 1:1 Help Now