How do I display a formatted (colour, style etc) log in Delphi?

Question

I need to display a formatted log in Delphi 2009. The formatting does not have to implement all the features of say html, but a small subset e.g. colour, font style etc.

Currently I am using a TRichEdit and my own proprietry tags e.g. this is blue. It is pretty convoluted to get this to work with a TRichEdit as there is no direct access to the RTF text. For example, to colour the text blue I have to:

1. Parse the appended text extracting the tags, figuring out what text needs to be formatted and how.
2. Select the text.
3. Apply the formatting.
4. Deselect the text and move the selection to the end of the text ready for the next append.

All this is hacky and slow. Do you know of a better (faster) way to do this with TRichEdit or another control that is better suited to the job?

I should mention that I have considered using HTML in a TWebBrowser. The problem with this approach is that the log can be anywhere from 1 to 100000 lines long. If I use a normal html viewer I need to set the entire text each time rather than simply appending it.

Additionally, the log needs to be updated in real time as I append lines to it. Not simply read from a file and displayed once.

Answer 1

Simple solution: use a TListBox with custom draw methods, and put the log entries in an TObjectList using objects which only contain the basic information, not the formatting (this will be applied in the presentation code).

Or use a Virtual String List / VirtualTreeView component. Only the items which need to be displayed will be rendered, this will save resources.

Answer 2

Assuming your log is 1,000,000 lines long you can forget using HTML or RTF, the cleanest solution (and I handle 100-1,000,000)is to use (as mjustin suggests) a TListBox with

Style := lbVirtualOwnerDraw;
OnDrawItem := ListDrawItem; // your own function (example in help file)

1. Define your data array in whatever format is useful for the rest of the application. I go with a simple LogObject.
2. Store all the LogObjects in a ObjectList, everytime there is an change to the list (add, remove), adjust the TListBox.Count to match the new ObjectList count.
3. Define ListDrawItem yourself to take the index and you can get the information from youe ObjectList (database, whatever..) and parse on demand.

Because you will only be viewing a few entries at a time, the "on demand parsing" approach is significantly better as there is no "slow down" at load time as you try to parse all million lines.

Not knowing your actual problem I can just say that in my experience this is a technique that once learned and mastered is useful in most data oriented application.

Enhancements include attacheing a header control above the list box (I wrap them together in a panel) and you can create a superior TListView Control. Attach a bit of sort logic to the click event on the header control and you can sort your object list and all you have to do is call ListBox.Invalidate to refresh the view (when it can).

++ For realtime updating. I do this at the moment, is to trigger a timer event to adjust the ListBox.Count as you don't want to update the listbox 1000 times a second.. :-)

Answer 3

if you decide to use a TListbox as suggested, please make sure you allow your users to copy details of line they are viewing to clipboard. There is nothing worse than not being able to copy lines from a log.

Answer 4

You might want to purchase a lexical scanner or source code / syntax highlighter component for Delphi. There are many available and most are not very expensive. In your case, you'll want to test a few and find one that's efficient enough for your needs.

A few examples are:

• Source Code Scanners by MBLabSoft

• Syntax Highlighting components - listing SynEdit (open source), Scintilla, Tsyncontrol and a few others

• RichEdit Syntax Highlighter by Serhiy Perevoznyk

For efficiency in highlighting a very large log file, look at the ones that specialize in highlighting text files. They should be extremely fast. But RichEdit is really no slouch either.

Answer 5

For those that are interested, here's the code that I ended up using. If you attach this to the OnAfterCellPaint event of a TVirtualStringTree it gives the desired results.

(*
  DrawHTML - Draws text on a canvas using tags based on a simple subset of HTML/CSS

  <B> - Bold e.g. <B>This is bold</B>
  <I> - Italic e.g. <I>This is italic</I>
  <U> - Underline e.g. <U>This is underlined</U>
  <font-color=x> Font colour e.g.
                <font-color=clRed>Delphi red</font-color>
                <font-color=#FFFFFF>Web white</font-color>
                <font-color=$000000>Hex black</font-color>
  <font-size=x> Font size e.g. <font-size=30>This is some big text</font-size>
  <font-family> Font family e.g. <font-family=Arial>This is arial</font-family>
*)
procedure TfrmSNMPMIBBrowser.DrawHTML(const ARect: TRect; const ACanvas: TCanvas; const Text: String);

  function CloseTag(const ATag: String): String;
  begin
    Result := concat('/', ATag);
  end;

  function GetTagValue(const ATag: String): String;
  var
    p: Integer;
  begin
    p := pos('=', ATag);

    if p = 0 then
      Result := ''
    else
      Result := copy(ATag, p + 1, MaxInt);
  end;

  function ColorCodeToColor(const Value: String): TColor;
  var
    HexValue: String;
  begin
    Result := 0;

    if Value <> '' then
    begin
      if (length(Value) >= 2) and (copy(Uppercase(Value), 1, 2) = 'CL') then
      begin
        // Delphi colour
        Result := StringToColor(Value);
      end else
      if Value[1] = '#' then
      begin
        // Web colour
        HexValue := copy(Value, 2, 6);

        Result := RGB(StrToInt('$'+Copy(HexValue, 1, 2)),
                      StrToInt('$'+Copy(HexValue, 3, 2)),
                      StrToInt('$'+Copy(HexValue, 5, 2)));
      end
      else
        // Hex or decimal colour
        Result := StrToIntDef(Value, 0);
    end;
  end;

