uses
...,
Vcl.ComCtrls,
Winapi.RichEdit;
procedure RE_SetSelBgColor(RichEdit: TRichEdit; AColor: TColor);
var
Format: TCHARFORMAT2;
begin
FillChar(Format, SizeOf(Format), 0);
with Format
do
begin
cbSize := SizeOf(Format);
dwMask := CFM_BACKCOLOR;
crBackColor := AColor;
RichEdit.Perform(EM_SETCHARFORMAT, SCF_SELECTION, Longint(@Format));
end;
end;
procedure RichFormat(
const aRichEdit: TRichEdit);
var
SearchStartPos, SearchLength: Integer;
P1, P2,
PE: Integer;
P_, C_: Integer;
sFormat:
string;
lSL: TStringList;
lS:
string;
lColor: TColor;
begin
SearchStartPos := 0;
SearchLength := (Length(aRichEdit.Text) - SearchStartPos);
aRichEdit.Lines.BeginUpdate;
repeat
sFormat := '
';
C_ := 0;
P1 := aRichEdit.FindText('
[RTF ', SearchStartPos, SearchLength, [stMatchCase]);
if (P1 >= 0)
then
begin
PE := aRichEdit.FindText('
]', SearchStartPos, SearchLength, [stMatchCase]);
aRichEdit.SelStart := P1;
aRichEdit.SelLength := (
PE - P1 + 1);
sFormat := aRichEdit.SelText;
aRichEdit.ClearSelection;
SearchStartPos := P1;
SearchLength := (Length(aRichEdit.Text) - SearchStartPos);
repeat
P2 := aRichEdit.FindText('
[RTF/]', SearchStartPos, SearchLength, [stMatchCase]);
if (P2 > P1)
then
begin
P_ := aRichEdit.FindText('
[RTF ', SearchStartPos, SearchLength, [stMatchCase]);
if (P_ >= 0)
and (P_ < P2)
then
begin
Inc(C_);
SearchStartPos := (P_ + 1);
SearchLength := (Length(aRichEdit.Text) - SearchStartPos);
end
else
begin
Dec(C_);
SearchStartPos := (P2 + 1);
SearchLength := (Length(aRichEdit.Text) - SearchStartPos);
end;
end;
until (C_ < 0);
if (P2 > P1)
then
begin
aRichEdit.SelStart := P2;
aRichEdit.SelLength := (Length('
[RTF/]'));
aRichEdit.ClearSelection;
aRichEdit.SelStart := P1;
aRichEdit.SelLength := (P2 - P1);
sFormat := StringReplace(sFormat, '
[RTL ', '
', [rfReplaceAll]);
sFormat := StringReplace(sFormat, '
]', '
', [rfReplaceAll]);
sFormat := StringReplace(sFormat, '
; ', #13#10, [rfReplaceAll]);
lSL := TStringList.Create;
lSL.Text := sFormat;
lS := lSL.Values['
BackColor'];
lColor := StrToInt(lS);
FreeAndNil(lSL);
RE_SetSelBgColor(aRichEdit, lColor);
SearchStartPos := P1;
SearchLength := (Length(aRichEdit.Text) - SearchStartPos);
end
else
Break;
end;
until (P1 < 0);
aRichEdit.Lines.EndUpdate;
end;
//
Text := '
-> [RTF FontName=Arial; FontColor=$0000ff; BackColor=$ff7777]hellblauer [RTF FontName=Arial; FontColor=$0000ff; BackColor=$7777ff]und dazwischen hellroter[RTF/] Text[RTF/]';
RichEdit.SelText := Text;
RichFormat(RichEdit);