Forum > LCL
[SOLVED] TRichMemo and text colour
MarkMLl:
--- Quote from: cdbc on May 23, 2024, 11:43:00 am ---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
--- End quote ---
No, I'm trying to append coloured text that stays coloured from that point onwards (i.e. "henceforth") irrespective of scrolling etc. In effect, it's a "default for all new text" rather than the existing "default for everything".
From what I can see, there is no provision to do that. However my code that appends and then colours does appear to work- /unless/ there is subsequent deletion from the start of the text as shown in the partial screenshot of alternating-colour blocks with a colour change after deletion has started.
I'll append a demo program in a day or so when I've had time to chop things down a bit.
MarkMLl
KodeZwerg:
--- Quote from: MarkMLl on May 24, 2024, 09:04:49 am ---No, I'm trying to append coloured text that stays coloured from that point onwards (i.e. "henceforth") irrespective of scrolling etc. In effect, it's a "default for all new text" rather than the existing "default for everything".
--- End quote ---
Sweet, I've understood your initial post :D
--- Quote from: MarkMLl on May 24, 2024, 09:04:49 am ---From what I can see, there is no provision to do that.
--- End quote ---
Sure there is, I've posted the methods that do exact what you want. O:-)
Maybe exchange the "string" with a better suiting one, eg TStrings/TStringList etc ...
MarkMLl:
--- Quote from: KodeZwerg on May 24, 2024, 10:25:05 am ---Sure there is, I've posted the methods that do exact what you want. O:-)
Maybe exchange the "string" with a better suiting one, eg TStrings/TStringList etc ...
--- End quote ---
Not in there /as/ /standard/ then. I'll check that out when I have time, thanks.
MarkMLl
MarkMLl:
--- Quote from: MarkMLl on May 24, 2024, 11:46:56 am ---Not in there /as/ /standard/ then. I'll check that out when I have time, thanks.
--- End quote ---
So what do I have to do to get that example to actually generate output? AddRichText() appears to be having no effect whatsoever.
Test program attached.
MarkMLl
MarkMLl:
I've tracked down my problem: when I was deleting a line at the start of the memo I was adding Length(Lines[0]) to the number of characters I was reporting deleted, when I should have been adding Length(Lines[0]) + 1 to allow for an internal EOL marker. The fact that an entire line was appearing with the wrong colour was an unfortunate coincidence.
I've now got a single function which handles length management of either a TMemo or TRichMemo, with the final line kept in view which is what would be expected for debugging etc. output:
--- 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";}};} ---const CurtailLimit= 256; (* Default limit and slop *) CurtailSlop= 32; (* This is a fraction since +ve *) var CurtailedMemoFteTimeout: integer= 90; (* Seconds *) (* This is typically used to keep the total number of lines in a TMemo etc. below some limit, so that the resources it consumes do not start to impose a bottleneck; this should also be called regularly (say every minute) without a lines parameter to update an internal counter. The return value is the number of characters deleted, including line-ends. If the blockText parameter is false then deletion is of individual lines at the start of the memo, otherwise it continues until it reaches a blank line assumed to indicate the end of a block or paragraph which is also deleted. If hasBeenVisible is false no attempt is made to save and restore the caret position, avoiding the penalty of handling an internal exception if text is being sent to a form known to be hidden. If the slop parameter is +ve then it indicates the fraction by which the size is allowed to "hunt" around the limit; +1 is a special case indicating that there should be no deletion. If the slop parameter is -ve then it is a number of lines rather than a fraction; -1 is a special case indicating a default.*)function CurtailedAppend(const memo: TCustomMemo; const line: ansistring= #$7f; blockText: boolean= false; hasBeenVisible: boolean= true; limit: longword= CurtailLimit; slop: integer= -1): integer; {$define USE_TAG_FOR_TIMEOUT } const ZeroPt: TPoint= (X: 0; Y: 0); var caret: TPoint; trimmedLines, halfSlop: integer; forceToEnd: boolean= false; {$ifdef USE_TAG_FOR_TIMEOUT } procedure setTimer(t: longword); begin if t = 0 then memo.Tag := 0 (* Zero/nil is valid *) else memo.Tag := ptruint(t << 1) or 1 (* Otherwise must not look like pointer *) end { setTimer } ; function getTimer(): longword; begin result := longword(memo.Tag >> 1) end { getTimer } ; {$else } (* Do not declare a static variable for the force-to-end timer if this will be *)(* called in the context of more than one memo. *) // timer: qword= 0; (* Static variable *) procedure setTimer(t: longword); begin {$if declared(timer) } timer := t {$endif } end { setTimer } ; function getTimer(): longword; begin {$if declared(timer) } result := timer {$else } result := 0 {$endif } end { getTimer } ; {$endif } begin result := 0; memo.Lines.BeginUpdate; try (* Save caret position on entry, with special provision for a hidden pane to *)(* avoid a "GetCaretPos called without handle" error. *) if hasBeenVisible then try caret := memo.CaretPos except caret := zeroPt end else caret := zeroPt; (* Initialise the slop and/or limit where not explicitly specified. Slop values *)(* of -1 and +1 are chosen to indicate the default and no-deletion cases since *)(* (-1 div 2) lines is zero and (limit / +1) would result in no retained output *)(* which makes these parameter values redundant. *) case Sign(slop) of -1: if slop = -1 then halfSlop := (limit div CurtailSlop) div 2 else halfSlop := -slop div 2; (* Slop was number of lines *) 0: halfSlop := 0; 1: halfSlop := (limit div slop) div 2 (* Slop was denominator *) end; (* If the cursor (as distinct from scrollbar) has been placed at some position *)(* other that the end of the displayed text then there will not be an automatic *)(* jump to the end as soon as more output arrives. However this is subject to a *)(* timeout so that if the operator is not actively investigating older messages *)(* the memo reverts to a state where it is the newer ones that are displayed. *) trimmedLines := memo.Lines.Count; (* Visible for debugging *) forceToEnd := not (caret.Y < trimmedLines - 1); if (not forceToEnd) and (getTimer() = 0) then setTimer(UnixNow); trimmedLines := 0; try (* If the line contains (only) a <Del> character then this is a dummy operation *)(* (typically invoked by a timer) with the intention of reverting to the end if *)(* the timeout has expired. In practice, don't delete any lines from the start *)(* if the user has scrolled up and is trying to read stuff. *) if line <> #$7f then begin if getTimer() = 0 then begin if (slop <> 1) and (memo.Lines.Count > limit + halfSlop) then begin while memo.Lines.Count > limit - halfSlop do begin result += memo.Lines[0].Length + 1; memo.Lines.Delete(0); trimmedLines += 1; if caret.Y > 0 then caret.Y -= 1 end; (* If that's left us on a non-blank line then advance to the next blank line, *)(* then one more to get rid of that as well. *) if blockText then begin while (memo.Lines.Count > 0) and (memo.Lines[0] <> '') do begin result += memo.Lines[0].Length + 1; memo.Lines.Delete(0); trimmedLines += 1; if caret.Y > 0 then caret.Y -= 1 end; if (memo.Lines.Count > 0) and (memo.Lines[0] = '') then begin result += memo.Lines[0].Length + 1; memo.Lines.Delete(0); trimmedLines += 1; if caret.Y > 0 then caret.Y -= 1 end end end end; (* Scrolling etc. behaviour above and in finally block below largely cribbed *)(* from WatchP0x via PSTalk. *) memo.Lines.Append(line) end finally if forceToEnd or (UnixNow() - getTimer() > CurtailedMemoFteTimeout) then begin if memo.Lines.Count > 0 then begin caret.Y := memo.Lines.Count - 1; caret.X := 0 end; setTimer(0) end end; (* Restore caret position on exit, with special provision for a hidden pane to *)(* avoid the overhead of a "GetCaretPos called without handle" exception. *) if hasBeenVisible then try memo.CaretPos := caret except end finally memo.Lines.EndUpdate endend { CurtailedAppend } ;
For a TMemo it can be called like this:
--- 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";}};} ---(* Output a single line.*)procedure TFrameOutfield.PaneAppend(const line: ansistring); begin CurtailedAppend(MemoOutfield, line, true)end { TFrameOutfield.PaneAppend } ;
while the code for a TRichMemo is only slightly more complex:
--- 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";}};} ---(* Output a single line.*)procedure TFrameInfield.PaneAppend(const line: ansistring; colour: TColor= clDefault); var existingTextLength: integer; begin existingTextLength := Length(RichMemoInfield.Lines.Text); existingTextLength -= CurtailedAppend(RichMemoInfield, line, true); (* CurtailedAppend() returns the number of characters deleted (if 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 RichMemoInfield.SetRangeColor(existingTextLength, Length(line), colour)end { TFrameInfield.PaneAppend } ;
Performance is sufficiently good that I've not investigated appending a block as a single operation. It should be easy enough with CurtailedAppend() called only for the final line, with suitable consideration of the length parameter (the example above doesn't colour the EOL, which might slow line addition down but OTOH might speed deletion up).
Hoping that is useful to somebody.
MarkMLl
Navigation
[0] Message Index
[#] Next page
[*] Previous page