Komponent do wyświetlania informacji dziennika w Delphi

Question

Mam wiele złożonych zadań przetwarzania, które będą generować komunikaty, ostrzeżenia i błędy krytyczne. Chcę móc wyświetlać te komunikaty w komponencie niezależnym od zadania. Moje wymagania to:

• Różne rodzaje wiadomości wyświetlane są w różnych kolorach czcionki i/lub w tle.

• Wyświetlacz można filtrować w celu uwzględnienia lub wykluczenia każdego rodzaju wiadomości.

• Wyświetlacz prawidłowo obsługuje długie wiadomości, owijając je i wyświetlając całą wiadomość.

• Każda wiadomość może mieć dołączony odnośnik do danych, a wiadomość może zostać wybrana jako encja (np. Zapis do memo RTF nie zadziała).

W gruncie rzeczy, szukam jakiegoś rodzaju listbox, jak komponent obsługujący kolory, filtrowanie i zawijanie wierszy. Czy każdy może zaproponować taki komponent (lub inny) do użycia jako podstawę do wyświetlania mojego dziennika?

W przeciwnym razie napiszę własne. Moja początkowa myśl polega na tym, że powinienem oprzeć komponent na TDBGrid z wbudowanym TClientDataset. Dodałbym wiadomości do zestawu danych klienta (z kolumną dla typu wiadomości) i obsługiwałam filtrowanie poprzez metody zestawów danych i kolorowanie poprzez metody losowania siatki.

Twoje przemyślenia na temat tego projektu są mile widziane.

[Uwaga: W tej chwili nie jestem szczególnie zainteresowany pisanie dziennika do pliku lub integracji z logowaniem w systemie Windows (o ile nie robi tak rozwiązuje mój problem wyświetlacza)]

Answer 1

Napisałem komponent dziennika, który robi większość tego, czego potrzebujesz i jest oparty na VitrualTreeView. Musiałem trochę zmienić kod, aby usunąć niektóre zależności, ale kompiluje się dobrze (chociaż nie został przetestowany po zmianach). Nawet jeśli nie jest to dokładnie to, czego potrzebujesz, może to być dobra baza do rozpoczęcia pracy.

Oto kod

unit UserInterface.VirtualTrees.LogTree; 

// Copyright (c) Paul Thornton 

interface 

uses 
Classes, SysUtils, Graphics, Types, Windows, ImgList, 
Menus, 

VirtualTrees; 

type 
TLogLevel = (llNone,llError,llInfo,llWarning,llDebug); 

TLogLevels = set of TLogLevel; 

TLogNodeData = record 
    LogLevel: TLogLevel; 
    Timestamp: TDateTime; 
    LogText: String; 
end; 
PLogNodeData = ^TLogNodeData; 

TOnLog = procedure(Sender: TObject; var LogText: String; var 
CancelEntry: Boolean; LogLevel: TLogLevel) of object; 
TOnPopupMenuItemClick = procedure(Sender: TObject; MenuItem: 
TMenuItem) of object; 

TVirtualLogPopupmenu = class(TPopupMenu) 
private 
    FOwner: TComponent; 
    FOnPopupMenuItemClick: TOnPopupMenuItemClick; 

    procedure OnMenuItemClick(Sender: TObject); 
public 
    constructor Create(AOwner: TComponent); override; 

    property OnPopupMenuItemClick: TOnPopupMenuItemClick read 
FOnPopupMenuItemClick write FOnPopupMenuItemClick; 
end; 

