Как отобразить отформатированный (цвет, стиль и т. Д.) Журнал в Delphi?

Question

Мне нужно отобразить отформатированный журнал в Delphi 2009. Форматирование не должно реализовывать все функции, скажем, html, но небольшое подмножество, например. цвет, стиль шрифта и т. д.

В настоящее время я использую TRichEdit и мои собственные теги собственности, например. это синий Довольно сложно заставить это работать с TRichEdit, так как нет прямого доступа к тексту RTF. Например, чтобы закрасить текст синим цветом, мне нужно:

1. Разбор приложенного текста, извлечение тегов, определение того, какой текст необходимо отформатировать и как.
2. Выберите текст.
3. Применить форматирование.
4. Отмените выделение текста и переместите выделение в конец текста, готового к следующему добавлению.

Все это нахально и медленно. Знаете ли вы о лучшем (более быстром) способе сделать это с помощью TRichEdit или другого элемента управления, который лучше подходит для работы?

Я должен упомянуть, что я рассмотрел использование HTML в TWebBrowser. Проблема этого подхода заключается в том, что длина журнала может составлять от 1 до 100000 строк. Если я использую обычный просмотрщик HTML, мне нужно каждый раз устанавливать весь текст, а не просто добавлять его.

Кроме того, журнал должен обновляться в режиме реального времени, так как я добавляю в него строки. Не просто читать из файла и отображать один раз.

Answer 1

Простое решение: используйте TListBox с пользовательскими методами рисования и поместите записи журнала в TObjectList, используя объекты, которые содержат только основную информацию, а не форматирование (это будет применяться в коде презентации).

Или используйте компонент Virtual String List / 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. Сохраняйте все объекты LogObjects в ObjectList, каждый раз, когда в список вносятся изменения (добавляются, удаляются), настраивайте TListBox.Count в соответствии с новым счетчиком ObjectList.
3. Определите ListDrawItem самостоятельно, чтобы взять индекс, и вы можете получить информацию из вашего ObjectList (база данных, что угодно ..) и анализировать по требованию.

Поскольку вы будете просматривать только несколько записей за раз, подход «анализ по требованию» значительно лучше, так как не происходит «замедления» во время загрузки, когда вы пытаетесь проанализировать все миллионы строк.

Не зная вашей реальной проблемы, я могу просто сказать, что по моему опыту эта техника, которая когда-то изучена и освоена, полезна в большинстве приложений, ориентированных на данные.

Улучшения включают в себя прикрепление элемента управления заголовка над списком (я обертываю их вместе на панели), и вы можете создать превосходный элемент управления TListView. Прикрепите немного логики сортировки к событию click в элементе управления заголовка, и вы можете отсортировать список объектов, и все, что вам нужно сделать, это вызвать ListBox.Invalidate, чтобы обновить представление (когда это возможно).

++ Для обновления в реальном времени. Я делаю это в данный момент, чтобы вызвать событие таймера для настройки ListBox.Count, поскольку вы не хотите обновлять список 1000 раз в секунду ..: -)

Answer 3

, если вы решите использовать TListbox в соответствии с предложением, убедитесь, что вы разрешаете своим пользователям копировать информацию о строке, которую они просматривают, в буфер обмена. Нет ничего хуже, чем невозможность скопировать строки из журнала.

Answer 4

Возможно, вы захотите приобрести лексический сканер или компонент подсветки исходного кода / синтаксиса для Delphi. Есть много доступных и большинство не очень дорого. В вашем случае вы захотите протестировать несколько и найти тот, который достаточно эффективен для ваших нужд.

Вот несколько примеров:

• Сканеры исходного кода от MBLabSoft

• Компоненты подсветки синтаксиса - список SynEdit (с открытым исходным кодом) , Scintilla, Tsyncontrol и некоторые другие

• RichEdit Syntax Highlighter, Сергей Перевозник

Для эффективности выделения очень большого файла журнала посмотрите на те, которые специализируются на выделении текстовых файлов. Они должны быть очень быстрыми. Но RichEdit на самом деле тоже не дурак.

Answer 5

Для тех, кто заинтересован, вот код, который я в итоге использовал. Если вы присоедините это к событию OnAfterCellPaint объекта TVirtualStringTree, это даст желаемые результаты.

(*
  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, а затем установите свойство текстовой строки. Но ... удачи в сборке правильного кода RTF.
• Преобразуйте журнал в HTML и используйте элемент управления TWebBrowser, чтобы отобразить его.
• Используйте Scintilla (или другой) элемент управления подсветкой и накатывайте собственную подсветку синтаксиса ...

Если вы пишете журнал самостоятельно, вы также можете использовать TRichEdit для создания журнала в RTF. Или вы можете сгенерировать журнал в HTML или в XML (который затем можно преобразовать во что угодно, используя XSLT).