Author: Jonas Bilinkevicius

Add formatted line (with TAGs) to TRichEdit - ready function

Answer:
1   
2   procedure AddRichLine(RichEdit: TRichEdit; const StrToAdd: string);
3   var
4     StrLeft: string;
5     TempStyle: TFontStyles;
6     TempStr: string;
7   
8     function FromLeftUntilStr(var OriginalStr: string; const UntilStr: string; const
9       ToEndIfNotFound, Trim: Boolean): string;
10    var
11      TempPos: Integer;
12    begin
13      TempPos := Pos(UntilStr, OriginalStr);
14      if TempPos > 0 then
15      begin
16        Result := Copy(OriginalStr, 1, TempPos - 1);
17        if Trim then
18          Delete(OriginalStr, 1, TempPos - 1);
19      end
20      else
21      begin
22        if ToEndIfNotFound then
23        begin
24          Result := OriginalStr;
25          if Trim then
26            OriginalStr := '';
27        end
28        else
29          Result := '';
30      end;
31    end;
32  
33    function StrStartsWith(var OriginalStr: string; const StartsWith: string; const
34      IgnoreCase, Trim: Boolean): Boolean;
35    var
36      PartOfOriginalStr: string;
37      NewStartsWith: string;
38    begin
39      PartOfOriginalStr := Copy(OriginalStr, 1, Length(StartsWith));
40      NewStartsWith := StartsWith;
41  
42      if IgnoreCase then
43      begin
44        PartOfOriginalStr := LowerCase(PartOfOriginalStr);
45        NewStartsWith := LowerCase(NewStartsWith);
46      end;
47  
48      Result := PartOfOriginalStr = NewStartsWith;
49  
50      if (Result = True) and (Trim = True) then
51        Delete(OriginalStr, 1, Length(NewStartsWith));
52    end;
53  
54    procedure AddToStyle(var Style: TFontStyles; AStyle: TFontStyle);
55    begin
56      if not (AStyle in Style) then
57        Style := Style + [AStyle];
58    end;
59  
60    procedure RemoveFromStyle(var Style: TFontStyles; AStyle: TFontStyle);
61    begin
62      if AStyle in Style then
63        Style := Style - [AStyle];
64    end;
65  begin
66    TempStyle := RichEdit.Font.Style;
67    StrLeft := StrToAdd;
68    RichEdit.SelStart := Length(RichEdit.Text);
69    while StrLeft <> '' do
70    begin
71      if StrStartsWith(StrLeft, '<', True, False) then
72      begin
73        // Bold Style
74        if StrStartsWith(StrLeft, '', True, True) then
75          AddToStyle(TempStyle, fsBold);
76        if StrStartsWith(StrLeft, '', True, True) then
77          RemoveFromStyle(TempStyle, fsBold);
78  
79        // Italic Style
80        if StrStartsWith(StrLeft, '', True, True) then
81          AddToStyle(TempStyle, fsItalic);
82        if StrStartsWith(StrLeft, '', True, True) then
83          RemoveFromStyle(TempStyle, fsItalic);
84  
85        // Underline Style
86        if StrStartsWith(StrLeft, '', True, True) then
87          AddToStyle(TempStyle, fsUnderline);
88        if StrStartsWith(StrLeft, '', True, True) then
89          RemoveFromStyle(TempStyle, fsUnderline);
90  
91        // Color
92        if StrStartsWith(StrLeft, '', True, True) then
93          RichEdit.SelAttributes.Color := RichEdit.Font.Color;
94        if StrStartsWith(StrLeft, '', False, True);
95        try
96          RichEdit.SelAttributes.Color := StringToColor(TempStr);
97        except
98          RichEdit.SelAttributes.Color := RichEdit.Font.Color;
99        end;
100       Delete(StrLeft, 1, 1);
101     end;
102   end
103 else
104   begin
105     RichEdit.SelAttributes.Style := TempStyle;
106     RichEdit.SelText := FromLeftUntilStr(StrLeft, '<', True, True);
107   end;
108 
109   RichEdit.SelStart := Length(RichEdit.Text);
110 end;
111 RichEdit.SelText := #13#10;
112 end;
113 
114 procedure TForm1.Button1Click(Sender: TObject);
115 begin
116   AddRichLine(RichEdit1,
117     'Test: This is a bold test line which is written in blue. Nice?');
118 end;