Узнать раскраску фона RichEdit

← →
картман © (2010-02-26 17:41) [0]

Всем доброго времени суток!

Нужно раскрашивать фон (шрифта?) RichEdit, крашу так:

procedure RESetSelBgColor(RichEdit: TRichEdit; AColor: TColor);
var
Format: CHARFORMAT2;
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 TForm1.Button1Click(Sender: TObject);
begin
RESetSelBgColor(RichEdit1, clYellow);
end;

Потом мне нужно получить смещение и длину всех раскрашенных областей. Получаю так:

function REGetSelBgColor(RichEdit: TRichEdit): Boolean;
var
Format: CHARFORMAT2;
begin
FillChar(Format, SizeOf(Format), 0);
with Format do
begin
cbSize := SizeOf(Format);
dwMask := CFM_BACKCOLOR;
Richedit.Perform(EM_GETCHARFORMAT, SCF_SELECTION, Longint(@Format));
end;
Result := Format.crBackColor > 0;
end;

procedure TForm1.Button4Click(Sender: TObject);
var
st: string;
i: Integer;
InSel: Boolean;
begin
st := "";
InSel := False;
for i := 0 to Length(RichEdit1.Text) - 1 do
begin
RichEdit1.SelStart := i;
RichEdit1.SelLength := 1;
if REGetSelBgColor(RichEdit1) then
begin
if not InSel then
begin
InSel := True;
st := st + #13#10 + IntToStr(i);
end;
end
else begin
if InSel then
st := st + "-" + IntToStr(i - 1);
InSel := False;
end;
end;
ShowMessage(st);
end;

Как получить то же самое не посылая сообщение для каждого символа?

← →
KilkennyCat © (2010-02-26 18:26) [1]

посмотреть формат ртф и работать с ним нативно

Узнать раскраску фона RichEdit Найти похожие ветки