Вставка текста с форматированием в RichEdit

[noname_06]

Браузер на основной форме должен заполнять RichEdit дочерней формы по маске

Дата
Заголовок страницы
URL

Вместо этого или весь текст выводит как синий, подчеркнутый, или применяет форматирование хаотично.
Способ №1:

procedure TForm1.chrmAddressChange(Sender: TObject; const browser: ICefBrowser;
  const frame: ICefFrame; const url: ustring);
var
  SlStart,SlLen: Integer;
begin
  cbbAdress.Text:= url;
  with frmHistory.redtHistory do
    begin
    Lines.Add(TimeToStr(Now));
    Lines.Add(Form1.Caption);
 
    SlStart:=Length(Text);
    SlLen:=Length(url);
    Lines.Add(url);
    SelStart:=SlStart;
    SelLength:=SlLen;
    SelAttributes.Style:= SelAttributes.Style + [fsUnderline];
    SelAttributes.Color:= clBlue;
    SelStart:= 0;
    SelLength:= 0;
    end;
end;

Способ №2

procedure TForm1.chrmAddressChange(Sender: TObject; const browser: ICefBrowser;
  const frame: ICefFrame; const url: ustring);
begin
  cbbAdress.Text:= url;
  with frmHistory.redtHistory do
    begin
    Lines.Add(TimeToStr(Now));
    Lines.Add(Form1.Caption);
    Lines.Add(url);
    selstart:=findtext(lines[Lines.Count-1],0,length(text), [stMatchCase]);
    sellength:=length(lines[Lines.Count-1]);
    SelAttributes.Style:= SelAttributes.Style + [fsUnderline];
    SelAttributes.Color:= clBlue;
    SelStart:= 0;
    SelLength:= 0;
    end;
end;

[Пепел Феникса]

SlStart:=Length(Text)

наверно вам надо RichEdit.Lines.Text?

[noname_06]

Убрал промежуточные переменные, заменил Length(Text) на Length(Lines.Text), все равно выделяет весь текст.

procedure TForm1.chrmAddressChange(Sender: TObject; const browser: ICefBrowser;
  const frame: ICefFrame; const url: ustring);
begin
  cbbAdress.Text:= url;
  with frmHistory.redtHistory do
    begin
    Lines.Add(TimeToStr(Now));
    Lines.Add(Form1.Caption);

    Lines.Add(url);
    SelStart:=Length(Lines.Text);
    SelLength:=Length(url);
    SelAttributes.Style:= SelAttributes.Style + [fsUnderline];
    SelAttributes.Color:= clBlue;
    SelStart:= 0;
    SelLength:= 0;
    end;
end;

Был еще такой вариант, но тоже выделял, что попало:

procedure TForm1.ColorLine(Line: Integer);
begin
  with frmHistory.redtHistory do
  begin
    SelStart := SendMessage(Handle, EM_LINEINDEX, Line, 0);
    SelLength := Length(Lines[Line]);
    SelAttributes.Color := clBlue;
    SelAttributes.Style := [fsUnderline];
  end;
end;
 
procedure TForm1.chrmAddressChange(Sender: TObject; const browser: ICefBrowser;
  const frame: ICefFrame; const url: ustring);
begin
  cbbAdress.Text:= url;
  with frmHistory.redtHistory do
    begin
    Lines.Add(TimeToStr(Now));
    Lines.Add(Form1.Caption);
    Lines.Add(url);
    ColorLine(Lines.Count-1);
    end;
end;

Вроде бы элементарно: выделить цветом кусок текста. Примеров - полно, ан нет.

[hemn6vyr]

Процедура

procedure WriteInRichEd(RichEd: TRichEdit; S: string; Color: TColor;
  Style: TFontStyles);
begin
   RichEd.SelStart:=Length(RichEd.Text);
   RichEd.SelAttributes.Color:=Color;
   RichEd.SelAttributes.Style:=Style;
   RichEd.SelText:=S
end;

Вызов

  WriteInRichEd(RichEdit1, 'Hello, World', clRed, [fsBold]);
  WriteInRichEd(RichEdit1, 'Hello, World', clGreen, [fsBold]);

