如何在 Delphi 中显示格式化（颜色、样式等）日志？

Question

我需要在 Delphi 2009 中显示格式化日志。格式化不必实现 html 的所有功能，而是实现一小部分功能，例如颜色、字体样式等。

目前我正在使用 TRichEdit 和我自己的专有标签，例如这是蓝色的。 让它与 TRichEdit 一起工作是相当复杂的，因为无法直接访问 RTF 文本。 例如，要将文本着色为蓝色，我必须：

1. 解析附加文本，提取标签，找出需要格式化的文本以及如何格式化。
2. 选择文本。
3. 应用格式设置。
4. 取消选择文本并将所选内容移至文本末尾，为下一次追加做好准备。

所有这些都是很麻烦且缓慢的。 您是否知道使用 TRichEdit 或其他更适合这项工作的控件更好（更快）的方法？

我应该提到我已经考虑过在 TWebBrowser 中使用 HTML。 这种方法的问题是日志的长度可以是 1 到 100000 行。 如果我使用普通的 html 查看器，我每次都需要设置整个文本，而不是简单地附加它。

此外，当我向日志中添加行时，日志需要实时更新。 不仅仅是从文件中读取并显示一次。

Answer 1

简单的解决方案：使用带有自定义绘制方法的 TListBox，并使用仅包含基本信息而不是格式的对象将日志条目放入 TObjectList 中（这将在演示代码中应用）。

或者使用虚拟字符串列表/ VirtualTreeView 组件。 仅渲染需要显示的项目，这将节省资源。

Answer 2

假设你的日志有 1,000,000 行长，你可以忘记使用 HTML 或 RTF，最干净的解决方案（我处理 100-1,000,000 行）是使用（正如 mjustin 建议的那样）一个 TListBox ，以

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

1. 任何对其余部分有用的格式定义你的数据数组应用程序。 我使用一个简单的 LogObject。
2. 将所有 LogObject 存储在 ObjectList 中，每次列表发生更改（添加、删除）时，调整 TListBox.Count 以匹配新的 ObjectList 计数。
3. 自己定义 ListDrawItem 来获取索引，您可以从您的 ObjectList（数据库，无论什么......）获取信息并按需解析。

因为您一次只会查看几个条目，所以“按需解析”方法明显更好，因为当您尝试解析所有百万行时，加载时不会“减慢”。

不知道您的实际问题，我只能说，根据我的经验，这是一项一旦学习和掌握的技术，在大多数面向数据的应用程序中都是有用的。

增强功能包括在列表框上方附加一个标题控件（我将它们包装在一个面板中），您可以创建一个高级的 TListView 控件。 将一些排序逻辑附加到标题控件上的单击事件，您可以对对象列表进行排序，您所要做的就是调用 ListBox.Invalidate 来刷新视图（如果可以的话）。

++ 用于实时更新。 我现在这样做是为了触发计时器事件来调整 ListBox.Count 因为您不想每秒更新列表框 1000 次..:-)

Answer 3

如果您决定按照建议使用 TListbox，请确保允许您的用户将他们正在查看的行的详细信息复制到剪贴板。 没有什么比无法从日志中复制行更糟糕的了。

Answer 4

您可能想要购买 Delphi 的词法扫描器或源代码/语法突出显示组件。 有很多可供选择，而且大多数都不是很贵。 就您的情况而言，您需要测试一些并找到一个足以满足您需求的有效方法。

一些示例是：

• MBLabSoft 的源代码扫描仪

• 语法高亮组件 - 列出SynEdit（打开源）、Scintilla、Tsyncontrol 和其他一些

• Serhiy Perevoznyk 的 RichEdit 语法荧光笔

为了提高突出显示非常大的日志文件的效率，请查看专门的内容突出显示文本文件。 他们应该非常快。 但 RichEdit 也确实不逊色。

Answer 5

对于那些感兴趣的人，这是我最终使用的代码。 如果将其附加到 TVirtualStringTree 的 OnAfterCellPaint 事件，它将给出所需的结果。

(*
  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;

Answer 6

我猜您想显示现有的纯文本日志，但要对其应用颜色？

我能想到的有以下几种选择：

• 直接编写 RTF； AFAIK，TRichEdit 确实提供了对 RTF 代码的直接访问； 只需将 PlainText 属性切换为 False，然后设置 Text 字符串属性即可。 但是...祝你好运，组装正确的 RTF 代码。
• 将日志转换为 HTML，并使用 TWebBrowser 控件来显示它。
• 使用 Scintilla （或其他）突出显示控件，并滚动您自己的语法突出显示...

如果您是自己编写日志，您也可以首先使用 TRichEdit 生成 RTF 格式的日志。 或者，您可以生成 HTML 或 XML 格式的日志（然后可以使用 XSLT 将其转换为您喜欢的任何内容）。