1089 lines
29 KiB
ObjectPascal
1089 lines
29 KiB
ObjectPascal
unit X2Log.Observer.MonitorForm;
|
|
|
|
interface
|
|
uses
|
|
System.Classes,
|
|
System.Generics.Collections,
|
|
System.Types,
|
|
Vcl.ActnList,
|
|
Vcl.ComCtrls,
|
|
Vcl.Controls,
|
|
Vcl.Dialogs,
|
|
Vcl.ExtCtrls,
|
|
Vcl.Forms,
|
|
Vcl.Grids,
|
|
Vcl.ImgList,
|
|
Vcl.Menus,
|
|
Vcl.StdCtrls,
|
|
Vcl.ToolWin,
|
|
Vcl.ValEdit,
|
|
VirtualTrees,
|
|
Winapi.Messages,
|
|
|
|
X2Log.Details.Intf,
|
|
X2Log.Intf;
|
|
|
|
|
|
const
|
|
CM_REENABLE = WM_APP + 1;
|
|
|
|
|
|
var
|
|
DefaultMaxEntries: Cardinal = 1000;
|
|
|
|
|
|
type
|
|
TX2LogObserverMonitorForm = class;
|
|
TMonitorFormDictionary = TObjectDictionary<IX2LogObservable,TX2LogObserverMonitorForm>;
|
|
|
|
TCopyHandler = procedure of object;
|
|
|
|
|
|
TX2LogObserverMonitorForm = class(TForm, IX2LogObserver)
|
|
vstLog: TVirtualStringTree;
|
|
ilsLog: TImageList;
|
|
splDetails: TSplitter;
|
|
hcDetails: THeaderControl;
|
|
pnlDetails: TPanel;
|
|
reDetails: TRichEdit;
|
|
pnlLog: TPanel;
|
|
tbLog: TToolBar;
|
|
tbDetails: TToolBar;
|
|
pnlBorder: TPanel;
|
|
tbClear: TToolButton;
|
|
tbSaveDetails: TToolButton;
|
|
sbStatus: TStatusBar;
|
|
tbCopyDetails: TToolButton;
|
|
alLog: TActionList;
|
|
actClear: TAction;
|
|
actCopyDetails: TAction;
|
|
actSaveDetails: TAction;
|
|
actPause: TAction;
|
|
tbPause: TToolButton;
|
|
sdDetails: TSaveDialog;
|
|
tbShowVerbose: TToolButton;
|
|
tbShowInfo: TToolButton;
|
|
tbShowWarning: TToolButton;
|
|
tbShowError: TToolButton;
|
|
actShowVerbose: TAction;
|
|
actShowInfo: TAction;
|
|
actShowWarning: TAction;
|
|
actShowError: TAction;
|
|
lblFilter: TLabel;
|
|
sbDetailsImage: TScrollBox;
|
|
imgDetailsImage: TImage;
|
|
tbWordWrap: TToolButton;
|
|
tbDetailsSep1: TToolButton;
|
|
actWordWrap: TAction;
|
|
mmMain: TMainMenu;
|
|
mmMainFile: TMenuItem;
|
|
mmMainLog: TMenuItem;
|
|
mmMainDetails: TMenuItem;
|
|
mmMainWindow: TMenuItem;
|
|
actClose: TAction;
|
|
mmMainFileClose: TMenuItem;
|
|
mmMainLogClear: TMenuItem;
|
|
mmMainLogPause: TMenuItem;
|
|
mmMainLogSep1: TMenuItem;
|
|
mmMainLogVerbose: TMenuItem;
|
|
mmMainLogInfo: TMenuItem;
|
|
mmMainLogWarning: TMenuItem;
|
|
mmMainLogError: TMenuItem;
|
|
mmMainDetailsCopy: TMenuItem;
|
|
mmMainDetailsSave: TMenuItem;
|
|
mmMainDetailsWordWrap: TMenuItem;
|
|
mmMainDetailsSep1: TMenuItem;
|
|
actAlwaysOnTop: TAction;
|
|
mmMainWindowAlwaysOnTop: TMenuItem;
|
|
actSaveAs: TAction;
|
|
mmMainFileSep1: TMenuItem;
|
|
mmMainFileSaveAs: TMenuItem;
|
|
sdSaveAs: TSaveDialog;
|
|
vleDetailsDictionary: TValueListEditor;
|
|
mmoMessage: TMemo;
|
|
hcMessage: THeaderControl;
|
|
|
|
procedure FormShow(Sender: TObject);
|
|
procedure FormClose(Sender: TObject; var Action: TCloseAction);
|
|
procedure vstLogFreeNode(Sender: TBaseVirtualTree; Node: PVirtualNode);
|
|
procedure vstLogGetText(Sender: TBaseVirtualTree; Node: PVirtualNode; Column: TColumnIndex; TextType: TVSTTextType; var CellText: string);
|
|
procedure vstLogGetImageIndex(Sender: TBaseVirtualTree; Node: PVirtualNode; Kind: TVTImageKind; Column: TColumnIndex; var Ghosted: Boolean; var ImageIndex: Integer);
|
|
procedure vstLogFocusChanged(Sender: TBaseVirtualTree; Node: PVirtualNode; Column: TColumnIndex);
|
|
procedure vleDetailsDictionaryKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);
|
|
procedure actCloseExecute(Sender: TObject);
|
|
procedure actClearExecute(Sender: TObject);
|
|
procedure actCopyDetailsExecute(Sender: TObject);
|
|
procedure actSaveDetailsExecute(Sender: TObject);
|
|
procedure actPauseExecute(Sender: TObject);
|
|
procedure ToolbarCustomDraw(Sender: TToolBar; const ARect: TRect; var DefaultDraw: Boolean);
|
|
procedure actShowVerboseExecute(Sender: TObject);
|
|
procedure actShowInfoExecute(Sender: TObject);
|
|
procedure actShowWarningExecute(Sender: TObject);
|
|
procedure actShowErrorExecute(Sender: TObject);
|
|
procedure actWordWrapExecute(Sender: TObject);
|
|
procedure actAlwaysOnTopExecute(Sender: TObject);
|
|
procedure actSaveAsExecute(Sender: TObject);
|
|
private class var
|
|
FInstances: TMonitorFormDictionary;
|
|
private
|
|
FFreeOnClose: Boolean;
|
|
FClosed: Boolean;
|
|
FLockCount: Integer;
|
|
FLogObservable: IX2LogObservable;
|
|
FLogAttached: Boolean;
|
|
FPausedLogCount: Integer;
|
|
FDetails: IX2LogDetails;
|
|
FVisibleLevels: TX2LogLevels;
|
|
FMaxEntries: Cardinal;
|
|
FWordWrap: Boolean;
|
|
FCopyHandler: TCopyHandler;
|
|
protected
|
|
class function GetInstance(ALog: IX2LogObservable; out AForm: TX2LogObserverMonitorForm): Boolean;
|
|
class procedure RemoveInstance(AForm: TX2LogObserverMonitorForm);
|
|
class procedure CleanupInstances;
|
|
|
|
procedure CreateParams(var Params: TCreateParams); override;
|
|
|
|
procedure WMEnable(var Msg: TWMEnable); message WM_ENABLE;
|
|
procedure CMReenable(var Msg: TMessage); message CM_REENABLE;
|
|
|
|
procedure AttachLog;
|
|
procedure DetachLog;
|
|
|
|
procedure UpdateUI;
|
|
procedure UpdateStatus;
|
|
procedure UpdateFilter;
|
|
|
|
function GetPaused: Boolean;
|
|
procedure ToggleVisibleLevel(AAction: TObject; ALevel: TX2LogLevel);
|
|
|
|
procedure SetDetails(ADetails: IX2LogDetails);
|
|
procedure SetBinaryDetails(ADetails: IX2LogDetailsBinary);
|
|
procedure SetGraphicDetails(ADetails: IX2LogDetailsGraphic);
|
|
procedure SetDictionaryDetails(ADetails: IX2LogDetailsDictionary);
|
|
procedure CopyDictionaryDetails;
|
|
|
|
procedure SetVisibleDetails(AControl: TControl);
|
|
procedure SetWordWrap(AValue: Boolean);
|
|
|
|
procedure ExportLog(ALog: IX2LogBase);
|
|
|
|
property Closed: Boolean read FClosed;
|
|
property Details: IX2LogDetails read FDetails;
|
|
property LockCount: Integer read FLockCount;
|
|
property LogObservable: IX2LogObservable read FLogObservable;
|
|
property LogAttached: Boolean read FLogAttached;
|
|
property Paused: Boolean read GetPaused;
|
|
property PausedLogCount: Integer read FPausedLogCount write FPausedLogCount;
|
|
property VisibleLevels: TX2LogLevels read FVisibleLevels write FVisibleLevels;
|
|
public
|
|
class function Instance(ALog: IX2LogObservable): TX2LogObserverMonitorForm;
|
|
|
|
{ Locked instances will always receive log messages, but will not be visible until
|
|
ShowInstance is called and will hide instead of closing until UnlockInstance is called. }
|
|
class procedure LockInstance(ALog: IX2LogObservable);
|
|
class procedure UnlockInstance(ALog: IX2LogObservable);
|
|
|
|
class procedure ShowInstance(ALog: IX2LogObservable);
|
|
class procedure CloseInstance(ALog: IX2LogObservable);
|
|
|
|
constructor Create(AOwner: TComponent; ALogObservable: IX2LogObservable = nil); reintroduce;
|
|
destructor Destroy; override;
|
|
|
|
procedure Lock;
|
|
procedure Unlock;
|
|
|
|
{ IX2LogObserver }
|
|
procedure Log(ALevel: TX2LogLevel; const AMessage, ACategory: string; ADetails: IX2LogDetails); overload;
|
|
procedure Log(ALevel: TX2LogLevel; ADateTime: TDateTime; const AMessage, ACategory: string; ADetails: IX2LogDetails); overload;
|
|
|
|
property FreeOnClose: Boolean read FFreeOnClose write FFreeOnClose;
|
|
property MaxEntries: Cardinal read FMaxEntries write FMaxEntries;
|
|
end;
|
|
|
|
|
|
implementation
|
|
uses
|
|
System.DateUtils,
|
|
System.Math,
|
|
System.SysUtils,
|
|
Vcl.Clipbrd,
|
|
Vcl.Themes,
|
|
Winapi.Windows,
|
|
|
|
X2Log.Constants,
|
|
X2Log.Observer.LogFile;
|
|
|
|
|
|
{$R *.dfm}
|
|
|
|
|
|
type
|
|
TLogEntryNodeData = record
|
|
Time: TDateTime;
|
|
Paused: Boolean;
|
|
Level: TX2LogLevel;
|
|
Category: string;
|
|
Message: string;
|
|
Details: IX2LogDetails;
|
|
|
|
procedure Initialize(APaused: Boolean; ALevel: TX2LogLevel; ADateTime: TDateTime; const AMessage, ACategory: string; ADetails: IX2LogDetails);
|
|
end;
|
|
|
|
PLogEntryNodeData = ^TLogEntryNodeData;
|
|
|
|
|
|
const
|
|
ColumnLevel = 0;
|
|
ColumnTime = 1;
|
|
ColumnCategory = 2;
|
|
ColumnMessage = 3;
|
|
|
|
LevelImageIndex: array[TX2LogLevel] of TImageIndex = (0, 1, 2, 3);
|
|
|
|
|
|
{ TLogEntryNode }
|
|
procedure TLogEntryNodeData.Initialize(APaused: Boolean; ALevel: TX2LogLevel; ADateTime: TDateTime; const AMessage, ACategory: string; ADetails: IX2LogDetails);
|
|
begin
|
|
Self.Time := ADateTime;
|
|
Self.Paused := APaused;
|
|
Self.Level := ALevel;
|
|
Self.Category := ACategory;
|
|
Self.Message := AMessage;
|
|
Self.Details := ADetails;
|
|
end;
|
|
|
|
|
|
{ TX2LogObserverMonitorForm }
|
|
class function TX2LogObserverMonitorForm.Instance(ALog: IX2LogObservable): TX2LogObserverMonitorForm;
|
|
var
|
|
log: IX2LogObservable;
|
|
|
|
begin
|
|
{ Explicit cast ensures we're getting the same pointer every time if, for example,
|
|
the implementing interface is a descendant of IX2Log }
|
|
log := (ALog as IX2LogObservable);
|
|
|
|
if not Assigned(FInstances) then
|
|
FInstances := TMonitorFormDictionary.Create([doOwnsValues]);
|
|
|
|
if not FInstances.TryGetValue(log, Result) then
|
|
begin
|
|
Result := TX2LogObserverMonitorForm.Create(nil, log);
|
|
Result.FreeOnClose := True;
|
|
|
|
FInstances.Add(log, Result);
|
|
end;
|
|
end;
|
|
|
|
|
|
class procedure TX2LogObserverMonitorForm.LockInstance(ALog: IX2LogObservable);
|
|
begin
|
|
Instance(ALog).Lock;
|
|
end;
|
|
|
|
|
|
class procedure TX2LogObserverMonitorForm.UnlockInstance(ALog: IX2LogObservable);
|
|
begin
|
|
Instance(ALog).Unlock;
|
|
end;
|
|
|
|
|
|
class procedure TX2LogObserverMonitorForm.ShowInstance(ALog: IX2LogObservable);
|
|
begin
|
|
Instance(ALog).Show;
|
|
end;
|
|
|
|
|
|
class procedure TX2LogObserverMonitorForm.CloseInstance(ALog: IX2LogObservable);
|
|
var
|
|
monitorForm: TX2LogObserverMonitorForm;
|
|
|
|
begin
|
|
if GetInstance(ALog, monitorForm) then
|
|
monitorForm.Close;
|
|
end;
|
|
|
|
|
|
class function TX2LogObserverMonitorForm.GetInstance(ALog: IX2LogObservable; out AForm: TX2LogObserverMonitorForm): Boolean;
|
|
begin
|
|
Result := False;
|
|
|
|
if Assigned(FInstances) then
|
|
Result := FInstances.TryGetValue(ALog as IX2Log, AForm);
|
|
end;
|
|
|
|
|
|
class procedure TX2LogObserverMonitorForm.RemoveInstance(AForm: TX2LogObserverMonitorForm);
|
|
var
|
|
log: IX2LogObservable;
|
|
|
|
begin
|
|
if Assigned(FInstances) then
|
|
begin
|
|
for log in FInstances.Keys do
|
|
begin
|
|
if FInstances[log] = AForm then
|
|
begin
|
|
FInstances.ExtractPair(log);
|
|
break;
|
|
end;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
|
|
class procedure TX2LogObserverMonitorForm.CleanupInstances;
|
|
begin
|
|
if Assigned(FInstances) then
|
|
FreeAndNil(FInstances);
|
|
end;
|
|
|
|
|
|
constructor TX2LogObserverMonitorForm.Create(AOwner: TComponent; ALogObservable: IX2LogObservable);
|
|
var
|
|
captionFormat: string;
|
|
|
|
begin
|
|
inherited Create(AOwner);
|
|
|
|
FClosed := True;
|
|
FLogObservable := ALogObservable;
|
|
FMaxEntries := DefaultMaxEntries;
|
|
|
|
captionFormat := GetLogResourceString(@LogMonitorFormCaption);
|
|
if Pos('%s', captionFormat) > 0 then
|
|
Caption := Format(captionFormat, [Application.Title])
|
|
else
|
|
Caption := captionFormat;
|
|
|
|
vstLog.NodeDataSize := SizeOf(TLogEntryNodeData);
|
|
vstLog.Header.Columns[ColumnTime].Text := GetLogResourceString(@LogMonitorFormColumnTime);
|
|
vstLog.Header.Columns[ColumnCategory].Text := GetLogResourceString(@LogMonitorFormColumnCategory);
|
|
vstLog.Header.Columns[ColumnMessage].Text := GetLogResourceString(@LogMonitorFormColumnMessage);
|
|
|
|
hcMessage.Sections[0].Text := GetLogResourceString(@LogMonitorFormMessageHeader);
|
|
hcDetails.Sections[0].Text := GetLogResourceString(@LogMonitorFormDetailHeader);
|
|
vleDetailsDictionary.TitleCaptions[0] := GetLogResourceString(@LogMonitorFormKeyHeader);
|
|
vleDetailsDictionary.TitleCaptions[1] := GetLogResourceString(@LogMonitorFormValueHeader);
|
|
|
|
mmMainFile.Caption := GetLogResourceString(@LogMonitorFormMenuFile);
|
|
mmMainLog.Caption := GetLogResourceString(@LogMonitorFormMenuLog);
|
|
mmMainDetails.Caption := GetLogResourceString(@LogMonitorFormMenuDetails);
|
|
mmMainWindow.Caption := GetLogResourceString(@LogMonitorFormMenuWindow);
|
|
|
|
actSaveAs.Caption := GetLogResourceString(@LogMonitorFormMenuFileSaveAs);
|
|
actClose.Caption := GetLogResourceString(@LogMonitorFormMenuFileClose);
|
|
actClear.Caption := GetLogResourceString(@LogMonitorFormButtonClear);
|
|
actPause.Caption := GetLogResourceString(@LogMonitorFormButtonPause);
|
|
actCopyDetails.Caption := GetLogResourceString(@LogMonitorFormButtonCopyDetails);
|
|
actSaveDetails.Caption := GetLogResourceString(@LogMonitorFormButtonSaveDetails);
|
|
actAlwaysOnTop.Caption := GetLogResourceString(@LogMonitorFormMenuWindowAlwaysOnTop);
|
|
|
|
sdDetails.Filter := GetLogResourceString(@LogMonitorFormSaveDetailsFilter);
|
|
sdSaveAs.Filter := GetLogResourceString(@LogMonitorFormSaveDetailsSaveAs);
|
|
|
|
lblFilter.Caption := ' ' + GetLogResourceString(@LogMonitorFormButtonFilter) + ' ';
|
|
actShowVerbose.Caption := GetLogLevelText(TX2LogLevel.Verbose);
|
|
actShowInfo.Caption := GetLogLevelText(TX2LogLevel.Info);
|
|
actShowWarning.Caption := GetLogLevelText(TX2LogLevel.Warning);
|
|
actShowError.Caption := GetLogLevelText(TX2LogLevel.Error);
|
|
|
|
FVisibleLevels := [Low(TX2LogLevel)..High(TX2LogLevel)];
|
|
SetVisibleDetails(nil);
|
|
UpdateUI;
|
|
end;
|
|
|
|
|
|
procedure TX2LogObserverMonitorForm.CreateParams(var Params: TCreateParams);
|
|
begin
|
|
inherited CreateParams(Params);
|
|
|
|
Params.WndParent := 0;
|
|
end;
|
|
|
|
|
|
procedure TX2LogObserverMonitorForm.AttachLog;
|
|
begin
|
|
if Assigned(FLogObservable) and (not FLogAttached) then
|
|
begin
|
|
FLogObservable.Attach(Self);
|
|
FLogAttached := True;
|
|
end;
|
|
end;
|
|
|
|
|
|
procedure TX2LogObserverMonitorForm.DetachLog;
|
|
begin
|
|
if Assigned(FLogObservable) and FLogAttached then
|
|
begin
|
|
FLogObservable.Detach(Self);
|
|
FLogAttached := False;
|
|
end;
|
|
end;
|
|
|
|
|
|
procedure TX2LogObserverMonitorForm.Lock;
|
|
begin
|
|
Inc(FLockCount);
|
|
AttachLog;
|
|
end;
|
|
|
|
|
|
procedure TX2LogObserverMonitorForm.Unlock;
|
|
begin
|
|
if FLockCount > 0 then
|
|
begin
|
|
Dec(FLockCount);
|
|
|
|
{ Lock may have prevented a proper close, try again }
|
|
if Closed then
|
|
Close;
|
|
end;
|
|
end;
|
|
|
|
|
|
destructor TX2LogObserverMonitorForm.Destroy;
|
|
begin
|
|
DetachLog;
|
|
RemoveInstance(Self);
|
|
|
|
inherited Destroy;
|
|
end;
|
|
|
|
|
|
procedure TX2LogObserverMonitorForm.FormShow(Sender: TObject);
|
|
begin
|
|
FClosed := False;
|
|
AttachLog;
|
|
end;
|
|
|
|
|
|
procedure TX2LogObserverMonitorForm.FormClose(Sender: TObject; var Action: TCloseAction);
|
|
begin
|
|
if LockCount = 0 then
|
|
begin
|
|
DetachLog;
|
|
|
|
if FreeOnClose then
|
|
Action := caFree
|
|
else
|
|
Action := caHide;
|
|
end else
|
|
begin
|
|
Action := caHide;
|
|
FClosed := True;
|
|
end;
|
|
end;
|
|
|
|
|
|
procedure TX2LogObserverMonitorForm.Log(ALevel: TX2LogLevel; const AMessage, ACategory: string; ADetails: IX2LogDetails);
|
|
begin
|
|
Log(ALevel, Now, AMessage, ACategory, ADetails);
|
|
end;
|
|
|
|
|
|
procedure TX2LogObserverMonitorForm.Log(ALevel: TX2LogLevel; ADateTime: TDateTime; const AMessage, ACategory: string; ADetails: IX2LogDetails);
|
|
var
|
|
node: PVirtualNode;
|
|
nodeData: PLogEntryNodeData;
|
|
|
|
begin
|
|
{ Ensure thread safety; TThread.Queue will run the procedure immediately
|
|
if Log is called from the main thread, or queue it asynchronously }
|
|
TThread.Queue(nil,
|
|
procedure
|
|
var
|
|
scroll: Boolean;
|
|
|
|
begin
|
|
scroll := (not Paused) and (vstLog.RootNodeCount > 0) and (vstLog.BottomNode = vstLog.GetLast);
|
|
|
|
vstLog.BeginUpdate;
|
|
try
|
|
node := vstLog.AddChild(nil);
|
|
nodeData := vstLog.GetNodeData(node);
|
|
|
|
{ BeginUpdate causes OnInitNode to be triggered on-demand,
|
|
moved Initialize call here }
|
|
Initialize(nodeData^);
|
|
nodeData^.Initialize(Paused, ALevel, ADateTime, AMessage, ACategory, ADetails);
|
|
|
|
vstLog.IsVisible[node] := (not Paused) and (ALevel in VisibleLevels);
|
|
|
|
|
|
if not paused then
|
|
begin
|
|
while vstLog.RootNodeCount > MaxEntries do
|
|
vstLog.DeleteNode(vstLog.GetFirst);
|
|
end;
|
|
finally
|
|
vstLog.EndUpdate;
|
|
end;
|
|
|
|
|
|
|
|
if scroll then
|
|
vstLog.ScrollIntoView(node, False);
|
|
|
|
UpdateUI;
|
|
|
|
if Paused then
|
|
begin
|
|
PausedLogCount := PausedLogCount + 1;
|
|
UpdateStatus;
|
|
end;
|
|
end);
|
|
end;
|
|
|
|
|
|
procedure TX2LogObserverMonitorForm.WMEnable(var Msg: TWMEnable);
|
|
begin
|
|
if not Msg.Enabled then
|
|
{ Modal forms disable all other forms, ensure we're still accessible }
|
|
PostMessage(Self.Handle, CM_REENABLE, 0, 0);
|
|
end;
|
|
|
|
|
|
procedure TX2LogObserverMonitorForm.CMReenable(var Msg: TMessage);
|
|
begin
|
|
EnableWindow(Self.Handle, True);
|
|
end;
|
|
|
|
|
|
procedure TX2LogObserverMonitorForm.UpdateUI;
|
|
begin
|
|
actClear.Enabled := (vstLog.RootNodeCount > 0);
|
|
actSaveAs.Enabled := (vstLog.RootNodeCount > 0);
|
|
end;
|
|
|
|
|
|
procedure TX2LogObserverMonitorForm.UpdateStatus;
|
|
begin
|
|
if Paused then
|
|
sbStatus.SimpleText := ' ' + Format(GetLogResourceString(@LogMonitorFormStatusPaused), [PausedLogCount])
|
|
else
|
|
sbStatus.SimpleText := '';
|
|
end;
|
|
|
|
|
|
procedure TX2LogObserverMonitorForm.UpdateFilter;
|
|
var
|
|
node: PVirtualNode;
|
|
nodeData: PLogEntryNodeData;
|
|
|
|
begin
|
|
vstLog.BeginUpdate;
|
|
try
|
|
for node in vstLog.Nodes do
|
|
begin
|
|
nodeData := vstLog.GetNodeData(node);
|
|
vstLog.IsVisible[node] := (not nodeData^.Paused) and (nodeData^.Level in VisibleLevels);
|
|
end;
|
|
finally
|
|
vstLog.EndUpdate;
|
|
end;
|
|
end;
|
|
|
|
|
|
function TX2LogObserverMonitorForm.GetPaused: Boolean;
|
|
begin
|
|
Result := actPause.Checked;
|
|
end;
|
|
|
|
|
|
procedure TX2LogObserverMonitorForm.ToggleVisibleLevel(AAction: TObject; ALevel: TX2LogLevel);
|
|
begin
|
|
if ALevel in VisibleLevels then
|
|
Exclude(FVisibleLevels, ALevel)
|
|
else
|
|
Include(FVisibleLevels, ALevel);
|
|
|
|
(AAction as TCustomAction).Checked := (ALevel in VisibleLevels);
|
|
UpdateFilter;
|
|
end;
|
|
|
|
|
|
procedure TX2LogObserverMonitorForm.SetDetails(ADetails: IX2LogDetails);
|
|
var
|
|
logDetailsGraphic: IX2LogDetailsGraphic;
|
|
logDetailsBinary: IX2LogDetailsBinary;
|
|
logDetailsDictionary: IX2LogDetailsDictionary;
|
|
logDetailsText: IX2LogDetailsText;
|
|
canWrap: Boolean;
|
|
|
|
begin
|
|
FDetails := ADetails;
|
|
canWrap := False;
|
|
FCopyHandler := nil;
|
|
|
|
if Assigned(Details) then
|
|
begin
|
|
if Supports(ADetails, IX2LogDetailsGraphic, logDetailsGraphic) then
|
|
SetGraphicDetails(logDetailsGraphic)
|
|
|
|
else if Supports(ADetails, IX2LogDetailsBinary, logDetailsBinary) then
|
|
SetBinaryDetails(logDetailsBinary)
|
|
|
|
else if Supports(ADetails, IX2LogDetailsDictionary, logDetailsDictionary) then
|
|
SetDictionaryDetails(logDetailsDictionary)
|
|
|
|
else if Supports(ADetails, IX2LogDetailsText, logDetailsText) then
|
|
begin
|
|
canWrap := True;
|
|
SetVisibleDetails(reDetails);
|
|
|
|
// Must be set after Visible = True, because the Text will get lost
|
|
// as soon as the handle is allocated.
|
|
reDetails.Text := logDetailsText.AsString;
|
|
end;
|
|
end else
|
|
SetVisibleDetails(nil);
|
|
|
|
|
|
actCopyDetails.Enabled := Assigned(FCopyHandler) or Supports(ADetails, IX2LogDetailsCopyable);
|
|
actSaveDetails.Enabled := Supports(ADetails, IX2LogDetailsStreamable);
|
|
actWordWrap.Enabled := canWrap;
|
|
actWordWrap.Checked := canWrap and FWordWrap;
|
|
|
|
SetWordWrap(actWordWrap.Checked);
|
|
end;
|
|
|
|
|
|
procedure TX2LogObserverMonitorForm.SetBinaryDetails(ADetails: IX2LogDetailsBinary);
|
|
const
|
|
BufferSize = 4096;
|
|
|
|
BytesPerLine = 16;
|
|
HexSplitPos = 7;
|
|
HexSplitSpacing = 1;
|
|
|
|
HexDigits = 2;
|
|
TextDigits = 1;
|
|
HexSpacing = 0;
|
|
HexTextSpacing = 2;
|
|
|
|
ReadableCharacters = [32..126, 161..255];
|
|
UnreadableCharacter = '.';
|
|
|
|
|
|
procedure ResetLine(var ALine: string);
|
|
var
|
|
linePos: Integer;
|
|
|
|
begin
|
|
for linePos := 1 to Length(ALine) do
|
|
ALine[linePos] := ' ';
|
|
end;
|
|
|
|
|
|
var
|
|
stream: TStream;
|
|
buffer: array[0..Pred(BufferSize)] of Byte;
|
|
readBytes: Integer;
|
|
linePosition: Integer;
|
|
line: string;
|
|
bufferIndex: Integer;
|
|
hexValue: string;
|
|
hexPos: Integer;
|
|
textPos: Integer;
|
|
|
|
begin
|
|
stream := ADetails.AsStream;
|
|
linePosition := 0;
|
|
|
|
SetLength(line, (BytesPerLine * (HexDigits + HexSpacing + TextDigits)) + HexTextSpacing +
|
|
IfThen(HexSplitPos < BytesPerLine, HexSplitSpacing, 0));
|
|
ResetLine(line);
|
|
|
|
reDetails.Lines.BeginUpdate;
|
|
try
|
|
reDetails.Lines.Clear;
|
|
|
|
while True do
|
|
begin
|
|
readBytes := stream.Read(buffer, SizeOf(buffer));
|
|
if readBytes = 0 then
|
|
break;
|
|
|
|
for bufferIndex := 0 to Pred(readBytes) do
|
|
begin
|
|
hexValue := IntToHex(buffer[bufferIndex], HexDigits);
|
|
|
|
if linePosition >= BytesPerLine then
|
|
begin
|
|
reDetails.Lines.Add(line);
|
|
|
|
ResetLine(line);
|
|
linePosition := 0;
|
|
end;
|
|
|
|
hexPos := (linePosition * (HexDigits + HexSpacing));
|
|
if linePosition > HexSplitPos then
|
|
Inc(hexPos, HexSplitSpacing);
|
|
|
|
line[hexPos + 1] := hexValue[1];
|
|
line[hexPos + 2] := hexValue[2];
|
|
|
|
textPos := (BytesPerLine * (HexDigits + HexSpacing)) + HexTextSpacing + (linePosition * TextDigits);
|
|
if HexSplitPos < BytesPerLine then
|
|
Inc(textPos, HexSplitSpacing);
|
|
|
|
if buffer[bufferIndex] in ReadableCharacters then
|
|
line[textPos] := Chr(buffer[bufferIndex])
|
|
else
|
|
line[textPos] := UnreadableCharacter;
|
|
|
|
Inc(linePosition);
|
|
end;
|
|
end;
|
|
|
|
if linePosition > 0 then
|
|
reDetails.Lines.Add(line);
|
|
finally
|
|
reDetails.Lines.EndUpdate;
|
|
|
|
SetVisibleDetails(reDetails);
|
|
end;
|
|
end;
|
|
|
|
|
|
procedure TX2LogObserverMonitorForm.SetGraphicDetails(ADetails: IX2LogDetailsGraphic);
|
|
begin
|
|
imgDetailsImage.Picture.Assign(ADetails.AsGraphic);
|
|
SetVisibleDetails(sbDetailsImage);
|
|
end;
|
|
|
|
|
|
procedure TX2LogObserverMonitorForm.SetDictionaryDetails(ADetails: IX2LogDetailsDictionary);
|
|
var
|
|
key: string;
|
|
|
|
begin
|
|
vleDetailsDictionary.Strings.Clear;
|
|
|
|
for key in ADetails.Keys do
|
|
vleDetailsDictionary.Values[key] := ADetails.DisplayValue[key];
|
|
|
|
FCopyHandler := CopyDictionaryDetails;
|
|
SetVisibleDetails(vleDetailsDictionary);
|
|
end;
|
|
|
|
|
|
procedure TX2LogObserverMonitorForm.CopyDictionaryDetails;
|
|
var
|
|
y: Integer;
|
|
x: Integer;
|
|
selectedText: TStringBuilder;
|
|
|
|
begin
|
|
selectedText := TStringBuilder.Create;
|
|
try
|
|
for y := vleDetailsDictionary.Selection.Top to vleDetailsDictionary.Selection.Bottom do
|
|
begin
|
|
for x := vleDetailsDictionary.Selection.Left to vleDetailsDictionary.Selection.Right do
|
|
selectedText.Append(vleDetailsDictionary.Cells[x, y]);
|
|
end;
|
|
|
|
Clipboard.AsText := selectedText.ToString;
|
|
finally
|
|
FreeAndNil(selectedText);
|
|
end;
|
|
end;
|
|
|
|
|
|
procedure TX2LogObserverMonitorForm.SetVisibleDetails(AControl: TControl);
|
|
begin
|
|
if Assigned(AControl) then
|
|
begin
|
|
AControl.BringToFront;
|
|
AControl.Visible := True;
|
|
end;
|
|
|
|
reDetails.Visible := (AControl = reDetails);
|
|
sbDetailsImage.Visible := (AControl = sbDetailsImage);
|
|
vleDetailsDictionary.Visible := (AControl = vleDetailsDictionary);
|
|
|
|
if not reDetails.Visible then
|
|
reDetails.Clear;
|
|
|
|
if not sbDetailsImage.Visible then
|
|
imgDetailsImage.Picture.Assign(nil);
|
|
|
|
if not vleDetailsDictionary.Visible then
|
|
vleDetailsDictionary.Strings.Clear;
|
|
end;
|
|
|
|
|
|
procedure TX2LogObserverMonitorForm.SetWordWrap(AValue: Boolean);
|
|
begin
|
|
reDetails.WordWrap := AValue;
|
|
|
|
if AValue then
|
|
reDetails.ScrollBars := ssVertical
|
|
else
|
|
reDetails.ScrollBars := ssBoth;
|
|
end;
|
|
|
|
|
|
procedure TX2LogObserverMonitorForm.ExportLog(ALog: IX2LogBase);
|
|
var
|
|
node: PVirtualNode;
|
|
nodeData: PLogEntryNodeData;
|
|
|
|
begin
|
|
for node in vstLog.Nodes do
|
|
begin
|
|
nodeData := vstLog.GetNodeData(node);
|
|
ALog.Log(nodeData^.Level, nodeData^.Time, nodeData^.Message, nodeData^.Category, nodeData^.Details);
|
|
end;
|
|
end;
|
|
|
|
|
|
procedure TX2LogObserverMonitorForm.vstLogFreeNode(Sender: TBaseVirtualTree; Node: PVirtualNode);
|
|
var
|
|
nodeData: PLogEntryNodeData;
|
|
|
|
begin
|
|
nodeData := Sender.GetNodeData(Node);
|
|
Finalize(nodeData^);
|
|
end;
|
|
|
|
|
|
procedure TX2LogObserverMonitorForm.vstLogGetText(Sender: TBaseVirtualTree; Node: PVirtualNode; Column: TColumnIndex;
|
|
TextType: TVSTTextType; var CellText: string);
|
|
var
|
|
nodeData: PLogEntryNodeData;
|
|
|
|
begin
|
|
CellText := '';
|
|
nodeData := Sender.GetNodeData(Node);
|
|
|
|
case Column of
|
|
ColumnTime:
|
|
CellText := DateTimeToStr(nodeData^.Time);
|
|
|
|
ColumnCategory:
|
|
CellText := nodeData^.Category;
|
|
|
|
ColumnMessage:
|
|
CellText := nodeData^.Message;
|
|
end;
|
|
end;
|
|
|
|
|
|
procedure TX2LogObserverMonitorForm.vstLogGetImageIndex(Sender: TBaseVirtualTree; Node: PVirtualNode; Kind: TVTImageKind;
|
|
Column: TColumnIndex; var Ghosted: Boolean; var ImageIndex: Integer);
|
|
var
|
|
nodeData: PLogEntryNodeData;
|
|
|
|
begin
|
|
if Kind in [ikNormal, ikSelected] then
|
|
begin
|
|
nodeData := Sender.GetNodeData(Node);
|
|
|
|
case Column of
|
|
ColumnLevel:
|
|
ImageIndex := LevelImageIndex[nodeData^.Level];
|
|
|
|
ColumnMessage:
|
|
if Assigned(nodeData^.Details) then
|
|
ImageIndex := 4;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
|
|
procedure TX2LogObserverMonitorForm.vstLogFocusChanged(Sender: TBaseVirtualTree; Node: PVirtualNode; Column: TColumnIndex);
|
|
var
|
|
nodeData: PLogEntryNodeData;
|
|
|
|
begin
|
|
if Assigned(Node) then
|
|
begin
|
|
nodeData := Sender.GetNodeData(Node);
|
|
|
|
mmoMessage.Text := nodeData^.Message;
|
|
SetDetails(nodeData^.Details);
|
|
end else
|
|
begin
|
|
mmoMessage.Clear;
|
|
SetDetails(nil);
|
|
end;
|
|
|
|
UpdateUI;
|
|
end;
|
|
|
|
|
|
procedure TX2LogObserverMonitorForm.vleDetailsDictionaryKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);
|
|
begin
|
|
if (Shift = [ssCtrl]) and (Key = Ord('C')) then
|
|
begin
|
|
CopyDictionaryDetails;
|
|
Key := 0;
|
|
end;
|
|
end;
|
|
|
|
|
|
procedure TX2LogObserverMonitorForm.actCloseExecute(Sender: TObject);
|
|
begin
|
|
Close;
|
|
end;
|
|
|
|
|
|
procedure TX2LogObserverMonitorForm.actClearExecute(Sender: TObject);
|
|
begin
|
|
vstLog.Clear;
|
|
SetDetails(nil);
|
|
|
|
UpdateUI;
|
|
end;
|
|
|
|
|
|
procedure TX2LogObserverMonitorForm.actCopyDetailsExecute(Sender: TObject);
|
|
var
|
|
logDetailsCopyable: IX2LogDetailsCopyable;
|
|
|
|
begin
|
|
if Assigned(FCopyHandler) then
|
|
FCopyHandler
|
|
|
|
else if Supports(Details, IX2LogDetailsCopyable, logDetailsCopyable) then
|
|
logDetailsCopyable.CopyToClipboard;
|
|
end;
|
|
|
|
|
|
procedure TX2LogObserverMonitorForm.actSaveDetailsExecute(Sender: TObject);
|
|
var
|
|
logDetailsStreamable: IX2LogDetailsStreamable;
|
|
outputStream: TFileStream;
|
|
|
|
begin
|
|
if Supports(Details, IX2LogDetailsStreamable, logDetailsStreamable) then
|
|
begin
|
|
if sdDetails.Execute then
|
|
begin
|
|
outputStream := TFileStream.Create(sdDetails.FileName, fmCreate or fmShareDenyWrite);
|
|
try
|
|
logDetailsStreamable.SaveToStream(outputStream);
|
|
finally
|
|
FreeAndNil(outputStream);
|
|
end;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
|
|
procedure TX2LogObserverMonitorForm.actWordWrapExecute(Sender: TObject);
|
|
begin
|
|
FWordWrap := actWordWrap.Checked;
|
|
SetWordWrap(FWordWrap);
|
|
end;
|
|
|
|
|
|
procedure TX2LogObserverMonitorForm.actPauseExecute(Sender: TObject);
|
|
var
|
|
node: PVirtualNode;
|
|
nodeData: PLogEntryNodeData;
|
|
|
|
begin
|
|
if not Paused then
|
|
begin
|
|
{ Clear Paused status from nodes }
|
|
vstLog.BeginUpdate;
|
|
try
|
|
for node in vstLog.Nodes do
|
|
begin
|
|
nodeData := vstLog.GetNodeData(node);
|
|
|
|
if nodeData^.Paused then
|
|
begin
|
|
nodeData^.Paused := False;
|
|
vstLog.IsVisible[node] := (nodeData^.Level in VisibleLevels);
|
|
end;
|
|
end;
|
|
finally
|
|
vstLog.EndUpdate;
|
|
end;
|
|
end;
|
|
|
|
PausedLogCount := 0;
|
|
UpdateStatus;
|
|
end;
|
|
|
|
|
|
procedure TX2LogObserverMonitorForm.actShowVerboseExecute(Sender: TObject);
|
|
begin
|
|
ToggleVisibleLevel(Sender, TX2LogLevel.Verbose);
|
|
end;
|
|
|
|
|
|
procedure TX2LogObserverMonitorForm.actShowInfoExecute(Sender: TObject);
|
|
begin
|
|
ToggleVisibleLevel(Sender, TX2LogLevel.Info);
|
|
end;
|
|
|
|
|
|
procedure TX2LogObserverMonitorForm.actShowWarningExecute(Sender: TObject);
|
|
begin
|
|
ToggleVisibleLevel(Sender, TX2LogLevel.Warning);
|
|
end;
|
|
|
|
|
|
procedure TX2LogObserverMonitorForm.actShowErrorExecute(Sender: TObject);
|
|
begin
|
|
ToggleVisibleLevel(Sender, TX2LogLevel.Error);
|
|
end;
|
|
|
|
|
|
procedure TX2LogObserverMonitorForm.actAlwaysOnTopExecute(Sender: TObject);
|
|
begin
|
|
actAlwaysOnTop.Checked := not actAlwaysOnTop.Checked;
|
|
|
|
if actAlwaysOnTop.Checked then
|
|
SetWindowPos(Self.Handle, HWND_TOPMOST, 0, 0, 0, 0, SWP_NOSIZE or SWP_NOMOVE or SWP_NOACTIVATE)
|
|
else
|
|
SetWindowPos(Self.Handle, HWND_NOTOPMOST, 0, 0, 0, 0, SWP_NOSIZE or SWP_NOMOVE or SWP_NOACTIVATE);
|
|
end;
|
|
|
|
|
|
procedure TX2LogObserverMonitorForm.actSaveAsExecute(Sender: TObject);
|
|
var
|
|
logFile: IX2LogBase;
|
|
|
|
begin
|
|
if sdSaveAs.Execute then
|
|
begin
|
|
{ Default behaviour of the LogFile observer is to append }
|
|
System.SysUtils.DeleteFile(sdSaveAs.FileName);
|
|
|
|
logFile := TX2LogFileObserver.Create(sdSaveAs.FileName, X2LogLevelsAll);
|
|
ExportLog(logFile);
|
|
end;
|
|
end;
|
|
|
|
|
|
procedure TX2LogObserverMonitorForm.ToolbarCustomDraw(Sender: TToolBar; const ARect: TRect; var DefaultDraw: Boolean);
|
|
var
|
|
element: TThemedElementDetails;
|
|
rect: TRect;
|
|
|
|
begin
|
|
if StyleServices.Enabled then
|
|
begin
|
|
rect := Sender.ClientRect;
|
|
if Assigned(Self.Menu) then
|
|
Dec(rect.Top, GetSystemMetrics(SM_CYMENU));
|
|
|
|
element := StyleServices.GetElementDetails(trRebarRoot);
|
|
StyleServices.DrawElement(Sender.Canvas.Handle, element, rect);
|
|
end;
|
|
end;
|
|
|
|
|
|
initialization
|
|
finalization
|
|
TX2LogObserverMonitorForm.CleanupInstances;
|
|
|
|
end.
|