Forum > LCL
[SOLVED] TRichMemo and text colour
MarkMLl:
I know that this is a bit of an FAQ, but I'm trying to strip things down to the bare minimum without any frills.
I have a TRichMemo set read-only, and am adding logging-style text to the end of its Lines property. All added text will be an entire paragraph followed by a blank line, I will never be adding a partial line or attempting to append to an existing one.
In order to conserve resources and maximise performance, I am periodically deleting entire lines from the start of the Lines property.
The user can scroll the display, but not manipulate the content.
What is the most-straightforward way of saying, at the point in the code where lines are being added, "set the colour to clSomething" such that the colour stays with the text even though lines above it are being deleted?
MarkMLl
MarkMLl:
On Linux this works without further correction for the number of lines etc.:
--- Code: Pascal [+][-]window.onload = function(){var x1 = document.getElementById("main_content_section"); if (x1) { var x = document.getElementsByClassName("geshi");for (var i = 0; i < x.length; i++) { x[i].style.maxHeight='none'; x[i].style.height = Math.min(x[i].clientHeight+15,306)+'px'; x[i].style.resize = "vertical";}};} ---function CurtailedAppend(lines: TStrings; const line: ansistring; var caret: TPoint; blockText: boolean= false; limit: integer= CurtailLimit; slop: integer= -1): integer; begin result := 0; lines.Append(line)end { CurtailedAppend } ; ... (* Output a single line.*)procedure TFrameInfield.PaneAppend(const line: ansistring; colour: TColor= clDefault); const hasBeenVisible: boolean= false; (* Static variable *) var caret: TPoint; lengthBeforeAppend, deletedByAppend: integer; begin lengthBeforeAppend := Length(RichMemoInfield.Lines.Text); deletedByAppend := CurtailedAppend(RichMemoInfield.Lines, line, caret, true); lengthBeforeAppend -= deletedByAppend; (* CurtailedAppend() returns the number of characters deleted (is any) from the *)(* start of the TMemo or TRichMemo. This is used to adjust the start point of *)(* the range to be coloured. *) if colour <> clDefault then // https://wiki.freepascal.org/RichMemo?#Append_mixed_color_text_at_the_end_of_the_RichMemo// This will go wrong if any lines were deleted. {SetRangeColor(Length(Lines.Text) - Length(Lines[Lines.Count - 1]) - Lines.Count - 1, Length(Lines[Lines.Count - 1]), clBlue);} RichMemoInfield.SetRangeColor(lengthBeforeAppend, Length(line), colour); end { TFrameInfield.PaneAppend } ;
I've stripped down CurtailedAppend() there to only append a single line, under normal circumstances it would ensure that the total number of lines was less than some maximum by deleting stuff from the start and would make sure that the most-recent text remained visible.
CurtailedAppend() is tested thoroughly with a TMemo. With a TRichMemo appending text with a defined colour works OK, but it deletion is allowed something goes wrong with the colouration a few lines above the insertion point.
I'll provide more detail once I've stripped stuff down to a bare-bones test app.
MarkMLl
KodeZwerg:
I guess I did not really understand what you try to do, adding colored lines into a richmemo, readonly, remove from time to time some lines by not change colors for other lines.
Okay, all above can be simple done with those helpers:
--- Code: Pascal [+][-]window.onload = function(){var x1 = document.getElementById("main_content_section"); if (x1) { var x = document.getElementsByClassName("geshi");for (var i = 0; i < x.length; i++) { x[i].style.maxHeight='none'; x[i].style.height = Math.min(x[i].clientHeight+15,306)+'px'; x[i].style.resize = "vertical";}};} ---procedure TForm1.AddRichText(const ARichMemo: TRichMemo; const AText: string; const AFont: TFont; const ABackgroundColor: TColor);var StartPos, EndPos: Integer; FontParams: TFontParams;begin StartPos := ARichMemo.SelStart; EndPos := StartPos + Length(AText); FontParams.Color := AFont.Color; FontParams.HasBkClr := True; FontParams.BkColor := ABackgroundColor; FontParams.Name := AFont.Name; FontParams.Size := AFont.Size; FontParams.Style := AFont.Style; FontParams.VScriptPos := vpNormal; ARichMemo.Lines.BeginUpdate; ARichMemo.SelText := AText; ARichMemo.SelStart := StartPos; ARichMemo.SelLength := EndPos - StartPos; ARichMemo.SetTextAttributes(StartPos, EndPos - StartPos, FontParams); ARichMemo.SelStart := EndPos; ARichMemo.Lines.EndUpdate;end; procedure TForm1.AddRichBreak(const ARichMemo: TRichMemo);begin ARichMemo.Lines.BeginUpdate; ARichMemo.SelText := LineEnding; ARichMemo.SelStart := ARichMemo.SelStart + Length(ARichMemo.SelText); ARichMemo.Lines.EndUpdate;end; procedure TForm1.DelRichLine(const ARichMemo: TRichMemo; const ALineNumber: Integer);begin if ALineNumber >= ARichMemo.Lines.Count then Exit; ARichMemo.Lines.BeginUpdate; ARichMemo.Lines.Delete(ALineNumber); ARichMemo.Lines.EndUpdate;end;
use "AddRichText()" to add text at wherever the caret is.
use "AddRichBreak()" to add a CRLF/linebreak wherever the caret is.
use "DelRichLine()" to delete a line, index 0 based for line #1.
Does that help?
cdbc:
Hi
I think Mark is trying to maintain a colored 'viewport', (scrolling as I understand it)...
I, for one, am following his progress :)
Regards Benny
paweld:
@MarkMLI: Or maybe a listbox + HTML is enough for you? see @wp's example in this thread: https://forum.lazarus.freepascal.org/index.php/topic,55971.msg416110.html#msg416110
Navigation
[0] Message Index
[#] Next page