#1
  1. No Profile Picture
    Registered User
    Devshed Newbie (0 - 499 posts)

    Join Date
    May 2013
    Posts
    2
    Rep Power
    0

    Add a colored line in the Richedit


    Frequently asked questions about the addition of a formatted string in Richedit. The answer is, through the management of SelAttributes, but the code in this case is not very clear. When I took too, pokorpel, scraped together a procedure that solves the problem, though not completely. In brief here:

    Code:
    var
      Form1: TForm1; RichEdit_text : string;
    RichEdit_text - included string - made ​​global, so that later you can use the procedure in the stream.

    Code:
    procedure RichEdit_add_text;
    // procedure  RichEdit_add_text add formatted line  RichEdit_text in 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
        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;
    
    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;
    Examples of use:

    Code:
    procedure TForm1.Button1Click(Sender: TObject);
    begin
        RichEdit_text:=  'plain Text';   RichEdit_add_text;
        RichEdit_text:=  'Text with<font color=green>green</font>word'; RichEdit_add_text; 
        RichEdit_text:=  'Text with<font color=#71d27b>emerald</font>word'; RichEdit_add_text;    
        RichEdit_text:=  'Text with<b>bold</b>word'; RichEdit_add_text; 
        RichEdit_text:=  'Text with<i>italic</i>word'; RichEdit_add_text;              
        RichEdit_text:=  'Text with<font color=red><b><i>bold, italic and red</i></b></font>word'; RichEdit_add_text;
        RichEdit_text:=  'Text with<i><b><font color=#ffd700>gold, and bold italic</font></b></i>word'; RichEdit_add_text;
        RichEdit_text:=  'Text with<font color=#4B0082><i>italic and indigo</i></font>word'; RichEdit_add_text;
        RichEdit_text:=  'Text with<b><font color=Fuchsia>turquoise and bold</font></b>word'; RichEdit_add_text;
        RichEdit_text:=  'if <font color=blue><b><i>c&gt;d</i></b></font> then...'; RichEdit_add_text;
        RichEdit_text:=  'if <font color=#4B0082><b><i>a&lt;b</i></b></font> then...'; RichEdit_add_text;  
    end;
    There are a plus - while the displayed text to html.
    Nesting tags implemented.
    Added support for html colors. Allowed to specify the names of the system colors in Delphi without the prefix CL
    It is clear that the need to closely monitor the nesting of tags, otherwise the result is unpredictable. Characters '<', '>' writing through the appropriate html-tags.
    I would be pleased reviews ...
  2. #2
  3. No Profile Picture
    Registered User
    Devshed Newbie (0 - 499 posts)

    Join Date
    May 2013
    Posts
    2
    Rep Power
    0

    sorry error


    Code:
    procedure RichEdit_add_text;
     
    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
        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;

IMN logo majestic logo threadwatch logo seochat tools logo