Link to home
Start Free TrialLog in
Avatar of rincewind666
rincewind666

asked on

Color words in richedit (500 points)

Whenever a certain sequence of characters appears in a richedit, I want to color it red.  The richedit contains text such as:
$db = "yes";
$prenum='no';
$prefix = 'ABC';

I am using the following code which turns every "$" in the text red.  I just want to turn all text in the same line red if it has a $, = and either a ' or " in it such as above.  Note that sometimes there  is a space before/after = and sometimes there isn't. Ignore any other times $ appears.

I am using Delphi 6.

I am giving 500 points as this is urgent.  Many thanks for your help.

CODE:

unit Unit1;

interface

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

type
  TForm1 = class(TForm)
    RichEdit1: TRichEdit;
    procedure FormShow(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

procedure colorword(ARichedit : TRichedit; AWord : String; AColor : TColor; whole:Boolean; aChar:String);          //  baby123
var
  foundAt,
  oldSelStart,
  oldSelLength,
  first,last : Integer;
begin

  oldSelStart := ARichedit.SelStart;
  oldSelLength := ARichedit.SelLength;
  try
    foundAt := -1;
    repeat
      if whole then begin
        foundAt := ARichEdit.FindText(AWord,foundAt+1,length(ARichEdit.Text),[stWholeWord]);
        if foundAt < 0 then break;
        ARichedit.SelStart := foundAt;
        ARichEdit.SelLength := length(AWord);
        ARichEdit.SelAttributes.Color := AColor;
        ARichEdit.SelAttributes.Style := [fsBold];
      end
      else begin
        foundAt := ARichEdit.FindText(AWord,foundAt+1,length(ARichEdit.Text),[]);
        if foundAt < 0 then break;
        first:=foundAt;
        while (ARichEdit.Text[first] in ['a'..'z']) or (ARichEdit.Text[first] in ['A'..'Z']) do begin
           Dec(first);
        end;
        ARichedit.SelStart := first;
        last:=foundAt+length(AWord)+1;
        while (ARichEdit.Text[last] in ['a'..'z']) or (ARichEdit.Text[last] in ['A'..'Z']) or
              (ARichEdit.Text[last]=aChar) do begin
           Inc(last);
        end;
        ARichedit.SelLength := last-first;
        ARichEdit.SelAttributes.Color := AColor;
        ARichEdit.SelAttributes.Style := [fsBold];
      end;
    until foundAt = -1;
  finally
    ARichedit.SelStart := oldSelStart;
    ARichedit.SelLength := oldSelLength;
  end;
end;

procedure TForm1.FormShow(Sender: TObject);
begin
colorword(RichEdit1,'$', clRed, false, '');
end;

end.

FORM:

object Form1: TForm1
  Left = 237
  Top = 316
  Width = 652
  Height = 215
  Caption = 'Form1'
  Color = clBtnFace
  Font.Charset = DEFAULT_CHARSET
  Font.Color = clWindowText
  Font.Height = -13
  Font.Name = 'MS Sans Serif'
  Font.Style = []
  OldCreateOrder = False
  Position = poScreenCenter
  OnShow = FormShow
  PixelsPerInch = 120
  TextHeight = 16
  object RichEdit1: TRichEdit
    Left = 0
    Top = 0
    Width = 644
    Height = 105
    Align = alTop
    Lines.Strings = (
      'session_start(); '

        'if ($_POST["vercode"] != $_SESSION["vercode"] OR $_SESSION["verc' +
        'ode"]=='''')  {'
      '     echo  ''<strong>Incorrect verification code.</strong><br>'';'
      '} else {'
      '$email = $_POST[''email''] ;'
      '$name = $_POST[''sendername''] ;'
      '$subject = $_POST[''subject''] ;'
      '$message = $_POST[''mesbody''] ;'
      '$db = "yes";'
      '$prenum=''no'';'
      '$prefix = ''ABC'';'
      '$count_my_page = ("hitcounter.txt");'
      '$hits = file($count_my_page);'
      '$hits[0] ++;'
      '$fp = fopen($count_my_page , "w");'
      'fputs($fp , "$hits[0]");'
      'fclose($fp);'
      '//sets number for subject'
      '$subnum = $hits[0];')
    ScrollBars = ssVertical
    TabOrder = 0
  end
end
Avatar of rincewind666
rincewind666

ASKER

Almost forgot, if possible, the richedit should scroll to this text when opened.  Don't worry if this extra feature is too difficult.  I will accept just the colored text.  Thanks.
Avatar of wd123
wd123
Flag of Belarus image
Better use TSynEdit  - http://synedit.sourceforge.net
Avatar of rincewind666
rincewind666

ASKER

Is TSynEdit compatable with Vista?
Avatar of TheRealLoki
TheRealLoki
Flag of New Zealand image
ahhh. that code looks familiar ;-)
so let me get this straight. You wish to highlight the entire line in red when you find
$, = and '
o $, = and "

unit Unit1;
 
interface
 
uses
  Windows, Messages, SysUtils, (*Variants, *)Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, ComCtrls, RichEdit;
 
type TColorWhat = (cw_Text, cw_Word, cw_Line);
 
type
  TForm1 = class(TForm)
    RichEdit1: TRichEdit;
    Button1: TButton;
    procedure FormShow(Sender: TObject);
    procedure Button1Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;
 
var
  Form1: TForm1;
 
procedure DetermineCurrentWord(ARichEdit: TRichEdit);
procedure DetermineCurrentLinePos(ARichEdit: TRichEdit);
procedure FindAndColorRichEdit(ARichEdit: TRichEdit; AText: string;
  AColor: TColor; FindWholeWord_: boolean; MatchCase_: boolean; ColorWhat: TColorWhat);
procedure FindAndColorLinesIfContainsAllThese(ARichEdit: TRichEdit; ATextCommaList: string;
  AColor: TColor; MatchCase_: boolean);
 
implementation
 
{$R *.dfm}
 
 
procedure colorword(ARichedit : TRichedit; AWord : String; AColor : TColor; whole:Boolean; aChar:String);          //  baby123
var
  foundAt,
  oldSelStart,
  oldSelLength,
  first,last : Integer;
begin
 
  oldSelStart := ARichedit.SelStart;
  oldSelLength := ARichedit.SelLength;
  try
    foundAt := -1;
    repeat
      if whole then begin
        foundAt := ARichEdit.FindText(AWord,foundAt+1,length(ARichEdit.Text),[stWholeWord]);
        if foundAt < 0 then break;
        ARichedit.SelStart := foundAt;
        ARichEdit.SelLength := length(AWord);
        ARichEdit.SelAttributes.Color := AColor;
        ARichEdit.SelAttributes.Style := [fsBold];
      end
      else begin
        foundAt := ARichEdit.FindText(AWord,foundAt+1,length(ARichEdit.Text),[]);
        if foundAt < 0 then break;
        first:=foundAt;
        while (ARichEdit.Text[first] in ['a'..'z']) or (ARichEdit.Text[first] in ['A'..'Z']) do begin
           Dec(first);
        end;
        ARichedit.SelStart := first;
        last:=foundAt+length(AWord)+1;
        while (ARichEdit.Text[last] in ['a'..'z']) or (ARichEdit.Text[last] in ['A'..'Z']) or
              (ARichEdit.Text[last]=aChar) do begin
           Inc(last);
        end;
        ARichedit.SelLength := last-first;
        ARichEdit.SelAttributes.Color := AColor;
        ARichEdit.SelAttributes.Style := [fsBold];
      end;
    until foundAt = -1;
  finally
    ARichedit.SelStart := oldSelStart;
    ARichedit.SelLength := oldSelLength;
  end;
end;
 
procedure DetermineCurrentWord(ARichEdit: TRichEdit);
var
  startpos, endpos: integer;
begin
  endpos := ARichEdit.SelStart;
  startpos := SendMessage( ARichEdit.Handle, EM_FINDWORDBREAK, WB_MOVEWORDLEFT, endpos + 1);
  endpos := SendMessage( ARichEdit.Handle, EM_FINDWORDBREAK, WB_MOVEWORDRIGHT, endpos);
// does not work with @
 
  ARichEdit.SelStart := startpos;
  ARichEdit.SelLength := (endpos - startpos);
end;
 
procedure DetermineCurrentLinePos(ARichEdit: TRichEdit);
var
  startpos, endpos, templine, currentline, len, i: integer;
begin
  startpos := ARichEdit.SelStart;
  endpos := startpos + 1;
  len := length(ARichEdit.Lines.Text);
  currentline := SendMessage( ARichEdit.Handle, EM_EXLINEFROMCHAR, 0, startpos);
  templine := currentline;
// find start of line
  while ( (startpos > 0) and (templine = currentline) ) do
  begin
    i := SendMessage( ARichEdit.Handle, EM_FINDWORDBREAK, WB_MOVEWORDLEFT, startpos);
    templine := SendMessage( ARichEdit.Handle, EM_EXLINEFROMCHAR, 0, i);
    if (templine = currentline) then
      startpos := i-1;
  end;
  if startpos < 0 then startpos := 0;
// find end of line
  templine := currentline;
 
  while ( (endpos < pred(len)) and (templine = currentline) ) do
  begin
    i := SendMessage( ARichEdit.Handle, EM_FINDWORDBREAK, WB_MOVEWORDRIGHT, endpos);
    templine := SendMessage( ARichEdit.Handle, EM_EXLINEFROMCHAR, 0, i);
    if (templine = currentline) then
      endpos := i + 1;
  end;
  if endpos >= len then endpos := len-1;
 
  ARichEdit.SelStart := startpos;
  ARichEdit.SelLength := (endpos - startpos);
end;
 
procedure FindAndColorRichEdit(ARichEdit: TRichEdit; AText: string;
  AColor: TColor; FindWholeWord_: boolean; MatchCase_: boolean; ColorWhat: TColorWhat);
var
  FoundAt: LongInt;
  StartPos, ToEnd: Integer;
  Searchtype: TSearchTypes;
  refind: TFindDialog;
begin
  refind := TFindDialog.Create(nil);
  try
    SearchType := [];
    if FindWholeWord_ then SearchType := SearchType + [stWholeWord];
    if MatchCase_ then SearchType := SearchType + [stMatchCase];
 
    refind.FindText := AText;
    with ARichEdit do
    begin
      StartPos := 0;
      { ToEnd is the length from StartPos to the end of the text in the rich edit control }
      ToEnd := Length(Text) - StartPos;
      FoundAt := FindText(refind.FindText, StartPos, ToEnd, SearchType);
      while FoundAt <> -1 do
      begin
        SetFocus;
        SelStart := FoundAt;
        SelLength := Length(refind.FindText);
 
        if ColorWhat = cw_Line then
        begin
          DetermineCurrentLinePos(ARichEdit);
          SelAttributes.Color := clRed;
          StartPos := ARichEdit.SelStart + ARichEdit.SelLength;
        end
        else if ColorWhat = cw_Word then
        begin
          DetermineCurrentWord(ARichEdit);
          SelAttributes.Color := clRed;
          StartPos := ARichEdit.SelStart + ARichEdit.SelLength;
        end
        else
        begin
          SelAttributes.Color := clRed;
          StartPos := SelStart + SelLength; // ready to search for the next
        end;
 
        ToEnd := Length(Text) - StartPos;
        FoundAt := FindText(refind.FindText, StartPos, ToEnd, SearchType);
      end;
      SelStart := 0; // unselect
      Sellength := 0;
    end;
  finally
    refind.Free;
  end;
end;
 
procedure FindAndColorLinesIfContainsAllThese(ARichEdit: TRichEdit; ATextCommaList: string;
  AColor: TColor; MatchCase_: boolean);
var
  FoundAt: LongInt;
  StartPos, ToEnd: Integer;
  Searchtype: TSearchTypes;
  refind: TFindDialog;
  sl: TStringList;
  AText, s: string;
  i: integer;
  matchedcount: integer;
begin
  sl := TStringList.Create;
  refind := TFindDialog.Create(nil);
  try
    sl.commatext := ATextCommaList;
    AText := sl[0];
    SearchType := [];
// not using yet - TODO    if FindWholeWord_ then SearchType := SearchType + [stWholeWord];
    if MatchCase_ then SearchType := SearchType + [stMatchCase];
 
    refind.FindText := AText;
    with ARichEdit do
    begin
      StartPos := 0;
      { ToEnd is the length from StartPos to the end of the text in the rich edit control }
      ToEnd := Length(Text) - StartPos;
      FoundAt := FindText(refind.FindText, StartPos, ToEnd, SearchType);
      while FoundAt <> -1 do
      begin
        SetFocus;
        SelStart := FoundAt;
        SelLength := Length(refind.FindText);
        DetermineCurrentLinePos(ARichEdit);
        s := ARichEdit.SelText;
        matchedcount := 0;
        for i := 0 to pred(sl.count) do
        begin
          if MatchCase_ and (pos(sl[i], s) > 0) then
            inc(matchedcount)
          else if (not MatchCase_) and (pos(uppercase(sl[i]), uppercase(s)) > 0) then
            inc(matchedcount);
        end;
        if matchedcount = sl.count then
        begin
          SelStart := FoundAt;
          DetermineCurrentLinePos(ARichEdit);
          StartPos := ARichEdit.SelStart + ARichEdit.SelLength;
          SelAttributes.Color := clRed;
        end
        else
          StartPos := FoundAt + Length(refind.FindText);
 
 
        ToEnd := Length(Text) - StartPos;
        FoundAt := FindText(refind.FindText, StartPos, ToEnd, SearchType);
      end;
      SelStart := 0; // unselect
      Sellength := 0;
    end;
  finally
    refind.Free;
    sl.clear;
    sl.free;
  end;
end;
 
procedure TForm1.FormShow(Sender: TObject);
begin
//  colorword(RichEdit1,'$', clRed, false, '');
//  FindAndColorRichEdit(RichEdit1, '$', clRed, false, false, cw_Line);
//$, = and '
    FindAndColorLinesIfContainsAllThese(RichEdit1, '$,=,''', clRed, false);
//$, = and "
    FindAndColorLinesIfContainsAllThese(RichEdit1, '$,=,""""', clRed, false);
end;
 
 
procedure TForm1.Button1Click(Sender: TObject);
begin
  FindAndColorRichEdit(RichEdit1, '$', clRed, false, false, cw_Line);
end;
 
end.

Open in new window

Avatar of TheRealLoki
TheRealLoki
Flag of New Zealand image
og, and to scroll to it is just
    ARichEdit.Perform(em_ScrollCaret, 0, 0);
ASKER CERTIFIED SOLUTION
Avatar of Russell Libby
Russell Libby
Flag of United States of America image
Link to home
membership
This solution is only available to members.
To access this solution, you must be a member of Experts Exchange.
Start Free Trial
Avatar of wd123
wd123
Flag of Belarus image
>Is TSynEdit compatable with Vista?
Yes
Avatar of rincewind666
rincewind666

ASKER

Sorry.  This isn't what I need.  I just want the line in red for this pattern ($word =) such as

$db = "yes";
$prenum='no';
$prefix = 'ABC';

Thanks for your help.
Avatar of rincewind666
rincewind666

ASKER

rllibby, I am getting the following error:
[Error] Unit1.pas(28): Undeclared identifier: 'TRegExpr'
Avatar of Russell Libby
Russell Libby
Flag of United States of America image
Did you download the RegExprEx.pas unit, and add it to your uses clause?

uses
  Windows, SysUtils, ... etc ..., RegExprEx;

Avatar of rincewind666
rincewind666

ASKER

rllibby

Opps1  I forgot to add it to my users clause.

Anyway, I am very pleased with this. Is there a help file available for the pattern?  I also want this if the line doesn't contain quotes:

$year = 2008;
$db = "yes";
$prenum='no';
$prefix = 'ABC';

Note that, in any event, all lines end with ;

If you can help me with this last little bit, I will appreciate it.  Thanks.
Avatar of Russell Libby
Russell Libby
Flag of United States of America image
1. Sorry, no help file per se. The syntax is loosely described in the header of the unit (comment section that details the syntax). Thats kind of why I asked what your comfort level was.  Some good tutorials can be found here:

http://www.regular-expressions.info/tutorial.html

2. Regarding matching it if it DOES not contain quotes, if you remove that restriction then almost all the lines would end up matching. Correct me if I'm wrong, but it looks like what you are trying to do is match lines with constant value assignments? If so, then we just update the pattern to match digits as well (" strings or ' strings or numeric values)

  regMatch:=TRegExpr.CreatePattern('@0\$[^=\r\n]+=\s*(''[^'']*''|"[^"]*"|\d+)[^\r\n]*@1');

A breakdown of what the pattern is doing:

  //    @0          =  Mark position and save as BeadPos[0]
  //    \$          =  Match literal '$'
  //    [^=\r\n]+   =  Iterate while not =, CR, LF, must match at least one char
  //    =           =  Match literal =
  //    \s*         =  Iterate past any white space zero or more times
  //    (           =  Start sub expression
  //    ''[^'']*''
  //       '        =  Match literal '
  //       [^']*    =  Iterate while not ', match zero or more times
  //       '        =  Match literal '
  //    |           =  or
  //    "[^"]*"
  //       "        =  Match literal "
  //       [^"]*    =  Iterate while not ", match zero or more times
  //       "        =  Match literal "
  //    |           =  or
  //    \d+         =  Match 1 or more digit chars
  //    )           =  End sub expression
  //    [^\r\n]*    =  Iterate while not CR or LF, match zero or more times
  //    @1          =  Mark position and save as BeadPos[1]
  //

The nice thing about regular expressions is that you don't have to recode any parsing logic when your requirements change; you only neeed to update the pattern value.

Hope this helps
Russell
Avatar of rincewind666
rincewind666

ASKER

rllibby

Excellent!  I am awarding you the well deserved points, together with my grateful thanks.