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