Componente per visualizzare le informazioni del registro in Delphi

Question

Ho un numero di attività di elaborazione complesse che produrrà messaggi, avvisi ed errori irreversibili. Voglio essere in grado di visualizzare questi messaggi in un componente indipendente dall'attività. I miei requisiti sono:

• diversi tipi di messaggi vengono visualizzati in carattere diverso e/o colori di sfondo.

• Il display può essere filtrato per includere o escludere ogni tipo di messaggio.

• Il display gestirà correttamente i messaggi lunghi avvolgendoli e visualizzando l'intero messaggio.

• Ogni messaggio può avere un riferimento di dati di qualche tipo collegato e il messaggio può essere selezionato come entità (ad esempio, la scrittura in un memo RTF non funzionerà).

In sostanza, sto cercando qualche tipo di casella di riepilogo come componente che supporta i colori, il filtraggio, e la linea di confezionamento. Qualcuno può suggerire un componente del genere (o un altro) da utilizzare come base per la visualizzazione del mio registro?

In caso contrario, scriverò il mio. Il mio pensiero iniziale è che dovrei basare il componente su un TDBGrid con un TClientDataset integrato. Aggiungerei messaggi al set di dati del cliente (con una colonna per il tipo di messaggio) e gestisco il filtraggio attraverso i metodi di set di dati e coloriamo attraverso i metodi di disegno della griglia.

I vostri pensieri su questo disegno sono i benvenuti.

[Nota: In questo momento non sono particolarmente interessato a scrivere il registro in un file o integrazione con la registrazione di Windows (a meno che ciò risolve il problema di visualizzazione)]

Answer 1

Ho scritto un componente di registro che esegue la maggior parte di ciò che è necessario ed è basato su VitrualTreeView. Ho dovuto modificare un po 'il codice per rimuovere alcune dipendenze, ma compila bene (anche se non è stato testato dopo le modifiche). Anche se non è esattamente quello di cui hai bisogno, potrebbe darti una buona base per iniziare.

Ecco il codice

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. 

Se si aggiungono eventuali funzioni aggiuntive, forse si potrebbe pubblicarle qui.

Answer 2

mi piace sempre di utilizzare il VirtualTreeView da Mike Lischke per un tale compito. È altamente flessibile e abbastanza complesso, ma quando hai capito come funziona puoi quasi realizzare qualsiasi attività di visualizzazione ad albero o ad albero.

Ho già fatto qualcosa di simile, ma non l'ho incapsulato in un componente in quel momento.