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 GetActivenull84function 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.ProcessSetupnull95function TlrPreviewToolsAbstract.ProcessSetup: boolean; 96 begin 97 Result:=true; 98 DoSetupEvent(Result); 99 end; 100 TlrPreviewToolsAbstract.ProcessToolnull101function 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