Работает. Не моя, нашёл в инете. пользовался.

[noname_06]

Опять же получаю бред

22:46:50
Google
htt p:/ /www.goo gle.com.ua/imghp?hl=uk&tab=wi
22:47:31
Google Drive
htt p:/ /news.goo gle.com.ua/nwshp?hl=uk&tab=inhttp://news.google.com.ua/nwshp?hl=uk&tab=in
22:47:33
Новини Google
htt p:/ /ua.for- ua.com/kiev/2013/05/05/125512.htmlhttp://ua.for-ua.com/kiev/2013/05/05/125512.html

22:47:41
Великодні богослужіння у столиці пройшли спокійно - ForUm
htt p://for- ua.com/video/

Вызываю так:

procedure TForm1.chrmAddressChange(Sender: TObject; const browser: ICefBrowser;
  const frame: ICefFrame; const url: ustring);
begin
  cbbAdress.Text:= url;
  with frmHistory.redtHistory do
    begin
    Lines.Add(TimeToStr(Now));
    Lines.Add(Form1.Caption);
    Lines.Add(url);
    WriteInRichEd(frmHistory.redtHistory, url, clGreen, [fsBold]);
    end;
end;

Похоже, снова Chromium воду мутит Буду пробовать привязать заполнение History к другому событию.

[hemn6vyr]

Сообщение от noname_06

Опять же получаю бред

Вызываю так:

procedure TForm1.chrmAddressChange(Sender: TObject; const browser: ICefBrowser;
  const frame: ICefFrame; const url: ustring);
begin
  cbbAdress.Text:= url;
  with frmHistory.redtHistory do
    begin
    Lines.Add(TimeToStr(Now));
    Lines.Add(Form1.Caption);
    Lines.Add(url);
    WriteInRichEd(frmHistory.redtHistory, url, clGreen, [fsBold]);
    end;
end;

Похоже, снова Chromium воду мутит Буду пробовать привязать заполнение History к другому событию.

Не совсем так.
Примерно так:

a:tstringlist;
....
a.add('qeqwe'); // строка 0
a.add('safdsf'); // строка 1
a.add('zxcvzxc'); // строка 2
a.add('вапыва'); // строка 3
...
WriteInRichEd(richedit, a[0], clGreen, [fsBold]);//тут сам вписывает с форматированием которое ты указал
WriteInRichEd(richedit, a[1], clblue, [fsBold]);
WriteInRichEd(richedit, a[2], clblack, [fsBold]);
WriteInRichEd(richedit, a[3], clpink, [fsBold]);
....

Эта функция не заменяет тектс, а добавляет его

[noname_06]

Спасибо за наводку. Теперь работает 50/50, но уже хоть что-то:

procedure TForm1.chrmAddressChange(Sender: TObject; const browser: ICefBrowser;
  const frame: ICefFrame; const url: ustring);
