Articles   Members Online:
-Article/Tip Search
-News Group Search over 21 Million news group articles.
-Delphi/Pascal
-CBuilder/C++
-C#Builder/C#
-JBuilder/Java
-Kylix
Member Area
-Home
-Account Center
-Top 10 NEW!!
-Submit Article/Tip
-Forums Upgraded!!
-My Articles
-Edit Information
-Login/Logout
-Become a Member
-Why sign up!
-Newsletter
-Chat Online!
-Indexes NEW!!
Employment
-Build your resume
-Find a job
-Post a job
-Resume Search
Contacts
-Contacts
-Feedbacks
-Link to us
-Privacy/Disclaimer
Embarcadero
Visit Embarcadero
Embarcadero Community
JEDI
Links
How to add formatted line (with TAGs) to TRichEdit - ready function Turn on/off line numbers in source code. Switch to Orginial background IDE or DSP color Comment or reply to this aritlce/tip for discussion. Bookmark this article to my favorite article(s). Print this article
18-Sep-03
Category
Reporting /Printing
Language
Delphi 5.x
Views
157
User Rating
No Votes
# Votes
0
Replies
0
Publisher:
DSP, Administrator
Reference URL:
DKB
			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;


			
Vote: How useful do you find this Article/Tip?
Bad Excellent
1 2 3 4 5 6 7 8 9 10

 

Advertisement
Share this page
Advertisement
Download from Google

Copyright © Mendozi Enterprises LLC