我有许多复杂的处理任务,会产生消息,警告和致命错误.我希望能够在与任务无关的组件中显示这些消息.我的要求是:
>不同种类的消息以不同的字体和/或背景颜色显示.
>可以过滤显示以包括或排除每种消息.
>显示器将通过包装它们并显示整个消息来正确处理长消息.
>每条消息都可以附加某种类型的数据引用,并且可以选择消息作为实体(例如,写入RTF备忘录将不起作用).
本质上,我正在寻找某种类似列表框的组件,它支持颜色,过滤和换行.任何人都可以建议使用这样的组件(或其他组件)作为我的日志显示的基础吗?
如果做不到的话,我会写自己的.我最初的想法是,我应该使用内置的TClientDataset将组件基于TDBGrid.我会将消息添加到客户端数据集(带有消息类型的列),并通过数据集方法处理过滤,并通过网格的绘制方法进行着色.
欢迎您对此设计的看法.
解决方法
我编写了一个日志组件,可以完成您所需的大部分工作,它基于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,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)),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,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>','</font-color>');
- llWarning: Value := concat('<font-color=clBlue>','</font-color>');
- llDebug: Value := concat('<font-color=clGreen>','</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,2)),StrToInt('$'+Copy(HexValue,3,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,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,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.