TRichEdit with VCL styles

[aehimself 388]

Hello,

 

I recently started to experiment with Delphi's TRichEdit control. There is one thing left which I don't know if I'm doing it right; and that's to 'repaint' the document to follow VCL styles.

RTF seems to include the generic text color, which is dark if the document was exported with a light / Windows style. If you load the same document back to a RichEdit, which has a dark style active the text will be unreadable.

 

The solution was rather easy:

  ro := RichEdit.ReadOnly;
  Try
    RichEdit.ReadOnly := False;
    RichEdit.Lines.LoadFromStream(myStream);
    RichEdit.DefAttributes.Color := TStyleManager.ActiveStyle.GetStyleFontColor(sfEditBoxTextNormal);
    RichEdit.Modified := False;
  Finally
    RichEdit.ReadOnly := ro;
  End;

First, I need to make the RichEdit non-read only, otherwise pictures won't show up in the loaded document. Then, load the stream and change the default color according to the current style. Then simply reset the Modified to false and ReadOnly to the original value.

This all seems to work but with this, even hyperlinks are recolored to the default color. They retain their link attributes and formatting, only the color is lost.

 

Is this a normal phenomenon? Should I parse the whole document and recolor all links from code? Or I'm simply loading / saving the document the wrong way?

 

I appreciate all tips 🙂

Thanks!

[aehimself 388]

I really do suspect that this is a bug. The color of uncolored text is clWindowText, it's just RichEdit is rendering it in a wrong color.

I'm not good with StyleHooks to actually fix it... I did find a workaround and however it works, it's painfully slow:

  TMyRichEdit = Class(Vcl.ComCtrls.TRichEdit)
  strict private
    Procedure StreamIn(Var Msg: TMessage); Message EM_STREAMIN;
  End;

Procedure TMyRichEdit.StreamIn(Var Msg: TMessage);
Var
  a: Integer;
Begin
  inherited;

  Self.LockDrawing;
  Try
    Self.SelStart := Integer.MaxValue;

    For a := 0 To Self.SelStart Do
    Begin
      Self.SelStart := a;
      If Self.SelStart <> a Then
        Continue;

      Self.SelLength := 1;
      If Self.SelAttributes.Color = clWindowtext Then
        Self.SelAttributes.Color := TStyleManager.ActiveStyle.GetStyleFontColor(sfEditBoxTextNormal);
    End;

    Self.SelStart := 0;
  Finally
    Self.UnlockDrawing;
  End;
End;

The amount of .SelStart is causing the slowdown. Does anyone know how I can extract the start and end of consecutive blocks, where all formatting is the same? That should speed things up a LOT.

 

I'll look into how exactly RichEdit is setting the properties of SelAttributes - maybe I can extract the attribute at a specific location without having to move the cursor, that way the only SelStart - SelLength would be at blocks what I actually have to change.

[PeterBelow 218]

Have you tried to just set DefAttributes.Color  before calling the inherited StreamIn method? SelAttributes.ConsistentAttributes may also be of use if you really need to manually correct the font color.

[aehimself 388]

1 hour ago, PeterBelow said:

Have you tried to just set DefAttributes.Color  before calling the inherited StreamIn method? SelAttributes.ConsistentAttributes may also be of use if you really need to manually correct the font color.

Yes, and unfortunately loading the stream overwrites this setting; it has no effect in the new document being loaded.

My issue with ConsistentAttributes is that it needs a selection - and for that I need to reposition the cursor again, most probably ending up at the same slowdown.

 

I'm attempting to experiment with EM_GETTEXTRANGE but unfortunately it doesn't seem to care about formatting at all, just returns as many characters as I desire.

[PeterBelow 218]

1 hour ago, aehimself said:

Yes, and unfortunately loading the stream overwrites this setting; it has no effect in the new document being loaded.

My issue with ConsistentAttributes is that it needs a selection - and for that I need to reposition the cursor again, most probably ending up at the same slowdown.

 

I'm attempting to experiment with EM_GETTEXTRANGE but unfortunately it doesn't seem to care about formatting at all, just returns as many characters as I desire.

As far as I know the MS richedit common control does not support owner drawing at all, which is the reason why styling does not work for it. You could try to parse the rich text and modify the main color table in it before it is loaded, but I would rate that as a desparate measure; the RTF format is complex, to say the least.

 

You could try to select larger blocks of text  (e.g. lines or paragraphs) to find some with consistent text color; if your text is mainly the default color that may reduce the number of SelStart/SelLength calls needed to a managable number.

 

[aehimself 388]

Ok, I'm getting baffled. Time is lost in the space-time continuum.

 

I added a ton of measuring to the code, looks like this now:

Procedure TRichEdit.StreamIn(Var Msg: TMessage);
Var
 a, b: Integer;
 ro: Boolean;
 sw, fsw: TStopWatch;
 needcolor: Boolean;
 sscount, slcount, clcount, gscount, nccount: Integer;
 ssdelay, sldelay, cldelay, gsdelay, lddelay, ulddelay, loading, rodelay, moddelay, ncdelay: Int64;
 s: String;
