1
0
mirror of synced 2024-12-22 01:13:08 +01:00

Added: working implementation of Observer.MonitorForm, lacking details view

Fixed: memory leaks with singletons
This commit is contained in:
Mark van Renswoude 2014-05-20 08:49:57 +00:00
parent 8abfde99cd
commit 041dfc71d6
13 changed files with 660 additions and 6 deletions

BIN
Resources/Details.bmp Normal file

Binary file not shown.

After

Width:  |  Height:  |  Size: 1.3 KiB

BIN
Resources/Error.bmp Normal file

Binary file not shown.

After

Width:  |  Height:  |  Size: 1.3 KiB

BIN
Resources/Info.bmp Normal file

Binary file not shown.

After

Width:  |  Height:  |  Size: 1.3 KiB

BIN
Resources/Verbose.bmp Normal file

Binary file not shown.

After

Width:  |  Height:  |  Size: 1.3 KiB

BIN
Resources/Warning.bmp Normal file

Binary file not shown.

After

Width:  |  Height:  |  Size: 1.3 KiB

View File

@ -1,6 +1,11 @@
program X2LogTest;
uses
madExcept,
madLinkDisAsm,
madListHardware,
madListProcesses,
madListModules,
Forms,
MainFrm in 'source\MainFrm.pas' {MainForm},
X2Log.Intf in '..\X2Log.Intf.pas',
@ -24,6 +29,7 @@ var
begin
Application.Initialize;
Application.MainFormOnTaskbar := True;
Application.Title := 'X²LogTest';
Application.CreateForm(TMainForm, MainForm);
Application.Run;
end.

View File

@ -84,6 +84,8 @@
<DCC_Define>DEBUG;$(DCC_Define)</DCC_Define>
</PropertyGroup>
<PropertyGroup Condition="'$(Cfg_2_Win32)'!=''">
<DCC_Define>madExcept;$(DCC_Define)</DCC_Define>
<DCC_MapFile>3</DCC_MapFile>
<Manifest_File>$(BDS)\bin\default_app.manifest</Manifest_File>
<VerInfo_IncludeVerInfo>true</VerInfo_IncludeVerInfo>
<VerInfo_Locale>1033</VerInfo_Locale>

View File

@ -32,6 +32,10 @@ object MainForm: TMainForm
OnChange = pcObserversChange
object tsEvent: TTabSheet
Caption = 'Event Observer '
ExplicitLeft = 0
ExplicitTop = 0
ExplicitWidth = 0
ExplicitHeight = 0
object mmoEvent: TMemo
AlignWithMargins = True
Left = 8
@ -51,6 +55,10 @@ object MainForm: TMainForm
object tsFile: TTabSheet
Caption = 'File Observer'
ImageIndex = 1
ExplicitLeft = 0
ExplicitTop = 0
ExplicitWidth = 0
ExplicitHeight = 0
end
object tsNamedPipe: TTabSheet
Caption = 'Named Pipe Observer'
@ -78,7 +86,18 @@ object MainForm: TMainForm
Align = alRight
Cancel = True
Caption = 'Close'
TabOrder = 1
end
object btnMonitorForm: TButton
Left = 0
Top = 0
Width = 145
Height = 25
Align = alLeft
Cancel = True
Caption = 'Monitor Form Observer'
TabOrder = 0
OnClick = btnMonitorFormClick
end
end
object GroupBox1: TGroupBox

View File