TVirtualLogTree = class(TVirtualStringTree) 
private 
    FOnLog: TOnLog; 
    FOnAfterLog: TNotifyEvent; 

    FHTMLSupport: Boolean; 
    FAutoScroll: Boolean; 
    FRemoveControlCharacters: Boolean; 
    FLogLevels: TLogLevels; 
    FAutoLogLevelColours: Boolean; 
    FShowDateColumn: Boolean; 
    FShowImages: Boolean; 
    FMaximumLines: Integer; 

    function DrawHTML(const ARect: TRect; const ACanvas: TCanvas; 
const Text: String; Selected: Boolean): Integer; 
    function GetCellText(const Node: PVirtualNode; const Column: 
TColumnIndex): String; 
    procedure SetLogLevels(const Value: TLogLevels); 
    procedure UpdateVisibleItems; 
    procedure OnPopupMenuItemClick(Sender: TObject; MenuItem: TMenuItem); 
    procedure SetShowDateColumn(const Value: Boolean); 
    procedure SetShowImages(const Value: Boolean); 
    procedure AddDefaultColumns(const ColumnNames: array of String; 
    const ColumnWidths: array of Integer); 
    function IfThen(Condition: Boolean; TrueResult, 
    FalseResult: Variant): Variant; 
    function StripHTMLTags(const Value: string): string; 
    function RemoveCtrlChars(const Value: String): String; 
protected 
    procedure DoOnLog(var LogText: String; var CancelEntry: Boolean; 
LogLevel: TLogLevel); virtual; 
    procedure DoOnAfterLog; virtual; 

    procedure DoAfterCellPaint(Canvas: TCanvas; Node: PVirtualNode; 
Column: TColumnIndex; CellRect: TRect); override; 
    procedure DoGetText(Node: PVirtualNode; Column: TColumnIndex; 
TextType: TVSTTextType; var Text: String); override; 
    procedure DoFreeNode(Node: PVirtualNode); override; 
    function DoGetImageIndex(Node: PVirtualNode; Kind: TVTImageKind; 
Column: TColumnIndex; var Ghosted: Boolean; var Index: Integer): 
TCustomImageList; override; 
    procedure DoPaintText(Node: PVirtualNode; const Canvas: TCanvas; 
Column: TColumnIndex; TextType: TVSTTextType); override; 
    procedure Loaded; override; 
public 
    constructor Create(AOwner: TComponent); override; 

    procedure Log(Value: String; LogLevel: TLogLevel = llInfo; 
TimeStamp: TDateTime = 0); 
    procedure LogFmt(Value: String; const Args: array of Const; 
LogLevel: TLogLevel = llInfo; TimeStamp: TDateTime = 0); 
    procedure SaveToFileWithDialog; 
    procedure SaveToFile(const Filename: String); 
    procedure SaveToStrings(const Strings: TStrings); 
    procedure CopyToClipboard; reintroduce; 
published 
    property OnLog: TOnLog read FOnLog write FOnLog; 
    property OnAfterLog: TNotifyEvent read FOnAfterLog write FOnAfterLog; 

    property HTMLSupport: Boolean read FHTMLSupport write FHTMLSupport; 
    property AutoScroll: Boolean read FAutoScroll write FAutoScroll; 
    property RemoveControlCharacters: Boolean read 
FRemoveControlCharacters write FRemoveControlCharacters; 
    property LogLevels: TLogLevels read FLogLevels write SetLogLevels; 
    property AutoLogLevelColours: Boolean read FAutoLogLevelColours 
write FAutoLogLevelColours; 
    property ShowDateColumn: Boolean read FShowDateColumn write 
SetShowDateColumn; 
    property ShowImages: Boolean read FShowImages write SetShowImages; 
    property MaximumLines: Integer read FMaximumLines write FMaximumLines; 
end; 

implementation 

uses 
Dialogs, 
Clipbrd; 

resourcestring 
StrSaveLog = '&Save'; 
StrCopyToClipboard = '&Copy'; 
StrTextFilesTxt = 'Text files (*.txt)|*.txt|All files (*.*)|*.*'; 
StrSave = 'Save'; 
StrDate = 'Date'; 
StrLog = 'Log'; 

constructor TVirtualLogTree.Create(AOwner: TComponent); 
begin 
inherited; 

