6

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

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

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

所有这些都是 hacky 和缓慢的。您是否知道使用 TRichEdit 或其他更适合该工作的控件来执行此操作的更好（更快）方法？

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

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

4

6 回答 6

9

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

或者使用 Virtual String List / VirtualTreeView组件。只有需要显示的项目才会被渲染，这样可以节省资源。

于 2009-06-13T09:42:20.403 回答
4

假设您的日志有 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 次.. :-)

于 2009-06-13T10:09:49.387 回答
2

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

于 2009-06-14T06:44:35.237 回答
1

你可能想为 Delphi 购买一个词法扫描器或源代码/语法高亮组件。有很多可用的，大多数都不是很贵。在您的情况下，您需要测试一些并找到一个对您的需求足够有效的。

几个例子是：

为了提高突出显示非常大的日志文件的效率，请查看那些专门突出显示文本文件的文件。它们应该非常快。但RichEdit 也确实没有懈怠。

于 2009-06-13T16:17:49.657 回答
1

对于那些感兴趣的人，这是我最终使用的代码。如果将它附加到 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;
于 2009-06-16T10:58:37.367 回答
0

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

以下是我能想到的几个选项：

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

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

于 2009-06-13T09:04:55.487 回答