delphi - Delphi中显示日志信息的组件

Question

我有许多复杂的处理任务，这些任务会产生消息、警告和 fatal error 。我希望能够在独立于任务的组件中显示这些消息。我的要求是:

• 不同类型的消息以不同的字体和/或背景颜色显示。

• 可以过滤显示以包含或排除每种消息。

• 显示屏将通过包装长消息并显示整个消息来正确处理长消息。

• 每条消息都可以附加某种数据引用，并且可以选择该消息作为实体(例如，写入 RTF 备忘录不起作用)。

本质上，我正在寻找某种类似列表框的组件，支持颜色、过滤和换行。谁能建议这样一个组件(或另一个组件)作为我的日志显示的基础？

如果做不到这一点，我会自己写一个。我最初的想法是，我应该将该组件基于带有内置 TClientDataset 的 TDBGrid。我会将消息添加到客户端数据集(带有消息类型列)，并通过数据集方法处理过滤，并通过网格的绘制方法处理着色。

欢迎您对此设计提出想法。

[注意:目前我对将日志写入文件或与 Windows 日志记录集成不是特别感兴趣(除非这样做可以解决我的显示问题)]

Answer 1

我编写了一个日志组件，它可以完成您需要的大部分功能，并且它基于 VitrualTreeView。我不得不稍微更改代码以删除一些依赖项，但它编译得很好(尽管更改后尚未经过测试)。即使它并不完全是您所需要的，它也可能为您提供良好的入门基础。

这是代码

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.

如果您添加任何其他功能，也许您可​​以将它们发布在这里。