代码之家  ›  专栏  ›  技术社区  ›  norgepaul

如何在Delphi中显示格式化的(颜色、样式等)日志?

  •  5
  • norgepaul  · 技术社区  · 16 年前

    我需要在Delphi2009中显示格式化的日志。格式化不必实现HTML的所有功能,只需要一个子集,例如颜色、字体样式等。

    目前,我使用的是TrichEdit和我自己的专有标签,例如,这是蓝色的。让它与trichedit一起工作是非常复杂的,因为没有直接访问RTF文本的权限。例如,要将文本染成蓝色,我必须:

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

    这一切都是老生常谈的。你知道用Trichedit或另一个更适合工作的控件进行此操作的更好(更快)的方法吗?

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

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

    6 回复  |  直到 16 年前
        1
  •  9
  •   mjn anonym    16 年前

    简单的解决方案:使用带有自定义绘制方法的tlistbox,并使用只包含基本信息而不包含格式的对象将日志条目放入TobjectList(这将在演示代码中应用)。

    或者使用虚拟字符串列表/ VirtualTreeView 组件。只呈现需要显示的项目,这将节省资源。

        2
  •  4
  •   Just Jules    16 年前

    假设您的日志长度为1000000行,您可以忘记使用HTML或RTF,最干净的解决方案(我处理100-1000000)是使用(如Mjustin建议的)一个具有

    Style := lbVirtualOwnerDraw;
    OnDrawItem := ListDrawItem; // your own function (example in help file)
    
    1. 以对应用程序其余部分有用的任何格式定义数据数组。我使用一个简单的logo对象。
    2. 将所有logo对象存储在对象列表中,每次列表发生更改(添加、删除)时,请调整tlistbox.count以匹配新的对象列表计数。
    3. 自己定义listDrawItem以获取索引,您可以从对象列表(数据库,无论什么..)中获取信息,并根据需要进行分析。

    因为一次只能查看几个条目,“按需解析”方法明显更好,因为在您尝试解析所有百万行时,在加载时没有“减速”。

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

    增强功能包括在列表框上方附加一个标题控件(我将它们包装在一个面板中),您可以创建一个高级的tlistview控件。在header控件的click事件上附加一点排序逻辑,您可以对对象列表进行排序,您所要做的就是调用列表框。如果可以的话,使其无效以刷新视图。

    ++用于实时更新。我现在这样做,是触发一个计时器事件来调整列表框。因为您不想每秒更新列表框1000次,所以计数。-)

        3
  •  1
  •   lkessler    16 年前

    您可能需要为Delphi购买词汇扫描器或源代码/语法高亮显示组件。有很多可用的,大多数不是很贵。在您的情况下,您将希望测试一些,并找到一个有效的足够您的需要。

    几个例子是:

    为了提高突出显示非常大的日志文件的效率,请查看专门突出显示文本文件的日志文件。它们应该非常快。但里奇德也不是一个懒散的人。

        4
  •  1
  •   Toby Allen mercator    16 年前

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

        5
  •  0
  •   Martijn    16 年前

    我想你想展示一个现有的纯文本日志,但要对其应用颜色吗?

    我可以想到以下几种选择:

    • 直接写入rtf;afaik,trichedit提供了对rtf代码的直接访问;只需将plaintext属性切换为false,然后设置文本字符串属性。但是…祝您组装正确的RTF代码。
    • 将日志转换为HTML,并使用twebBrowser控件显示它。
    • 使用 Scintilla (或其他)突出显示控件,并滚动您自己的语法突出显示…

    如果您自己编写日志,也可以首先使用trichedit在rtf中生成日志。或者,您可以用HTML或XML生成日志(然后可以使用XSLT将其转换为您喜欢的任何内容)。

        6
  •  0
  •   norgepaul    16 年前

    对于那些感兴趣的人,这里是我最终使用的代码。如果将此附加到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;