begin
  cbbAdress.Text:= url;
  with frmHistory.redtHistory do
    begin
    Lines.Add(#13+TimeToStr(Now));
    Lines.Add(Form1.Caption+#13);

    SelStart := GetTextLen;
    SelAttributes.Style:= [fsUnderline];
    SelAttributes.Color:= clBlue;
    SelText:= url;
    SelAttributes.Style:= SelAttributes.Style - [fsUnderline];
    SelAttributes.Color:= clBlack;
    end;
end;

Примерный результат:

22:46:50
Google

htt p:/ /www.goo gle.com.ua/imghp?hl=uk&tab=wi

22:47:31
Google Drive
htt p:/ /news.goo gle.com.ua/nwshp?hl=uk&tab=inhttp://news.google.com.ua/nwshp?hl=uk&tab=in

22:47:33
Новини Google
htt p:/ /ua.for- ua.com/kiev/2013/05/05/125512.htmlhttp://ua.for-ua.com/kiev/2013/05/05/125512.html

Т.е. первый раз добавляет неадекватно (кривое форматирование + лишняя строка) + если добавлять пустую строку между записями любым способом, кроме

Lines.Add(#13+TimeToStr(Now));

то выделяет весь текст.

[hemn6vyr]

Вот, работает нормально, #10 - перенос строки, можно и #13 использовать.
Можешь скинуть код, гляну, попробую поправить.

Unit Unit1;

Interface

  Uses
    Winapi.Windows,
    Winapi.Messages,
    System.SysUtils,
    System.Variants,
    System.Classes,
    Vcl.Graphics,
    Vcl.Controls,
    Vcl.Forms,
    Vcl.Dialogs,
    Vcl.StdCtrls,
    Vcl.ComCtrls;

  Type
    TForm1 = Class(TForm)
      Button1: TButton;
      RichEdit1: TRichEdit;
      Procedure WriteInRichEd(RichEd: TRichEdit; S: String; Color: TColor = ClWindowText; Style: TFontStyles = []);
      Procedure Button1Click(Sender: TObject);
    Private
    { Private declarations }
    Public
    { Public declarations }
    End;

  Var
    Form1: TForm1;

Implementation

{$R *.dfm}

  Procedure TForm1.Button1Click(Sender: TObject);
    Begin
      WriteInRichEd(RichEdit1, 'qweqweqweqwe' + #10, ClRed, [FsBold]);
      WriteInRichEd(RichEdit1, 'qweqweqweqwe' + #10, ClBlue, [FsBold]);
      WriteInRichEd(RichEdit1, 'qweqweqweqwe' + #10, ClGreen, [FsBold]);
      WriteInRichEd(RichEdit1, 'qweqweqweqwe' + #10, ClYellow, [FsBold]);
      WriteInRichEd(RichEdit1, 'qweqweqweqwe' + #10, ClGray, [FsBold]);
    End;

  Procedure TForm1.WriteInRichEd(RichEd: TRichEdit; S: String; Color: TColor; Style: TFontStyles);
    Begin
      RichEd.SelStart := Length(RichEd.Text);
      RichEd.SelAttributes.Color := Color;
      RichEd.SelAttributes.Style := Style;
      RichEd.SelText := S
    End;

End.

[hemn6vyr]

procedure TForm1.chrmAddressChange(Sender: TObject; const browser: ICefBrowser; const frame: ICefFrame; const url: ustring);
begin
cbbAdress.Text:= url;
with frmHistory.redtHistory do
begin
Lines.Add(#13+TimeToStr(Now));
Lines.Add(Form1.Caption+#13);

SelStart := GetTextLen;
SelAttributes.Style:= [fsUnderline];
SelAttributes.Color:= clBlue;
SelText:= url;
SelAttributes.Style:= SelAttributes.Style - [fsUnderline];
SelAttributes.Color:= clBlack;
end;
end;

твой код, просто поменянный ричедит и переменная url

      For I := 0 To 10 Do
        Begin
          With RichEdit1 Do
            Begin
              Lines.Add(TimeToStr(Now));
              Lines.Add(Form1.Caption);
              SelStart := GetTextLen;
              SelAttributes.Style := [FsUnderline];
              SelAttributes.Color := ClBlue;
              SelText := 'qweqweqweqwe' + #10;
              SelAttributes.Style := SelAttributes.Style - [FsUnderline];
              SelAttributes.Color := ClBlack;
            End;
        End;

[noname_06]

Спасибо огромное! Наконец домучился с ним, оптимальный вариант (если заполнять RichEdit из процедуры chrmAddressChange, то пишет ересь хаотичную, пришлось-таки полностью пользоваться внешней процедурой):

procedure TForm1.chrmAddressChange(Sender: TObject; const browser: ICefBrowser;
const frame: ICefFrame; const url: ustring);
begin
cbbAdress.Text:= url;
WriteInRichEd(frmHistory.redtHistor y, TimeToStr(Now) + #10, clBlack, []);
WriteInRichEd(frmHistory.redtHistor y, Form1.Caption + #10, clBlack, []);
WriteInRichEd(frmHistory.redtHistor y, url + #10 + #10, clBlue, [fsUnderline]);
end;

*зачем в последнем листинге цикл For I := 0 To 10 Do? (это уже праздный интерес)