FAutoScroll := TRUE; 
FHTMLSupport := TRUE; 
FRemoveControlCharacters := TRUE; 
FShowDateColumn := TRUE; 
FShowImages := TRUE; 
FLogLevels := [llError, llInfo, llWarning, llDebug]; 

NodeDataSize := SizeOf(TLogNodeData); 
end; 

procedure TVirtualLogTree.DoAfterCellPaint(Canvas: TCanvas; Node: PVirtualNode; 
Column: TColumnIndex; CellRect: TRect); 
var 
ColWidth: Integer; 
begin 
inherited; 

if Column = 1 then 
begin 
    if FHTMLSupport then 
    ColWidth := DrawHTML(CellRect, Canvas, GetCellText(Node, 
Column), Selected[Node]) 
    else 
    ColWidth := Canvas.TextWidth(GetCellText(Node, Column)); 

    if not FShowDateColumn then 
    ColWidth := ColWidth + 32; // Width of image 

    if ColWidth > Header.Columns[1].MinWidth then 
    Header.Columns[1].MinWidth := ColWidth; 
end; 
end; 

procedure TVirtualLogTree.DoFreeNode(Node: PVirtualNode); 
var 
NodeData: PLogNodeData; 
begin 
inherited; 

NodeData := GetNodeData(Node); 

if Assigned(NodeData) then 
    NodeData.LogText := ''; 
end; 

function TVirtualLogTree.DoGetImageIndex(Node: PVirtualNode; Kind: TVTImageKind; 
Column: TColumnIndex; var Ghosted: Boolean; 
var Index: Integer): TCustomImageList; 
var 
NodeData: PLogNodeData; 
begin 
Images.Count; 

if ((FShowImages) and (Kind in [ikNormal, ikSelected])) and 
    (((FShowDateColumn) and (Column <= 0)) or 
    ((not FShowDateColumn) and (Column = 1))) then 
begin 
    NodeData := GetNodeData(Node); 

    if Assigned(NodeData) then 
    case NodeData.LogLevel of 
     llError: Index := 3; 
     llInfo: Index := 2; 
     llWarning: Index := 1; 
     llDebug: Index := 0; 
    else 
     Index := 4; 
    end; 
end; 

Result := inherited DoGetImageIndex(Node, Kind, Column, Ghosted, Index); 
end; 

procedure TVirtualLogTree.DoGetText(Node: PVirtualNode; Column: TColumnIndex; 
TextType: TVSTTextType; var Text: String); 
begin 
inherited; 

if (TextType = ttNormal) and ((Column <= 0) or (not FHTMLSupport)) then 
    Text := GetCellText(Node, Column) 
else 
    Text := ''; 
end; 

procedure TVirtualLogTree.DoOnAfterLog; 
begin 
if Assigned(FOnAfterLog) then 
    FOnAfterLog(Self); 
end; 

procedure TVirtualLogTree.DoOnLog(var LogText: String; var 
CancelEntry: Boolean; LogLevel: TLogLevel); 
begin 
if Assigned(FOnLog) then 
    FOnLog(Self, LogText, CancelEntry, LogLevel); 
end; 

procedure TVirtualLogTree.DoPaintText(Node: PVirtualNode; const Canvas: TCanvas; 
Column: TColumnIndex; TextType: TVSTTextType); 
begin 
inherited; 

Canvas.Font.Color := clBlack; 
end; 

function TVirtualLogTree.GetCellText(const Node: PVirtualNode; const 
Column: TColumnIndex): String; 
var 
NodeData: PLogNodeData; 
begin 
NodeData := GetNodeData(Node); 

if Assigned(NodeData) then 
    case Column of 
    -1, 0: Result := concat(DateTimeToStr(NodeData.Timestamp), '.', 
FormatDateTime('zzz', NodeData.Timestamp)); 
    1: Result := NodeData.LogText; 
    end; 
end; 