@ -28,6 +28,7 @@ type
edtException: TEdit;
btnException: TButton;
tsNamedPipe: TTabSheet;
btnMonitorForm: TButton;
procedure FormCreate(Sender: TObject);
procedure FormDestroy(Sender: TObject);
@ -36,6 +37,7 @@ type
procedure edtExceptionKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);
procedure edtMessageKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);
procedure btnExceptionClick(Sender: TObject);
procedure btnMonitorFormClick(Sender: TObject);
private
FLog: IX2Log;
FObserver: IX2LogObserver;
@ -56,6 +58,7 @@ uses
X2Log.Exception.madExcept,
X2Log.Observer.Event,
X2Log.Observer.LogFile,
X2Log.Observer.MonitorForm,
X2Log.Observer.NamedPipe;
@ -65,11 +68,15 @@ uses
{ TMainForm }
procedure TMainForm.FormCreate(Sender: TObject);
begin
{ Testing the localization (Dutch) }
SetLogResourceString(@LogLevelVerbose, 'Uitgebreid');
SetLogResourceString(@LogLevelInfo, 'Informatie');
SetLogResourceString(@LogLevelWarning, 'Waarschuwing');
SetLogResourceString(@LogLevelError, 'Fout');
SetLogResourceString(@LogMonitorFormColumnTime, 'Tijd');
SetLogResourceString(@LogMonitorFormColumnMessage, 'Melding');
FLog := TX2Log.Create;
FLog.SetExceptionStrategy(TX2LogmadExceptExceptionStrategy.Create);
@ -164,4 +171,10 @@ begin
end;
end;
procedure TMainForm.btnMonitorFormClick(Sender: TObject);
begin
TX2LogObserverMonitorForm.ShowInstance(FLog);
end;
end.

View File

