uses Windows, RichEdit, RichMemoUtils;
procedure RichMemoHighlightRange(R: TRichMemo; ASelStart, ASelLength: integer; AColor: TColor);
var
Format: CHARFORMAT2;
OldSelStart, OldSelLength: integer;
begin
R.Lines.BeginUpdate;
try
OldSelStart := R.SelStart;
OldSelLength := R.SelLength;
R.SelStart := ASelStart;
R.SelLength := ASelLength;
FillChar(Format, SizeOf(Format), 0);
Format.cbSize := SizeOf(Format);
SendMessage(R.Handle, EM_GETCHARFORMAT, WPARAM(True), LPARAM(@Format));
Format.dwMask := CFM_BACKCOLOR;
if AColor = 0 then
begin
Format.dwEffects := CFE_AUTOBACKCOLOR;
end
else
begin
Format.dwEffects := 0;
Format.crBackColor := ColorToRGB(AColor);
end;
SendMessage(R.Handle, EM_SETCHARFORMAT, SCF_SELECTION, LPARAM(@Format));
finally
R.SelStart := OldSelStart;
R.SelLength := OldSelLength;
R.Lines.EndUpdate;
end;
end;
procedure RichMemoHighlightReset(R: TRichMemo);
begin
RichMemoHighlightRange(R, 0, R.GetTextLen, 0);
end;
procedure RichMemoHighlightWord(R: TRichMemo; AWord: string; AColor: TColor);
var
Start, Found: integer;
begin
Start := 0;
Found := R.Search(AWord, Start, R.GetTextLen, []);
while (Found <> -1) do
begin
RichMemoHighLightRange(R, Found, Length(AWord), AColor);
Start := Found + 1;
Found := R.Search(AWord, Start, R.GetTextLen, []);
end;
end;
procedure TForm1.FormCreate(Sender: TObject);
begin
LoadRtfFile(RichMemo1, 'c:\temp\test.rtf');
end;
procedure TForm1.Button1Click(Sender: TObject);
begin
RichMemoHighlightReset(RichMemo1);
end;
procedure TForm1.Button2Click(Sender: TObject);
begin
RichMemoHighlightWord(RichMemo1, 'Lorem', clYellow);
RichMemoHighlightWord(RichMemo1, 'Ipsum', clMoneyGreen);
end;