procedure TVirtualLogTree.AddDefaultColumns(
const ColumnNames: array of String; const ColumnWidths: array of Integer); 
var 
i: Integer; 
Column: TVirtualTreeColumn; 
begin 
Header.Columns.Clear; 

if High(ColumnNames) <> high(ColumnWidths) then 
    raise Exception.Create('Number of column names must match the 
number of column widths.') // Do not localise 
else 
begin 
    for i := low(ColumnNames) to high(ColumnNames) do 
    begin 
    Column := Header.Columns.Add; 

    Column.Text := ColumnNames[i]; 

    if ColumnWidths[i] > 0 then 
     Column.Width := ColumnWidths[i] 
    else 
    begin 
     Header.AutoSizeIndex := Column.Index; 
     Header.Options := Header.Options + [hoAutoResize]; 
    end; 
    end; 
end; 
end; 

procedure TVirtualLogTree.Loaded; 
begin 
inherited; 

TreeOptions.PaintOptions := TreeOptions.PaintOptions - [toShowRoot, 
toShowTreeLines, toShowButtons] + [toUseBlendedSelection, 
toShowHorzGridLines, toHideFocusRect]; 
TreeOptions.SelectionOptions := TreeOptions.SelectionOptions + 
[toFullRowSelect, toRightClickSelect]; 

AddDefaultColumns([StrDate, 
        StrLog], 
        [170, 
        120]); 

Header.AutoSizeIndex := 1; 
Header.Columns[1].MinWidth := 300; 
Header.Options := Header.Options + [hoAutoResize]; 

if (PopupMenu = nil) and (not (csDesigning in ComponentState)) then 
begin 
    PopupMenu := TVirtualLogPopupmenu.Create(Self); 
    TVirtualLogPopupmenu(PopupMenu).OnPopupMenuItemClick := 
OnPopupMenuItemClick; 
end; 

SetShowDateColumn(FShowDateColumn); 
end; 

procedure TVirtualLogTree.OnPopupMenuItemClick(Sender: TObject; 
MenuItem: TMenuItem); 
begin 
if MenuItem.Tag = 1 then 
    SaveToFileWithDialog 
else 
if MenuItem.Tag = 2 then 
    CopyToClipboard; 
end; 

procedure TVirtualLogTree.SaveToFileWithDialog; 
var 
SaveDialog: TSaveDialog; 
begin 
SaveDialog := TSaveDialog.Create(Self); 
try 
    SaveDialog.DefaultExt := '.txt'; 
    SaveDialog.Title := StrSave; 
    SaveDialog.Options := SaveDialog.Options + [ofOverwritePrompt]; 
    SaveDialog.Filter := StrTextFilesTxt; 

    if SaveDialog.Execute then 
    SaveToFile(SaveDialog.Filename); 
finally 
    FreeAndNil(SaveDialog); 
end; 
end; 

procedure TVirtualLogTree.SaveToFile(const Filename: String); 
var 
SaveStrings: TStringList; 
begin 
SaveStrings := TStringList.Create; 
try 
    SaveToStrings(SaveStrings); 

    SaveStrings.SaveToFile(Filename); 
finally 
    FreeAndNil(SaveStrings); 
end; 
end; 

procedure TVirtualLogTree.CopyToClipboard; 
var 
CopyStrings: TStringList; 
begin 
CopyStrings := TStringList.Create; 
try 
    SaveToStrings(CopyStrings); 

    Clipboard.AsText := CopyStrings.Text; 
finally 
    FreeAndNil(CopyStrings); 
end; 
end; 

function TVirtualLogTree.IfThen(Condition: Boolean; TrueResult, 
FalseResult: Variant): Variant; 
begin 
if Condition then 
    Result := TrueResult 
else 
    Result := FalseResult; 
end; 

function TVirtualLogTree.StripHTMLTags(const Value: string): string; 
var 
TagBegin, TagEnd, TagLength: integer; 
begin 
Result := Value; 

TagBegin := Pos('<', Result);  // search position of first < 

while (TagBegin > 0) do 
begin 
    TagEnd := Pos('>', Result); 
    TagLength := TagEnd - TagBegin + 1; 

    Delete(Result, TagBegin, TagLength); 
    TagBegin:= Pos('<', Result); 
end; 
end; 

procedure TVirtualLogTree.SaveToStrings(const Strings: TStrings); 
var 
Node: PVirtualNode; 
begin 
Node := GetFirst; 

while Assigned(Node) do 
begin 
    Strings.Add(concat(IfThen(FShowDateColumn, 
concat(GetCellText(Node, 0), #09), ''), IfThen(FHTMLSupport, 
StripHTMLTags(GetCellText(Node, 1)), GetCellText(Node, 1)))); 

    Node := Node.NextSibling; 
end; 
end; 

function TVirtualLogTree.RemoveCtrlChars(const Value: String): String; 
var 
i: Integer; 
begin 
// Replace CTRL characters with <whitespace> 
Result := ''; 

for i := 1 to length(Value) do 
    if (AnsiChar(Value[i]) in [#0..#31, #127]) then 
    Result := Result + ' ' 
    else 
    Result := Result + Value[i]; 
end; 

procedure TVirtualLogTree.Log(Value: String; LogLevel: TLogLevel; 
TimeStamp: TDateTime); 
var 
CancelEntry: Boolean; 
Node: PVirtualNode; 
NodeData: PLogNodeData; 
DoScroll: Boolean; 
begin 
CancelEntry := FALSE; 

DoOnLog(Value, CancelEntry, LogLevel); 

if not CancelEntry then 
begin 
    DoScroll := ((not Focused) or (GetLast = FocusedNode)) and (FAutoScroll); 

    Node := AddChild(nil); 

    NodeData := GetNodeData(Node); 

    if Assigned(NodeData) then 
    begin 
    NodeData.LogLevel := LogLevel; 

    if TimeStamp = 0 then 
     NodeData.Timestamp := now 
    else 
     NodeData.Timestamp := TimeStamp; 

    if FRemoveControlCharacters then 
     Value := RemoveCtrlChars(Value); 


    if FAutoLogLevelColours then 
     case LogLevel of 
     llError: Value := concat('<font-color=clRed>', Value, 
'</font-color>'); 
     llInfo: Value := concat('<font-color=clBlack>', Value, 
'</font-color>'); 
     llWarning: Value := concat('<font-color=clBlue>', Value, 
'</font-color>'); 
     llDebug: Value := concat('<font-color=clGreen>', Value, 
'</font-color>') 
     end; 

    NodeData.LogText := Value; 

    IsVisible[Node] := NodeData.LogLevel in FLogLevels; 

    DoOnAfterLog; 
    end; 

    if FMaximumLines <> 0 then 
    while RootNodeCount > FMaximumLines do 
     DeleteNode(GetFirst); 

    if DoScroll then 
    begin 
    //SelectNodeEx(GetLast); 

    ScrollIntoView(GetLast, FALSE); 
    end; 
end; 
end; 

procedure TVirtualLogTree.LogFmt(Value: String; const Args: Array of 
Const; LogLevel: TLogLevel; TimeStamp: TDateTime); 
begin 
Log(format(Value, Args), LogLevel, TimeStamp); 
end; 

procedure TVirtualLogTree.SetLogLevels(const Value: TLogLevels); 
begin 
FLogLevels := Value; 

UpdateVisibleItems; 
end; 

procedure TVirtualLogTree.SetShowDateColumn(const Value: Boolean); 
begin 
FShowDateColumn := Value; 

if Header.Columns.Count > 0 then 
begin 
    if FShowDateColumn then 
    Header.Columns[0].Options := Header.Columns[0].Options + [coVisible] 
    else 
    Header.Columns[0].Options := Header.Columns[0].Options - [coVisible] 
end; 
end; 

procedure TVirtualLogTree.SetShowImages(const Value: Boolean); 
begin 
FShowImages := Value; 

Invalidate; 
end; 

procedure TVirtualLogTree.UpdateVisibleItems; 
var 
Node: PVirtualNode; 
NodeData: PLogNodeData; 
begin 
BeginUpdate; 
try 
    Node := GetFirst; 

    while Assigned(Node) do 
    begin 
    NodeData := GetNodeData(Node); 

    if Assigned(NodeData) then 
     IsVisible[Node] := NodeData.LogLevel in FLogLevels; 

    Node := Node.NextSibling; 
    end; 

    Invalidate; 
finally 
    EndUpdate; 
end; 
end; 

function TVirtualLogTree.DrawHTML(const ARect: TRect; const ACanvas: 
TCanvas; const Text: String; Selected: Boolean): Integer; 
(*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>*) 

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'; 
TagColour = 'COLOUR'; 

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

begin 
ACanvas.Font.Size := Canvas.Font.Size; 
ACanvas.Font.Name := Canvas.Font.Name; 

//if Selected and Focused then 
// ACanvas.Font.Color := clWhite 
//else 
ACanvas.Font.Color := Canvas.Font.Color; 
ACanvas.Font.Style := Canvas.Font.Style; 

PreviousFontColour := ACanvas.Font.Color; 
PreviousFontFamily := ACanvas.Font.Name; 
PreviousFontSize := ACanvas.Font.Size; 
PreviousColour := ACanvas.Brush.Color; 

x := ARect.Left; 
y := ARect.Top + 1; 
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 := PreviousFontColour else 

    if Tag = CloseTag(TagColour) then 
     ACanvas.Brush.Color := PreviousColour 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 
      PreviousFontColour := ACanvas.Font.Color; 

      try 
      ACanvas.Font.Color := ColorCodeToColor(TagValue); 
      except 
      //Just in case the canvas colour is invalid 
      end; 
     end else 

     if Tag = TagColour then 
     begin 
      PreviousColour := ACanvas.Brush.Color; 

      try 
      ACanvas.Brush.Color := ColorCodeToColor(TagValue); 
      except 
      //Just in case the canvas colour is invalid 
      end; 
     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 y + MaxCharHeight < ARect.Bottom then 
    begin 
     ACanvas.Brush.Style := bsClear; 

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

    x := x + CharWidth; 
    end; 

    inc(idx); 
end; 

Result := x - ARect.Left; 
end; 

{ TVirtualLogPopupmenu } 

constructor TVirtualLogPopupmenu.Create(AOwner: TComponent); 

function AddMenuItem(const ACaption: String; ATag: Integer): TMenuItem; 
begin 
    Result := TMenuItem.Create(Self); 

    Result.Caption := ACaption; 
    Result.Tag := ATag; 
    Result.OnClick := OnMenuItemClick; 

    Items.Add(Result); 
end; 

begin 
inherited Create(AOwner); 

FOwner := AOwner; 

AddMenuItem(StrSaveLog, 1); 
AddMenuItem('-', -1); 
AddMenuItem(StrCopyToClipboard, 2); 
end; 

procedure TVirtualLogPopupmenu.OnMenuItemClick(Sender: TObject); 
begin 
if Assigned(FOnPopupMenuItemClick) then 
    FOnPopupMenuItemClick(Self, TMenuItem(Sender)); 
end; 

end. 

Jeśli dodać żadnych dodatkowych funkcji, może można umieszczać je tutaj.

Answer 2

Zawsze lubię używać VirtualTreeView przez Mike Lischke za takie zadanie. Jest bardzo elastyczny i dość złożony, ale kiedy już zrozumiesz, jak to działa, możesz prawie wykonać dowolną listę lub zadanie wizualizacji drzewa.

Zrobiłem już coś podobnego, ale nie zawierałem go w komponencie w tym czasie.