[alexan0308]

Часто встречается вопросы про добавление форматированной строки в Richedit. Ответ есть, через управление SelAttributes, но сам код при этом становится не очень наглядным. Есть компонент, но он платный. Когда мне тоже понадобилось, покорпел, наскреб процедуру, которая решает задачу, хоть и не полностью. Короче вот:

Код:

uses StrUtils;

Код:

var
  Form1: TForm1; RichEdit_text : string;

RichEdit_text - добавляемая строка - сделана глобальной, чтобы потом легче было использовать процедуру в потоке.

Вот процедура

Код:

procedure RichEdit_add_text;
// процедура  RichEdit_add_text добавляет текстовую строку RichEdit_text с тегами в RichEdit1
 
function HtmlColorToTColor(Color: string):TColor ;
const DelphiColorConst = 'clblack, clmaroon, clgreen, clolive, clnavy, clpurple, clteal, clgray, clsilver, clred, cllime, clyellow, clblue, clfuchsia, claqua, clwhite';
var
  rColor: TColor;
begin
try
  if ansipos(AnsiLowerCase(Color),DelphiColorConst)>0 then begin result := StringToColor('CL' + Color);  exit; end;
  delete(Color,1,1);
  if (length(color) >= 6) then
  begin
    {незабудьте, что TColor это bgr, а не rgb: поэтому необходимо изменить порядок}
    color := '$00' + copy(color,5,2) + copy(color,3,2) + copy(color,1,2);
    rColor := StrToInt(color);
  end;
  result := rColor;
except
   result :=  $000000;
end;
end;
 
function before_tag_symbol_delete(sssr:string; n:integer):string;
var  k : integer; res : string;
begin
     k:=0;  res:='';
      while k<n do
        begin
            inc(k);
            if sssr[k] = '<' then while sssr[k] <> '>' do begin inc(k); end;
            if sssr[k] = '>' then continue;
            res:=res +  sssr[k];
        end;
   before_tag_symbol_delete:=res + copy(sssr,n, length(sssr)- n + 1);
end;
 
 
var st, zvet, sssr, raspad_sssr,  rf : string;
raspad_count, k, mm, k_beg, k_end, k_end_color, globbegin, tag_color, tag_bf, tag_italic, tag_, Line : integer;
color : Tcolor;
pole_zvetov : string; arbeiten: integer;
 
