unit unit_RichMemo;
{$mode ObjFPC}{$H+}
interface
uses
Classes, SysUtils, graphics,
Windows, RichMemo, RichMemoUtils;
type
TmyRichMemo = class(TObject)
procedure RichMemoHighlightRange(R: TRichMemo; ASelStart, ASelLength: integer; AColor: TColor);
procedure RichMemoHighlightReset(R: TRichMemo);
procedure RichMemoHighlightWord(R: TRichMemo; AWord: string; AColor: TColor);
end;
Var myRichMemo: TRichMemo;
implementation
//uses struct.inc;
procedure TmyRichMemo.RichMemoHighlightRange(R: TRichMemo; ASelStart, ASelLength: integer; AColor: TColor);
var
Format: CHARFORMAT2; // ist in struct.inc
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 TmyRichMemo.RichMemoHighlightReset(R: TRichMemo);
begin
RichMemoHighlightRange(R, 0, R.GetTextLen, 0);
end;
procedure TmyRichMemo.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;
end.