1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
|
{*****************************************}
{ }
{ LazReport }
{ LazReport export filter }
{ }
{ Copyright (c) 2014 by Lagunov A.A. }
{ }
{*****************************************}
unit lr_PreviewToolsAbstract;
{$mode objfpc}{$H+}
interface
uses
Classes, SysUtils, LR_Class;
type
TlrPreviewToolsAbstract = class;
TlrPreviewToolsSetupEvent = procedure(Sender:TlrPreviewToolsAbstract; var StopExec: boolean) of object;
{ TlrPreviewToolsAbstract }
TlrPreviewToolsAbstract = class(TComponent)
private
FOnSetup: TlrPreviewToolsSetupEvent;
function GetActive: boolean;
procedure SetActive(AValue: boolean);
protected
FCaption: string;
FDoc: TfrReport;
procedure DoSetupEvent(var ContinueExec: boolean);
function ProcessSetup:boolean; virtual;
function ProcessTool:boolean; virtual;
public
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
procedure Execute(ADoc:TfrReport);
published
property Active:boolean read GetActive write SetActive;
property Caption: string read FCaption write FCaption;
property OnSetup:TlrPreviewToolsSetupEvent read FOnSetup write FOnSetup;
end;
procedure RegisterLRExportFilter(AFilter:TlrPreviewToolsAbstract);
procedure UnRegisterLRExportFilter(AFilter:TlrPreviewToolsAbstract);
var
lrExportFilters : TList = nil;
implementation
procedure RegisterLRExportFilter(AFilter: TlrPreviewToolsAbstract);
var
i: Integer;
begin
for i:=0 to lrExportFilters.Count - 1 do
if TlrPreviewToolsAbstract(lrExportFilters[i]) = AFilter then
exit;
lrExportFilters.Add(AFilter);
end;
procedure UnRegisterLRExportFilter(AFilter: TlrPreviewToolsAbstract);
var
i: Integer;
begin
i:=lrExportFilters.IndexOf(AFilter);
if i>=0 then
lrExportFilters.Delete(i);
end;
{ TlrPreviewToolsAbstract }
procedure TlrPreviewToolsAbstract.SetActive(AValue: boolean);
begin
if AValue then
RegisterLRExportFilter(Self)
else
UnRegisterLRExportFilter(Self);
end;
function TlrPreviewToolsAbstract.GetActive: boolean;
begin
Result:=lrExportFilters.IndexOf(Self)>-1;
end;
procedure TlrPreviewToolsAbstract.DoSetupEvent(var ContinueExec: boolean);
begin
if Assigned(FOnSetup) then
FOnSetup(Self, ContinueExec);
end;
function TlrPreviewToolsAbstract.ProcessSetup: boolean;
begin
Result:=true;
DoSetupEvent(Result);
end;
function TlrPreviewToolsAbstract.ProcessTool: boolean;
begin
Result:=false;
end;
constructor TlrPreviewToolsAbstract.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
RegisterLRExportFilter(Self);
FCaption:=ClassName;
end;
destructor TlrPreviewToolsAbstract.Destroy;
begin
UnRegisterLRExportFilter(Self);
inherited Destroy;
end;
procedure TlrPreviewToolsAbstract.Execute(ADoc: TfrReport);
begin
FDoc:=ADoc;
try
if ProcessSetup then
ProcessTool;
finally
FDoc:=nil;
end;
end;
procedure DoFreeExportFilters;
begin
FreeAndNil(lrExportFilters);
end;
initialization
lrExportFilters :=TList.Create;
finalization
DoFreeExportFilters;
end.
|