Begin
 fsw := TStopWatch.StartNew;

 sscount := 0;
 ssdelay := 0;
 slcount := 0;
 sldelay := 0;
 clcount := 0;
 cldelay := 0;
 gscount := 0;
 gsdelay := 0;
 lddelay := 0;
 ulddelay := 0;
 rodelay := 0;
 moddelay := 0;
 nccount := 0;
 ncdelay := 0;

 sw := TStopWatch.StartNew;
 Self.LockDrawing;
 lddelay := sw.ElapsedMilliseconds;
 Try
  ro := Self.ReadOnly;
  Try
   sw := TStopWatch.StartNew;
   Self.ReadOnly := False;
   Inc(rodelay, sw.ElapsedMilliseconds);

   sw := TStopWatch.StartNew;
   inherited;
   loading := sw.ElapsedMilliseconds;
  Finally
   sw := TStopWatch.StartNew;
   Self.ReadOnly := ro;
   Inc(rodelay, sw.ElapsedMilliseconds);
  End;

  Inc(sscount);
  sw := TStopWatch.StartNew;
  Self.SelStart := Integer.MaxValue;
  Inc(ssdelay, sw.ElapsedMilliseconds);

  Inc(gscount);
  sw := TStopWatch.StartNew;
  b := Self.SelStart;
  Inc(gsdelay, sw.ElapsedMilliseconds);

  For a := 0 To b Do
   Begin
    Inc(sscount);
    sw := TStopWatch.StartNew;
    Self.SelStart := a;
    Inc(ssdelay, sw.ElapsedMilliseconds);

    Inc(gscount);
    sw := TStopWatch.StartNew;
    Try
     If Self.SelStart <> a Then Continue;
    Finally
     Inc(gsdelay, sw.ElapsedMilliseconds);
    End;

    Inc(slcount);
    sw := TStopWatch.StartNew;
    Self.SelLength := 1;
    Inc(sldelay, sw.ElapsedMilliseconds);

    Inc(nccount);
    sw := TStopWatch.StartNew;
    needcolor := Self.SelAttributes.Color = clWindowtext;
    Inc(ncdelay, sw.ElapsedMilliseconds);

    If needcolor Then
    Begin
     Inc(clcount);
     sw := TStopWatch.StartNew;
     Self.SelAttributes.Color := TStyleManager.ActiveStyle.GetStyleFontColor(sfEditBoxTextNormal);
     Inc(cldelay, sw.ElapsedMilliseconds);
    End;
   End;

  Inc(sscount);
  sw := TStopWatch.StartNew;
  Self.SelStart := 0;
  Inc(ssdelay, sw.ElapsedMilliseconds);

  sw := TStopWatch.StartNew;
  Self.Modified := False;
  moddelay := sw.ElapsedMilliseconds;
 Finally
  sw := TStopWatch.StartNew;
  Self.UnlockDrawing;
  ulddelay := sw.ElapsedMilliseconds;
 End;

 sw := TStopWatch.StartNew;
 s := 'SelStart count: ' + sscount.ToString + ', total time: ' + ssdelay.ToString + ' ms' + sLineBreak +
             'SelLength count: ' + slcount.ToString + ', total time: ' + sldelay.ToString + ' ms' + sLineBreak +
             'NeedColor count: ' + nccount.ToString + ', total time: ' + ncdelay.ToString + ' ms' + sLineBreak +
             'Coloring count: ' + clcount.ToString + ', total time: ' + cldelay.ToString + ' ms' + sLineBreak +
             'GetSelStart count: ' + gscount.ToString + ', total time: ' + gsdelay.ToString + ' ms' + sLineBreak +
             'Locking: ' + lddelay.ToString + ' ms, unlocking: ' + ulddelay.ToString + ' ms, loading: ' + loading.ToString + ' ms, read-only: ' + rodelay.ToString + ' ms, modified: ' + moddelay.ToString + ' ms' + sLineBreak +
             'Full cycle: ' + fsw.ElapsedMilliseconds.ToString + ' ms' + sLineBreak +
             'Building message: ' + sw.ElapsedMilliseconds.ToString + ' ms';
 ShowMessage(s);
End;

Loading a 7 kb RTF file with no coloring, only links and a bulleted list results:

Quote

SelStart count: 2140, total time: 730 ms
SelLength count: 703, total time: 816 ms
NeedColor count: 703, total time: 0 ms
Coloring count: 85, total time: 5 ms
GetSelStart count: 2139, total time: 0 ms
Locking: 0 ms, unlocking: 0 ms, loading: 6 ms, read-only: 0 ms, modified: 0 ms
Full cycle: 3247 ms
Building message: 0 ms

Setting SelStarts took 730 ms, setting SelLengths took 816 ms, a total of 1546 ms.  So how the full cycle is 3247 ms, which is more than double...?

 

Loading the same with no VCL styles active makes it even more visible:

Quote

 

SelStart count: 2140, total time: 11 ms
SelLength count: 703, total time: 111 ms
NeedColor count: 703, total time: 0 ms
Coloring count: 85, total time: 0 ms
GetSelStart count: 2139, total time: 0 ms
Locking: 0 ms, unlocking: 0 ms, loading: 5 ms, read-only: 0 ms, modified: 0 ms
Full cycle: 1847 ms
Building message: 0 ms

 

What I did not measure yet...?

 

I know TStopWatch is not the most precise system, but it can not be missing this much...

[aehimself 388]

I discovered a trick. If you put SelStart before a link and set SelLength to 1, RichEdit will select the FULL link text... like

Quote

HYPERLINK "https://en.delphipraxis.net"Delphi Praxis

The good news in this is that we can optimize the checking cycle to use this feature:

  Self.SelStart := Integer.MaxValue;
  max := Self.SelStart;

  a := 0;
  While a < max Do
  Begin
    Self.SelStart := a;
    Self.SelLength := 1;

    If Self.SelAttributes.Color = clWindowtext Then
      Self.SelAttributes.Color := TStyleManager.ActiveStyle.GetStyleFontColor(sfEditBoxTextNormal);

    a := Self.SelStart + Self.SelLength;
  End;

Instead of 3000+ msec, the cycle now finishes in 500!

 

Still not ideal, but a lot more bearable 🙂