begin
   sssr :=  RichEdit_text;
      st:=''; k:=1;
    while k<=length(sssr) do
      begin
          if sssr[k]<>'<' then begin  st:=st+sssr[k]; end
                  else while sssr[k]<>'>' do inc(k);
                  inc(k);
      end;
       Line:=  Form1.Richedit1.Lines.Count;
       st:= StringReplace(st, '&lt;', '<', [rfReplaceAll, rfIgnoreCase]);
       st:= StringReplace(st, '&gt;', '>', [rfReplaceAll, rfIgnoreCase]);
      Form1.Richedit1.Lines.Add(st);
 
       sssr:= StringReplace(RichEdit_text, '&lt;', '!', [rfReplaceAll, rfIgnoreCase]);
       sssr:= StringReplace(sssr, '&gt;', '!', [rfReplaceAll, rfIgnoreCase]);
       sssr:= StringReplace(sssr, '< ', '<', [rfReplaceAll, rfIgnoreCase]);
       sssr:= StringReplace(sssr, ' >', '>', [rfReplaceAll, rfIgnoreCase]);
        globbegin:= SendMessage(Form1.RichEdit1.Handle, EM_LINEINDEX, Line, 0);
         raspad_sssr:=sssr;
 
            arbeiten:=0;
            tag_:= ansipos('</', raspad_sssr);  // ищем ближайший закрывающий тег
            if tag_>0 then
                          if raspad_sssr[tag_+ 2] = 'f' then  arbeiten:=1    // </font>
                      else
                          if raspad_sssr[tag_+ 2] = 'b' then  arbeiten:=2    // </b>
                      else
                          if raspad_sssr[tag_+ 2] = 'i' then  arbeiten:=3;   //  </i>
 
  while arbeiten >0 do begin
 
   case arbeiten of
 
    1:    BEGIN
             k_end_color:=ansipos('<font color=',raspad_sssr);  rf:= before_tag_symbol_delete(raspad_sssr, k_end_color);
      k_beg:=ansipos('<font color=',rf);
      mm:=posex('>',rf, k_beg);
      k_end_color:=ansipos('</font>',rf);
 
      zvet:='CL' + copy(rf, k_beg+7+5, mm-k_beg-7-5);
 
      zvet:=copy(rf, k_beg+7+5, mm-k_beg-7-5);
 
      k_end:=k_end_color-(mm-k_beg)-2;
 
       Form1.Richedit1.SelStart := globbegin + k_beg - 1;
       Form1.Richedit1.SelLength:=  k_end-k_beg+1;
       Form1.Richedit1.SelAttributes.Color :=  HtmlColorToTColor(zvet);
 
 
      k_beg:=ansipos('<font color=',raspad_sssr);
      mm:=posex('>',raspad_sssr, k_beg);
      k_end_color:=ansipos('</font>',raspad_sssr);
      k_end:=k_end_color-(mm-k_beg)-2;
 
             delete(raspad_sssr, k_end_color, 7);
             delete(raspad_sssr, k_beg, length(zvet)+13);
      END;
 
    2:    BEGIN
          k_end_color:=ansipos('<b>',raspad_sssr);  rf:= before_tag_symbol_delete(raspad_sssr, k_end_color);
      k_beg:=ansipos('<b>',rf);
      mm:=posex('>',rf, k_beg);
      k_end_color:=ansipos('</b>',rf);
      k_end:=k_end_color-(mm-k_beg)-2;
 
       Form1.Richedit1.SelStart := globbegin + k_beg - 1;
       Form1.Richedit1.SelLength:=  k_end-k_beg+1;
            Form1.RichEdit1.SelAttributes.Style :=Form1.RichEdit1.SelAttributes.Style + [fsBold];
 
      k_beg:=ansipos('<b>',raspad_sssr);
      mm:=posex('>',raspad_sssr, k_beg);
      k_end_color:=ansipos('</b>',raspad_sssr);
      k_end:=k_end_color-(mm-k_beg)-2;
             delete(raspad_sssr, k_end_color, 4);
             delete(raspad_sssr, k_beg, 3);
   END;
 
    3:    BEGIN
                       k_end_color:=ansipos('<i>',raspad_sssr);  rf:= before_tag_symbol_delete(raspad_sssr, k_end_color);
      k_beg:=ansipos('<i>',rf);
      mm:=posex('>',rf, k_beg);
      k_end_color:=ansipos('</i>',rf);
      k_end:=k_end_color-(mm-k_beg)-2;
 
       Form1.Richedit1.SelStart := globbegin + k_beg - 1;
       Form1.Richedit1.SelLength:=  k_end-k_beg+1;
         Form1.RichEdit1.SelAttributes.Style :=Form1.RichEdit1.SelAttributes.Style + [fsItalic];
 
      k_beg:=ansipos('<i>',raspad_sssr);
      mm:=posex('>',raspad_sssr, k_beg);
      k_end_color:=ansipos('</i>',raspad_sssr);
      k_end:=k_end_color-(mm-k_beg)-2;
             delete(raspad_sssr, k_end_color, 4);
             delete(raspad_sssr, k_beg, 3);
   END;
 
   end;
            arbeiten:=0;
            tag_:= ansipos('</', raspad_sssr);  // ищем ближайший закрывающий тег
            if tag_>0 then
                          if raspad_sssr[tag_+ 2] = 'f' then  arbeiten:=1    // </font>
                      else
                          if raspad_sssr[tag_+ 2] = 'b' then  arbeiten:=2    // </b>
                      else
                          if raspad_sssr[tag_+ 2] = 'i' then  arbeiten:=3;   //  </i>
  end;
 
end;

Примеры использования:

Код:

procedure TForm1.Button1Click(Sender: TObject);
begin
      RichEdit_text:=  'Обычный текст';   RichEdit_add_text;
      RichEdit_text:=  'Текст с<font color=red><b><i>жирным, курсивным и красным</i></b></font>словом'; RichEdit_add_text;
      RichEdit_text:=  'Текст с<i><b><font color=#ffd700>золотистым, курсивным и жирным</font></b></i>словом'; RichEdit_add_text;
      RichEdit_text:=  'Текст с<font color=#4B0082><i>курсивным и цвета индиго</i></font>словом'; RichEdit_add_text;
      RichEdit_text:=  'Текст с<b><font color=Fuchsia>бирюзовым и жирным</font></b>словом'; RichEdit_add_text;
      RichEdit_text:=  'Доказать, что <font color=blue><b><i>c&gt;d</i></b></font> Задать...'; RichEdit_add_text;
      RichEdit_text:=  'Доказать, что <font color=#4B0082><b><i>a&lt;b</i></b></font> Найти...'; RichEdit_add_text;
      RichEdit_text:=  'Все вместе<i>курсивом</i>потом<b>жирным</b>потом<font color=green>зеленым</font>снова<b>жирным</b>опять<i>курсивом</i>еще<font color=red>красным</font>и обычным';
      RichEdit_add_text;
      RichEdit_text:=  'Опять обычный текст';   RichEdit_add_text;
end;

Есть плюсик - при сохранении отображаемого текста в html.
Буду рад отзывам...
Вложенность тегов реализована.
Добавлена поддержка html цветов. Разрешено указывать имена системных цветов в Delphi без приставки CL
Понятно, что нужно строго следить за вложенностью тегов, иначе результат непредсказуем. Знаки '<', '>' писать через соответствующие html-теги.