@ -26,6 +26,19 @@ resourcestring
LogFileLineDetails = ' (details: %s)';
{
X2Log.Observer.MonitorForm
}
{ Caption of the monitor form. %s is optional and will be replaced
with the application's title }
LogMonitorFormCaption = '%s - Live Log';
{ Caption of the columns in the live log view }
LogMonitorFormColumnTime = 'Time';
LogMonitorFormColumnMessage = 'Message';
function GetLogLevelText(ALogLevel: TX2LogLevel): string;

View File

@ -9,8 +9,10 @@ uses
type
TX2GlobalLog = class(TObject)
private
class var FInstance: IX2Log;
private class var
FInstance: IX2Log;
protected
class procedure CleanupInstance;
public
class function Instance: IX2Log;
@ -46,6 +48,13 @@ begin
end;
class procedure TX2GlobalLog.CleanupInstance;
begin
if Assigned(FInstance) then
FreeAndNil(FInstance);
end;
class procedure TX2GlobalLog.Attach(AObserver: IX2LogObserver);
begin
Instance.Attach(AObserver);
@ -99,4 +108,9 @@ begin
Instance.Exception(AException, AMessage, ADetails);
end;
initialization
finalization
TX2GlobalLog.CleanupInstance;
end.

View File

@ -1,7 +1,7 @@
object X2LogObserverMonitorForm: TX2LogObserverMonitorForm
Left = 0
Top = 0
Caption = 'Log'
Caption = 'Live Log'
ClientHeight = 519
ClientWidth = 658
Color = clBtnFace
@ -11,6 +11,321 @@ object X2LogObserverMonitorForm: TX2LogObserverMonitorForm
Font.Name = 'Tahoma'
Font.Style = []
OldCreateOrder = False
OnClose = FormClose
OnShow = FormShow
PixelsPerInch = 96
TextHeight = 13
object vstLog: TVirtualStringTree
Left = 0
Top = 0
Width = 658
Height = 519
Align = alClient
Header.AutoSizeIndex = 2
Header.Font.Charset = DEFAULT_CHARSET
Header.Font.Color = clWindowText
Header.Font.Height = -11
Header.Font.Name = 'Tahoma'
Header.Font.Style = []
Header.Options = [hoAutoResize, hoColumnResize, hoDrag, hoShowSortGlyphs, hoVisible, hoHeaderClickAutoSort]
Images = ilsLog
TabOrder = 0
TreeOptions.PaintOptions = [toHideFocusRect, toShowButtons, toShowDropmark, toThemeAware]
TreeOptions.SelectionOptions = [toFullRowSelect]
OnFreeNode = vstLogFreeNode
OnGetText = vstLogGetText
OnGetImageIndex = vstLogGetImageIndex
OnInitNode = vstLogInitNode
Columns = <
item
Options = [coAllowClick, coDraggable, coEnabled, coParentBidiMode, coParentColor, coShowDropMark, coVisible, coAllowFocus]
Position = 0
Width = 24
end
item
Position = 1
Width = 150
WideText = 'Time'
end
item
Position = 2
Width = 480
WideText = 'Message'
end>
end
object ilsLog: TImageList
Left = 584
Top = 48
Bitmap = {
494C010105004000480010001000FFFFFFFFFF10FFFFFFFFFFFFFFFF424D3600
0000000000003600000028000000400000002000000001002000000000000020
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
00000000000000000000000000000000000000000000000000009B7C6C009B7C
6C009B7C6C009B7C6C009B7C6C009B7C6C009B7C6C009B7C6C009B7C6C009B7C
6C009B7C6C009B7C6C0000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
00000000000000000000000000000000000000000000000000009B776600FFFF
FF00FAF4E900FAF4E900FAF4E900FAF4E900FAF4E900FAF4E900FAF4E900F9EF
E000F9EFE0009779670000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000A27F6F00FFFF
FF00DDC1B400DDC1B400DDC1B400DDC1B400DDBEAD00DDBEAD00DCBAA500DCBA
A500F9EFE0009779670000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000A3807000FFFF
FF00DBC4BD00DBC4BD00DDC1B400DDC1B400DDBEAD00DDBEAD00DCBAA500DCBA
A500FAF4E9009B7C6C0000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000A9877800FFFF
FF00DBC6C200DBC4BD00DBC4BD00DDC1B400DBBFB400DCBAA500DDBEAD00DDBE
AD00FAF4E9009779670000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000AB897A00FFFF
FF00DBC6C200DBC6C200DBC4BD00DBC4BD00DBBFB400DCBAA500DDBEAD00DCBA
A500FAF4E9009B7C6C0000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000AB897A00FFFF
FF00DBC6C200DBC4BD00DBC4BD00DBC4BD00DDC1B400DBBFB400DCBAA500DDBE
AD00FAF4E9009B7C6C0000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000B1908000FFFF
FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FCF9F500FCF9F500FCF9F500FAF4
E900FAF4E9009B7C6C0000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000AF8F8000FFFF
FF00DFCDCB00DFCDCB00DBC6C200DBC4BD00DBC4BD00DDC1B400DDBEAD00DDBE
AD00FCF9F5009B7C6C0000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000B1908000FFFF
FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FCF9F500FCF9F500FAF4
E900F0E8E0009B7C6C0000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000B1908000FFFF
FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FCF9F500A3807000A380
7000A3807000A380700000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000B8988800FFFF
FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FCF9F500FFFFFF00A3807000F5E2
D900B08E7D00AB9E980000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000B8988800FFFF
FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00A3807000B08E
7D00AB9E98000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000B8988800B898
8800B1908000B1908000B08E7D00B08E7D00AC887700AC887700A3807000AB9E
9800000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000005C8F5C002979270014700D0014700D00277525005C8F5C000000
0000000000000000000000000000000000000000000000000000000000000000
000000000000A6795F00A1552D00A2481400A04615009E543000A47965000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
000000000000000000000000000000000000000000005E63B2001221BA000812
B1000812B1000810AA00080EA600080EA600080EA600080A9D00080EA6000606
9A00080A9D00080A9D006060A400000000000000000000000000000000000000
00000F7D0F00088800000888000013880000217D000032720000266D0000126D
0D00000000000000000000000000000000000000000000000000000000000000
0000AD4F0F00BE580000C55F0000BE580000BE580000B04A0000A94300009D43
14000000000000000000000000000000000000000000749AAC003593B9002F95
BC002693BB002693BB001A92B9001492B9000F92B8000B91B6000B91B6000C8F
B5000C8FB5001B80A800000000000000000000000000192CC6002441E000001E
D700001ED7000526DB000015C9000013C7000013C7000008B7000921C7000004
AD000009AB000004A200080EA600000000000000000000000000000000000585
070004A00800009D010004A00800009D0100009D0100009500001E7E0000396B
000010690200000000000000000000000000000000000000000000000000B752
0200D56D0000D56D0000D2670000EB952800F8B04F00DC750000BE580000A943
0000A03D0600000000000000000000000000000000003D98BD00A6EBF70084E1
F1006CE2F10056E3F10040E9F50019F1FA002AF7F70000FEFE0000FEFE0000FE
FE0000FEFE0000FEFE001083AB0000000000000000001C32CE00264AEE000020
E6000533F200B0C1EF001641F100001ED7000015C9001C40E500D0DEFF002441
E0000008B7000009AB0006069A00000000000000000000000000158816000BA8
170004A0080036C15400DCF3E9007ADD9B00009D010000950000009D01001285
0000396B0000126D0D0000000000000000000000000000000000B65A1000DC75
0000D56D0000D56D0000DA985000F4FEFF00FEFFFF00FFFAE100D56D0000BE58
0000B04A00009D4314000000000000000000000000003593B900A5E7F3007EDB
ED0069DBEC0055DEEE0032E3FD001E374000453C380009FFFF0000FEFE0000FE
FE0000FEFE0000FEFE000C8FB5000000000000000000213AD200294FF7000028
F800C0C7E400F1EDE000D9DFEC000F3BF1000C34EB00E1EAFD00FFFFF900EFF8
FF002441E0000004AD0006069A0000000000000000006097600024A82F0008A9
1B002BB43E00F6F0F500FCF6FA00FFFEFF007ADD9B00009D0100009D01000095
0000217D0000266D00005C8F5C000000000000000000AE795400D97E1B00DC75
0000DC750000DC750000CA844900ECF9FF00F4FEFF00FEEED500D96D0000C862
0000BE580000A9430000A47965000000000000000000709EB30069C3DD0089DE
F00069DBEC005ADCED0044E3F4000B91B600129DB80008F5FC0000F4F90000FE
FE0000FEFE0000E4EE005585A1000000000000000000213AD2002852FF00A0AC
E200EDEADD00E4E4E300F1F0E900D4DCF300CFD9F800FFFFF900FFFFF900FFFF
F900DEEDFF000921C700080EA60000000000000000002C8E2B0039BF4F0024A8
2F00ECE6EA00F5EEF400FCF6FA00FFFEFF00FFFEFF007ADD9B00009F0900009D
01000095000032720000277525000000000000000000B8662400E9912400E27C
0000E27C0000E27C0000D96D0000CA6C1000D6853000D96D0000D56D0000C862
0000C8620000B04A0000A1552D000000000000000000000000002F9BC50094E2
F0007EDBED005ADCED0056E3F10032E6EB0046DCDD0016ECF70006EEF60000F4
F90000FEFE00128AB1000000000000000000000000002945DB003764FF000533
F200D7D7E000ECEBE500EDEDEB00F4F4F100FAF9F600FFFFF900FFFFF900FFFF
F9002E54EC000008B700080A9D0000000000000000001E93220039BF4F00AAC9
A700FAEAF900D1E1D1001EAF3300DAEEDD00FFFEFF00FFFEFF007ADD9B00009D
0100009D0100297C000014700D000000000000000000C4691600ED992A00E881
0000E8810000E8810000F4971600FFD89400FFD58F00FFC76400D96D0000D56D
0000CE680000BE580000A24814000000000000000000000000000000000049B3
D60087DFEF0069DBEC0058E4F6001A888E004074720026F2FE0016ECF70008F5
FC0002C6DA006E9AAA000000000000000000000000002C48DE004473FF00003C
FF000537F800D2D6E800EDEDEB00F4F4F100FFFFF900FFFFF900EAEFFF001D46
EF000014D2000012BF00060CA3000000000000000000219624005DD27C0017A3
25008EBF880011AB24001BB940000BAC2600DAEEDD00FFFEFF00FFFEFF007ADD
9B00009D01001B86000014700D000000000000000000CA6C1000F6A73C00EF88
0000EF880000EF880000EB952800FEFFFF00FEFFFF00FFE7B900DC750000D56D
0000D56D0000C55F0000A248140000000000000000000000000000000000409F
C20087DFEF007EDBED0047E8FF00243A3E003F3635001DFBFF002BE5F20021EE
F600268CAA00000000000000000000000000000000002F4EE3004D81FF00044A
FF00002CF600B0BAE800EDEDEB00F4F4F100F4F4F100FFFFF900D0DEFF00012D
ED00001ED7000013C7000009AB0000000000000000002C922C0077DC95002CC5
59001BB940002CC5590026C04E0022BB45000BAC2600DAEEDD00FFFEFF00FFFE
FF0078DB960013880000267D26000000000000000000BF6B2000FCBA5A00F68F
0000F7900000F68F0000E28D2500F4FEFF00FEFFFF00FFE2B200E1750000D771
0000D56D0000C55F0000A4582B00000000000000000000000000000000000000
000038ABD00094E2F00038D2F600211210003827260020CEDA0040E9F5001EAC
CF0000000000000000000000000000000000000000003253E500568EFF000031
EB00B6B8DC00ECEBE500EDEDEB00F4F4F100F4F4F100FFFFF900FFFFF900E1EA
FD000031EB000013C7000810AA000000000000000000629C620053C66C0061D8
890031CA630031CA63002CC5590026C04E0022BB45000BAC2600DAEEDD00FCF6
FA00CAECD7000E8E08005C905C000000000000000000B57B4E00F8B04F00FDA9
2C00FD960000FD960000DA842300EAF2FB00EFF2F700F5D6A900E1750000DC75
0000D56D0000C55F0000A6795F00000000000000000000000000000000000000
00005AA3C00082D3E80045CFF100110602002B14100023C9E50055DEEE003C92
B7000000000000000000000000000000000000000000385AEA004F77EC009A98
CB00EDEADD00E4E4E300F1F0E900D2D6E800DFE3F400FFFFF900FFFFF900FFFF
F900D0DEFF000526DB000611B2000000000000000000000000001E9A230083E5
A7004CD3790031CA630031CA630027C3530022BB45001CB53A0008A91B007ACC
850011AB24000F7D0F0000000000000000000000000000000000D1761900FFC7
6400FFA21300FF980000CF7A2600DFEEFE00E3EFFB00E4CBAC00E1750000DC75
0000D7710000AE510E0000000000000000000000000000000000000000000000
00000000000031A1C9009DE6F60031B0D30027ADCF0067E5FA0031A1C9000000
00000000000000000000000000000000000000000000385AEA0067A4FF000F35
D200D8D4D800ECEBE500D9D8E4000533F200003CFF00F4F4F100FFFFF900FFFF
F9001944F9000015C9000012BF000000000000000000000000000000000024A4
2D0083E5A7005ED8880031CA630027C3530022BB45001CB53A0016B02E000BAC
2600058A08000000000000000000000000000000000000000000BE916D00DA84
2300FFC76400FFAD2600DC750000CD6E0F00D5760F00DA790B00E27C0000E27C
0000BD5700000000000000000000000000000000000000000000000000000000
00000000000074A9BD006FC7E300A5E7F30094E2F00077D4E7005398B5000000
000000000000000000000000000000000000000000003D60F0006DABFF00116E
FF001136D300BDB9D4000633E300044AFF00003CFF000537F800D4DCF3000C3B
F9000020E600001ED7000611B200000000000000000000000000000000000000
00001E9A230056CA730077E09C005DD27C0043C8660036C154001EAA2F001588
160000000000000000000000000000000000000000000000000000000000BE91
6D00D1761900F8B04F00FFBF4E00FDA92C00F69A1900EF911500DA790B00BA5C
0C00000000000000000000000000000000000000000000000000000000000000
0000000000000000000031A1C900B8E8F200B1E9F600369DC100000000000000
00000000000000000000000000000000000000000000355DF200BAE0FF005CA0
FF00569AFF003A60E4004584FF003F76FF003764FF00295AFF001944F9001944
F9001D46EF001D38DB001326C300000000000000000000000000000000000000
000000000000629C62002C922C00229A28001E9322002C922C00629C62000000
0000000000000000000000000000000000000000000000000000000000000000
000000000000B57B4E00C26F2100CD6E0F00CA6C1000BF6B2000AE7954000000
0000000000000000000000000000000000000000000000000000000000000000
00000000000000000000000000003D98BD00369DC10000000000000000000000
000000000000000000000000000000000000000000006373CE00365DEF004162
EE00385AEA00385AEA00385AEA003253E500304DE2002945DB002945DB002441
E000213AD2001C32CE00656DB900000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
000000000000000000000000000000000000424D3E000000000000003E000000
2800000040000000200000000100010000000000000100000000000000000000
000000000000000000000000FFFFFF00FFFF000000000000C003000000000000
C003000000000000C003000000000000C003000000000000C003000000000000
C003000000000000C003000000000000C003000000000000C003000000000000
C003000000000000C003000000000000C003000000000000C007000000000000
C00F000000000000FFFF000000000000FFFFFFFFFFFFFFFFF81FF81FFFFF8001
F00FF00F80038001E007E00780018001C003C003800180018001800180018001
80018001C003800180018001E003800180018001E007800180018001F00F8001
80018001F00F8001C003C003F81F8001E007C007F81F8001F00FE00FFC3F8001
F81FF81FFE7F8001FFFFFFFFFFFFFFFF00000000000000000000000000000000
000000000000}
end
end

View File

@ -2,8 +2,12 @@ unit X2Log.Observer.MonitorForm;
interface
uses
System.Classes,
System.Generics.Collections,
Vcl.Controls,
Vcl.Forms,
Vcl.ImgList,
VirtualTrees,
Winapi.Messages,
X2Log.Intf;
@ -15,26 +19,185 @@ const
type
TX2LogObserverMonitorForm = class(TForm, IX2LogObserver)
vstLog: TVirtualStringTree;
ilsLog: TImageList;
procedure FormShow(Sender: TObject);
procedure FormClose(Sender: TObject; var Action: TCloseAction);
procedure vstLogInitNode(Sender: TBaseVirtualTree; ParentNode, Node: PVirtualNode; var InitialStates: TVirtualNodeInitStates);
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);
private class var
FInstances: TDictionary<IX2Log,TX2LogObserverMonitorForm>;
private
FFreeOnClose: Boolean;
FLogToAttach: IX2Log;
FLogAttached: Boolean;
protected
class function GetInstance(ALog: IX2Log; 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;
property LogToAttach: IX2Log read FLogToAttach;
property LogAttached: Boolean read FLogAttached;
public
class function Instance(ALog: IX2Log): TX2LogObserverMonitorForm;
class procedure ShowInstance(ALog: IX2Log);
class procedure CloseInstance(ALog: IX2Log);
constructor Create(AOwner: TComponent; ALogToAttach: IX2Log = nil); reintroduce;
destructor Destroy; override;
{ IX2LogObserver }
procedure Log(ALevel: TX2LogLevel; const AMessage: string; const ADetails: string = '');
property FreeOnClose: Boolean read FFreeOnClose write FFreeOnClose;
end;
implementation
uses
Winapi.Windows;
System.DateUtils,
System.SysUtils,
Winapi.Windows,
X2Log.Constants;
{$R *.dfm}
type
TLogEntryNodeData = record
Time: TDateTime;
Level: TX2LogLevel;
Message: string;
Details: string;
procedure Initialize(ALevel: TX2LogLevel; const AMessage, ADetails: string);
end;
PLogEntryNodeData = ^TLogEntryNodeData;
const
ColumnLevel = 0;
ColumnTime = 1;
ColumnMessage = 2;
{ TLogEntryNode }
procedure TLogEntryNodeData.Initialize(ALevel: TX2LogLevel; const AMessage, ADetails: string);
begin
Time := Now;
Level := ALevel;
Message := AMessage;
Details := ADetails;
end;
{ TX2LogObserverMonitorForm }
class function TX2LogObserverMonitorForm.Instance(ALog: IX2Log): TX2LogObserverMonitorForm;
var
log: IX2Log;
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 IX2Log);
if not Assigned(FInstances) then
FInstances := TDictionary<IX2Log,TX2LogObserverMonitorForm>.Create;
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.ShowInstance(ALog: IX2Log);
begin
Instance(ALog).Show;
end;
class procedure TX2LogObserverMonitorForm.CloseInstance(ALog: IX2Log);
var
monitorForm: TX2LogObserverMonitorForm;
begin
if GetInstance(ALog, monitorForm) then
monitorForm.Close;
end;
class function TX2LogObserverMonitorForm.GetInstance(ALog: IX2Log; 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: IX2Log;
begin
if Assigned(FInstances) then
begin
for log in FInstances.Keys do
begin
if FInstances[log] = AForm then
begin
FInstances.Remove(log);
break;
end;
end;
end;
end;
class procedure TX2LogObserverMonitorForm.CleanupInstances;
begin
if Assigned(FInstances) then
FreeAndNil(FInstances);
end;
constructor TX2LogObserverMonitorForm.Create(AOwner: TComponent; ALogToAttach: IX2Log);
var
captionFormat: string;
begin
inherited Create(AOwner);
FLogToAttach := ALogToAttach;
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[ColumnMessage].Text := GetLogResourceString(@LogMonitorFormColumnMessage);
end;
procedure TX2LogObserverMonitorForm.CreateParams(var Params: TCreateParams);
begin
inherited CreateParams(Params);
@ -43,9 +206,51 @@ begin
end;
procedure TX2LogObserverMonitorForm.Log(ALevel: TX2LogLevel; const AMessage, ADetails: string);
destructor TX2LogObserverMonitorForm.Destroy;
begin
//
if Assigned(FLogToAttach) and FLogAttached then
FLogToAttach.Detach(Self);
RemoveInstance(Self);
inherited Destroy;
end;
procedure TX2LogObserverMonitorForm.FormShow(Sender: TObject);
begin
if Assigned(FLogToAttach) and (not FLogAttached) then
begin
FLogToAttach.Attach(Self);
FLogAttached := True;
end;
end;
procedure TX2LogObserverMonitorForm.FormClose(Sender: TObject; var Action: TCloseAction);
begin
if Assigned(FLogToAttach) and FLogAttached then
begin
FLogToAttach.Detach(Self);
FLogAttached := False;
end;
if FreeOnClose then
Action := caFree
else
Action := caHide;
end;
procedure TX2LogObserverMonitorForm.Log(ALevel: TX2LogLevel; const AMessage, ADetails: string);
var
node: PVirtualNode;
nodeData: PLogEntryNodeData;
begin
node := vstLog.AddChild(nil);
nodeData := vstLog.GetNodeData(node);
nodeData^.Initialize(ALevel, AMessage, ADetails);
end;
@ -62,4 +267,71 @@ begin
EnableWindow(Self.Handle, True);
end;
procedure TX2LogObserverMonitorForm.vstLogInitNode(Sender: TBaseVirtualTree; ParentNode, Node: PVirtualNode;
var InitialStates: TVirtualNodeInitStates);
var
nodeData: PLogEntryNodeData;
begin
nodeData := Sender.GetNodeData(Node);
Initialize(nodeData^);
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);
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:
case nodeData^.Level of
TX2LogLevel.Verbose: ImageIndex := 0;
TX2LogLevel.Info: ImageIndex := 1;
TX2LogLevel.Warning: ImageIndex := 2;
TX2LogLevel.Error: ImageIndex := 3;
end;
ColumnMessage:
if Length(nodeData^.Details) > 0 then
ImageIndex := 4;
end;
end;
end;
end.