Add formatted line (with TAGs) to TRichEdit - ready function (Views: 31)
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; |