const
  TagBold = 'B';
  TagItalic = 'I';
  TagUnderline = 'U';
  TagBreak = 'BR';
  TagFontSize = 'FONT-SIZE';
  TagFontFamily = 'FONT-FAMILY';
  TagFontColour = 'FONT-COLOR';

var
  x, y, idx, CharWidth, MaxCharHeight: Integer;
  CurrChar: Char;
  Tag, TagValue: String;
  PreviousFontColor: TColor;
  PreviousFontFamily: String;
  PreviousFontSize: Integer;

begin
  // Start - required if used with TVirtualStringTree
  ACanvas.Font.Size := Canvas.Font.Size;
  ACanvas.Font.Name := Canvas.Font.Name;
  ACanvas.Font.Color := Canvas.Font.Color;
  ACanvas.Font.Style := Canvas.Font.Style;
  // End

  PreviousFontColor := ACanvas.Font.Color;
  PreviousFontFamily := ACanvas.Font.Name;
  PreviousFontSize := ACanvas.Font.Size;

  x := ARect.Left;
  y := ARect.Top;
  idx := 1;

  MaxCharHeight := ACanvas.TextHeight('Ag');

  While idx <= length(Text) do
  begin
    CurrChar := Text[idx];

    // Is this a tag?
    if CurrChar = '<' then
    begin
      Tag := '';

      inc(idx);

      // Find the end of then tag
      while (Text[idx] <> '>') and (idx <= length(Text)) do
      begin
        Tag := concat(Tag,  UpperCase(Text[idx]));

        inc(idx);
      end;

      ///////////////////////////////////////////////////
      // Simple tags
      ///////////////////////////////////////////////////
      if Tag = TagBold then
        ACanvas.Font.Style := ACanvas.Font.Style + [fsBold] else

      if Tag = TagItalic then
        ACanvas.Font.Style := ACanvas.Font.Style + [fsItalic] else

      if Tag = TagUnderline then
        ACanvas.Font.Style := ACanvas.Font.Style + [fsUnderline] else

      if Tag = TagBreak then
      begin
        x := ARect.Left;

        inc(y, MaxCharHeight);
      end else

      ///////////////////////////////////////////////////
      // Closing tags
      ///////////////////////////////////////////////////
      if Tag = CloseTag(TagBold) then
        ACanvas.Font.Style := ACanvas.Font.Style - [fsBold] else

      if Tag = CloseTag(TagItalic) then
        ACanvas.Font.Style := ACanvas.Font.Style - [fsItalic] else

      if Tag = CloseTag(TagUnderline) then
        ACanvas.Font.Style := ACanvas.Font.Style - [fsUnderline] else

      if Tag = CloseTag(TagFontSize) then
        ACanvas.Font.Size := PreviousFontSize else

      if Tag = CloseTag(TagFontFamily) then
        ACanvas.Font.Name := PreviousFontFamily else

      if Tag = CloseTag(TagFontColour) then
        ACanvas.Font.Color := PreviousFontColor else

      ///////////////////////////////////////////////////
      // Tags with values
      ///////////////////////////////////////////////////
      begin
        // Get the tag value (everything after '=')
        TagValue := GetTagValue(Tag);

        if TagValue <> '' then
        begin
          // Remove the value from the tag
          Tag := copy(Tag, 1, pos('=', Tag) - 1);

          if Tag = TagFontSize then
          begin
            PreviousFontSize := ACanvas.Font.Size;
            ACanvas.Font.Size := StrToIntDef(TagValue, ACanvas.Font.Size);
          end else

          if Tag = TagFontFamily then
          begin
            PreviousFontFamily := ACanvas.Font.Name;
            ACanvas.Font.Name := TagValue;
          end;

          if Tag = TagFontColour then
          begin
            PreviousFontColor := ACanvas.Font.Color;
            ACanvas.Font.Color := ColorCodeToColor(TagValue);
          end;
        end;
      end;
    end
    else
    // Draw the character if it's not a ctrl char
    if CurrChar >= #32 then
    begin
      CharWidth := ACanvas.TextWidth(CurrChar);

      if x + CharWidth > ARect.Right then
      begin
        x := ARect.Left;

        inc(y, MaxCharHeight);
      end;

      if y + MaxCharHeight < ARect.Bottom then
      begin
        ACanvas.Brush.Style := bsClear;

        ACanvas.TextOut(x, y, CurrChar);
      end;

      x := x + CharWidth;
    end;

    inc(idx);
  end;
end;