2006. július 16., vasárnap
Add formatted line (with TAGs) to TRichEdit - ready function
Problem/Question/Abstract:
Add formatted line (with TAGs) to TRichEdit - ready function
Answer:
procedure AddRichLine(RichEdit: TRichEdit; const StrToAdd: string);
var
StrLeft: string;
TempStyle: TFontStyles;
TempStr: string;
function FromLeftUntilStr(var OriginalStr: string; const UntilStr: string; const
ToEndIfNotFound, Trim: Boolean): string;
var
TempPos: Integer;
begin
TempPos := Pos(UntilStr, OriginalStr);
if TempPos > 0 then
begin
Result := Copy(OriginalStr, 1, TempPos - 1);
if Trim then
Delete(OriginalStr, 1, TempPos - 1);
end
else
begin
if ToEndIfNotFound then
begin
Result := OriginalStr;
if Trim then
OriginalStr := '';
end
else
Result := '';
end;
end;
function StrStartsWith(var OriginalStr: string; const StartsWith: string; const
IgnoreCase, Trim: Boolean): Boolean;
var
PartOfOriginalStr: string;
NewStartsWith: string;
begin
PartOfOriginalStr := Copy(OriginalStr, 1, Length(StartsWith));
NewStartsWith := StartsWith;
if IgnoreCase then
begin
PartOfOriginalStr := LowerCase(PartOfOriginalStr);
NewStartsWith := LowerCase(NewStartsWith);
end;
Result := PartOfOriginalStr = NewStartsWith;
if (Result = True) and (Trim = True) then
Delete(OriginalStr, 1, Length(NewStartsWith));
end;
procedure AddToStyle(var Style: TFontStyles; AStyle: TFontStyle);
begin
if not (AStyle in Style) then
Style := Style + [AStyle];
end;
procedure RemoveFromStyle(var Style: TFontStyles; AStyle: TFontStyle);
begin
if AStyle in Style then
Style := Style - [AStyle];
end;
begin
TempStyle := RichEdit.Font.Style;
StrLeft := StrToAdd;
RichEdit.SelStart := Length(RichEdit.Text);
while StrLeft <> '' do
begin
if StrStartsWith(StrLeft, '<', True, False) then
begin
// Bold Style
if StrStartsWith(StrLeft, '', True, True) then
AddToStyle(TempStyle, fsBold);
if StrStartsWith(StrLeft, '', True, True) then
RemoveFromStyle(TempStyle, fsBold);
// Italic Style
if StrStartsWith(StrLeft, '', True, True) then
AddToStyle(TempStyle, fsItalic);
if StrStartsWith(StrLeft, '', True, True) then
RemoveFromStyle(TempStyle, fsItalic);
// Underline Style
if StrStartsWith(StrLeft, '', True, True) then
AddToStyle(TempStyle, fsUnderline);
if StrStartsWith(StrLeft, '', True, True) then
RemoveFromStyle(TempStyle, fsUnderline);
// Color
if StrStartsWith(StrLeft, '', True, True) then
RichEdit.SelAttributes.Color := RichEdit.Font.Color;
if StrStartsWith(StrLeft, '', False, True);
try
RichEdit.SelAttributes.Color := StringToColor(TempStr);
except
RichEdit.SelAttributes.Color := RichEdit.Font.Color;
end;
Delete(StrLeft, 1, 1);
end;
end
else
begin
RichEdit.SelAttributes.Style := TempStyle;
RichEdit.SelText := FromLeftUntilStr(StrLeft, '<', True, True);
end;
RichEdit.SelStart := Length(RichEdit.Text);
end;
RichEdit.SelText := #13#10;
end;
procedure TForm1.Button1Click(Sender: TObject);
begin
AddRichLine(RichEdit1,
'Test: This is a bold test line which is written in blue. Nice?');
end;
Feliratkozás:
Megjegyzések küldése (Atom)
Nincsenek megjegyzések:
Megjegyzés küldése