1 {
2     This file is part of the Free Component Library.
3     Copyright (c) 2016 Michael Van Canneyt, member of the Free Pascal development team
4 
5     FPReport LCL Preview form.
6 
7     See the file COPYING.FPC, included in this distribution,
8     for details about the copyright.
9 
10     This program is distributed in the hope that it will be useful,
11     but WITHOUT ANY WARRANTY; without even the implied warranty of
12     MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
13 
14  **********************************************************************}
15 unit fpreportpreview;
16 
17 {$mode objfpc}{$H+}
18 
19 interface
20 
21 uses
22   Classes, SysUtils,
23   FileUtil, LazUTF8,
24   Forms, Controls, Graphics, Dialogs, ExtCtrls,
25   ComCtrls, ActnList, Buttons, StdCtrls, Menus,
26   fpreport, fpreportlclexport, fpreportformexport;
27 
28 type
29 
30   { TFPReportPreviewForm }
31   // Fool the IDE.
32   TForm = TCustomFPreportPreviewForm;
33   TOpenURLEvent = Procedure (Sender : TObject; Const AURL : String) of Object;
34 
35   TFPReportPreviewForm = class(TForm)
36     AClose: TAction;
37     ALast: TAction;
38     AFirst: TAction;
39     APrint: TAction;
40     AExportPDF: TAction;
41     AZoomReset: TAction;
42     AZoomOut: TAction;
43     AZoomIn: TAction;
44     ANext: TAction;
45     APrevious: TAction;
46     AExport: TAction;
47     ALPreview: TActionList;
48     EPage: TEdit;
49     ILPreview: TImageList;
50     LPageCount: TLabel;
51     PBPreview: TPaintBox;
52     PButtons: TPanel;
53     PBottom: TPanel;
54     PMExport: TPopupMenu;
55     SBPrevious: TSpeedButton;
56     SBPrevious1: TSpeedButton;
57     ScrollBox1: TScrollBox;
58     SpeedButton1: TSpeedButton;
59     SpeedButton2: TSpeedButton;
60     TBPreview: TToolBar;
61     TBClose: TToolButton;
62     TBExport: TToolButton;
63     TBPDF: TToolButton;
64     TBPrint: TToolButton;
65     TBFirst: TToolButton;
66     TBLast: TToolButton;
67     ToolButton3: TToolButton;
68     TBPrevious: TToolButton;
69     TBNext: TToolButton;
70     ToolButton6: TToolButton;
71     TBZoomIn: TToolButton;
72     TBZoomReset: TToolButton;
73     TBZoomOut: TToolButton;
74     procedure ACloseExecute(Sender: TObject);
75     procedure AExportExecute(Sender: TObject);
76     procedure AExportPDFExecute(Sender: TObject);
77     procedure AExportPDFUpdate(Sender: TObject);
78     procedure AFirstExecute(Sender: TObject);
79     procedure AFirstUpdate(Sender: TObject);
80     procedure ALastExecute(Sender: TObject);
81     procedure ALastUpdate(Sender: TObject);
82     procedure ANextExecute(Sender: TObject);
83     procedure ANextUpdate(Sender: TObject);
84     procedure APreviousExecute(Sender: TObject);
85     procedure APreviousUpdate(Sender: TObject);
86     procedure APrintExecute(Sender: TObject);
87     procedure AZoomInExecute(Sender: TObject);
88     procedure AZoomInUpdate(Sender: TObject);
89     procedure AZoomOutExecute(Sender: TObject);
90     procedure AZoomOutUpdate(Sender: TObject);
91     procedure AZoomResetExecute(Sender: TObject);
92     procedure EPageEditingDone(Sender: TObject);
93     procedure FormCreate(Sender: TObject);
94     procedure FormDestroy(Sender: TObject);
95     procedure PBPreviewClick(Sender: TObject);
96     procedure PBPreviewMouseLeave(Sender: TObject);
97     procedure PBPreviewMouseMove(Sender: TObject; Shift: TShiftState; X,
98       Y: Integer);
99   private
100     FHorzOffset : Integer;
101     FBitmap:TBitmap;
102     FLastPage : Integer;
103     FCurrentZoom : Integer;
104     FOnOpenURL: TOpenURLEvent;
105     FRender:TFPReportExportCanvas;
106     procedure DoExport(Sender: TObject);
107     procedure ExportReport(REC: TFPReportExporterClass);
108     procedure FillExportMenu;
GetPageIndexnull109     function GetPageIndex: Integer;
110     procedure RecreateBitmap;
111     procedure ResizePreview;
112     procedure SetCurrentZoom(AValue: Integer);
113     procedure SetPageIndex(AValue: Integer);
114   Protected
GetEnableHyperLinksnull115     function GetEnableHyperLinks: Boolean ; override;
116     procedure SetEnableHyperLinks(AValue: Boolean); override;
117     procedure SetReport(AValue: TFPCustomReport); override;
118     procedure ShowHyperLink(const AURL: String); virtual;
119       { private declarations }
120   public
121     procedure DoPaintReport(Sender: TObject);
LoadFromResourcenull122     Class Function LoadFromResource : Boolean; override;
123     { public declarations }
124     Property CurrentZoom : Integer Read FCurrentZoom Write SetCurrentZoom;
125     // Zero based  !
126     Property PageIndex : Integer Read GetPageIndex Write SetPageIndex;
127     // If not set, the OpenURL method of LCL will be called.
128     Property OnOpenURL : TOpenURLEvent Read FOnOpenURL Write FOnOpenURL;
129   end;
130 
131 var
132   FPReportPreviewForm: TFPReportPreviewForm;
133 
134 implementation
135 
136 {$R *.lfm}
137 
138 uses dlginputcombo,lclintf;
139 
140 Const
141   MaxZoomIndex = 4;
142   Zooms : Array[-4..4] of Double = (1/4, 1/2, 1/1.5, 1/1.25, 1, 1.25, 1.5, 2, 4);
143   PDFExport = 'PDF';
144   PrintExport = 'Print';
145 
146 Resourcestring
147   SPageCount = 'of %d';
148   SExport = 'Export Report';
149   SSelectExportFormat = 'Select export format';
150   SErrNoHyperLinkSupport = 'Hyperlink support not enabled.';
151 
152 Type
153   TExportMenuItem = Class(TMenuItem)
154   Public
155     TheClass : TFPReportExporterClass;
156   end;
157 
158 { TFPReportPreviewForm }
159 
160 procedure TFPReportPreviewForm.ACloseExecute(Sender: TObject);
161 begin
162   Close;
163 end;
164 
165 procedure TFPReportPreviewForm.AExportExecute(Sender: TObject);
166 
167 Var
168   I : integer;
169   L : TStringList;
170 
171 begin
172   // Do Export
173   L:=TStringListUTF8Fast.Create;
174   try
175     For I:=0 to PMExport.Items.Count-1 do
176       L.AddObject(PMExport.Items[I].Caption,PMExport.Items[I]);
177     if L.Count=0 then
178         exit;
179     L.Sort;
180     I:=InputCombo(SExport,SSelectExportFormat,L);
181     If I<>-1 then
182       ExportReport((L.Objects[i] as TExportMenuItem).TheClass);
183   finally
184     L.Free;
185   end;
186 end;
187 
188 procedure TFPReportPreviewForm.AExportPDFExecute(Sender: TObject);
189 begin
190   ExportReport(ReportExportManager.FindExporter(PDFExport));
191 end;
192 
193 procedure TFPReportPreviewForm.AExportPDFUpdate(Sender: TObject);
194 begin
195   (Sender as TAction).Enabled:=ReportExportManager.FindExporter(PDFExport)<>Nil;
196 end;
197 
198 procedure TFPReportPreviewForm.AFirstExecute(Sender: TObject);
199 begin
200   PageIndex:=0;
201 end;
202 
203 procedure TFPReportPreviewForm.AFirstUpdate(Sender: TObject);
204 begin
205   (Sender as TAction).Enabled:=PageIndex>0;
206 end;
207 
208 procedure TFPReportPreviewForm.ALastExecute(Sender: TObject);
209 begin
210   PageIndex:=ReportPages.Count-1;
211 end;
212 
213 procedure TFPReportPreviewForm.ALastUpdate(Sender: TObject);
214 begin
215   (Sender as TAction).Enabled:=PageIndex<ReportPages.Count-1;
216 end;
217 
218 procedure TFPReportPreviewForm.ANextExecute(Sender: TObject);
219 begin
220   PageIndex:=PageIndex+1;
221 end;
222 
223 procedure TFPReportPreviewForm.ANextUpdate(Sender: TObject);
224 begin
225   (Sender as TAction).Enabled:=PageIndex<ReportPages.Count-1;
226 end;
227 
228 procedure TFPReportPreviewForm.APreviousExecute(Sender: TObject);
229 begin
230   PageIndex:=PageIndex-1;
231 end;
232 
233 procedure TFPReportPreviewForm.APreviousUpdate(Sender: TObject);
234 begin
235   (Sender as TAction).Enabled:=PageIndex>0;
236 end;
237 
238 procedure TFPReportPreviewForm.APrintExecute(Sender: TObject);
239 begin
240   ExportReport(ReportExportManager.FindExporter(PrintExport));
241 end;
242 
243 procedure TFPReportPreviewForm.AZoomInExecute(Sender: TObject);
244 begin
245   if FCurrentZoom<MaxZoomIndex then
246     CurrentZoom:=CurrentZoom+1;
247 end;
248 
249 procedure TFPReportPreviewForm.AZoomInUpdate(Sender: TObject);
250 begin
251   (Sender as Taction).Enabled:=FCurrentZoom<MaxZoomIndex;
252 end;
253 
254 procedure TFPReportPreviewForm.AZoomOutExecute(Sender: TObject);
255 begin
256   if FCurrentZoom>-MaxZoomIndex then
257     CurrentZoom:=CurrentZoom-1;
258 end;
259 
260 procedure TFPReportPreviewForm.AZoomOutUpdate(Sender: TObject);
261 begin
262   (Sender as Taction).Enabled:=FCurrentZoom>-MaxZoomIndex;
263 end;
264 
265 procedure TFPReportPreviewForm.AZoomResetExecute(Sender: TObject);
266 begin
267   CurrentZoom:=0;
268 end;
269 
270 procedure TFPReportPreviewForm.EPageEditingDone(Sender: TObject);
271 Var
272   PN : Integer;
273 begin
274   PN:=StrToIntDef(EPage.Text,-1);
275   if (PN<1) or (PN>FRender.PageCount) then exit;
276   FRender.PageIndex:=PN-1;
277   PBPreview.Invalidate;
278 end;
279 
280 
281 procedure TFPReportPreviewForm.SetCurrentZoom(AValue: Integer);
282 begin
283   if FCurrentZoom=AValue then Exit;
284   FCurrentZoom:=AValue;
285   FRender.HDPI:=PixelsPerInch;
286   FRender.VDPI:=PixelsPerInch;
287   FRender.Zoom:=Zooms[FCurrentZoom];
288   ResizePreview;
289   FLastPage:=-1; // Force recreate
290   PBPreview.Invalidate;
291 end;
292 
TFPReportPreviewForm.GetPageIndexnull293 function TFPReportPreviewForm.GetPageIndex: Integer;
294 begin
295   Result:=FRender.PageIndex;
296 end;
297 
298 procedure TFPReportPreviewForm.SetPageIndex(AValue: Integer);
299 begin
300   FRender.PageIndex:=AValue;
301   EPage.Text:=IntToStr(AValue+1);
302   PBPreview.Invalidate;
303 end;
304 
TFPReportPreviewForm.GetEnableHyperLinksnull305 function TFPReportPreviewForm.GetEnableHyperLinks: Boolean;
306 begin
307   Result:=FRender.HyperLinksEnabled;
308 end;
309 
310 procedure TFPReportPreviewForm.SetEnableHyperLinks(AValue: Boolean);
311 begin
312   FRender.HyperLinksEnabled:=AValue;
313 end;
314 
315 procedure TFPReportPreviewForm.SetReport(AValue: TFPCustomReport);
316 begin
317   inherited SetReport(AValue);
318   FRender.Report:=AValue;
319   If Assigned(AValue) then
320     begin
321     FRender.Execute;
322     LPageCount.Caption:=Format(SPageCount,[FRender.PageCount]);
323     EPage.Text:='1';
324     PageIndex:=0;
325     end;
326 end;
327 
328 procedure TFPReportPreviewForm.ResizePreview;
329 
330 Var
331   W,H : Integer;
332 
333 begin
334   FRender.GetCurrentPageRenderSize(W,H);
335   PBPreview.Width:=W+FHorzOffset*2;
336   PBPreview.Height:=H;
337 end;
338 
339 procedure TFPReportPreviewForm.RecreateBitmap;
340 
341 Var
342   W,H : Integer;
343 
344 begin
345   FRender.GetCurrentPageRenderSize(W,H);
346   FBitmap.SetSize(W,H);
347   FRender.RenderCurrentPage;
348   FLastPage:=FRender.PageIndex;
349 end;
350 
351 procedure TFPReportPreviewForm.DoPaintReport(Sender: TObject);
352 
353 
354 begin
355   if FLastPage<>FRender.PageIndex then
356     RecreateBitmap;
357   ResizePreview;
358   PBPreview.Canvas.Draw(FHorzOffset*2,0,FBitmap);
359 end;
360 
TFPReportPreviewForm.LoadFromResourcenull361 class function TFPReportPreviewForm.LoadFromResource: Boolean;
362 begin
363   Result:=True;
364 end;
365 
366 procedure TFPReportPreviewForm.FormCreate(Sender: TObject);
367 
368 begin
369   FHorzOffset:=100;
370   FRender:=TFPReportExportCanvas.Create(Self);
371   FRender.HyperLinksEnabled:=True;
372   FBitmap:=TBitmap.Create;
373   FLastPage:=-1;
374   FRender.Zoom:=1;
375   FRender.Canvas:=FBitmap.Canvas;
376   PBPreview.OnPaint:=@DoPaintReport;
377   AExportPDF.Enabled:=ReportExportManager.IndexOfExporter(PDFExport)<>-1;
378   APrint.Enabled:=ReportExportManager.IndexOfExporter(PrintExport)<>-1;
379   CurrentZoom:=0;
380   FillExportMenu;
381 end;
382 
383 procedure TFPReportPreviewForm.FormDestroy(Sender: TObject);
384 begin
385   FBitmap.Free;
386 end;
387 
388 procedure TFPReportPreviewForm.ShowHyperLink(const AURL: String);
389 
390 begin
391   if Assigned(FOnOpenURL) then
392     FOnOpenURL(Self,AURL)
393   else
394     OpenURL(AURL);
395 end;
396 
397 procedure TFPReportPreviewForm.PBPreviewClick(Sender: TObject);
398 
399 Var
400   P : TPoint;
401   H : THyperLinkItem;
402 
403 begin
404   P:=PBPreview.ScreenToClient(Mouse.CursorPos);
405   if Not Assigned(FRender.HyperLinks) then
406     Raise EReportExportError.Create(SErrNoHyperlinkSupport);
407   H:=FRender.HyperLinks.FindLinkAtPoint(P);
408   if Assigned(H) then
409     ShowHyperLink(H.URL);
410 end;
411 
412 procedure TFPReportPreviewForm.PBPreviewMouseLeave(Sender: TObject);
413 begin
414   if Screen.Cursor=crHandPoint then
415     Screen.Cursor:=crDefault;
416 end;
417 
418 procedure TFPReportPreviewForm.PBPreviewMouseMove(Sender: TObject;
419   Shift: TShiftState; X, Y: Integer);
420 
421 Var
422   H : THyperLinkItem;
423 
424 begin
425   if Assigned(FRender.HyperLinks) then
426     begin
427     H:=FRender.HyperLinks.FindLinkAtPoint(Point(X,Y));
428     If Assigned(h) then
429       Screen.Cursor:=crHandPoint
430     else
431       Screen.Cursor:=crDefault;
432     end;
433 end;
434 
435 
436 procedure TFPReportPreviewForm.ExportReport(REC : TFPReportExporterClass);
437 
438 Var
439   E : TFPReportExporter;
440 
441 begin
442   E:=Rec.Create(Self);
443   try
444     E.Report:=Self.Report;
445     if E.ShowConfig then
446       E.Execute;
447   finally
448     E.Free;
449   end;
450 end;
451 
452 procedure TFPReportPreviewForm.DoExport(Sender : TObject);
453 
454 Var
455   REC : TFPReportExporterClass;
456 
457 begin
458   REC:=(Sender As TExportMenuItem).TheClass;
459   ExportReport(REC);
460 end;
461 
462 procedure TFPReportPreviewForm.FillExportMenu;
463 
464 Var
465   REC : TFPReportExporterClass;
466   I: Integer;
467   MI : TExportMenuItem;
468 
469 begin
470   PMExport.Items.Clear;
471   For I:=0 to ReportExportManager.ExporterCount-1 do
472     begin
473     REC:=ReportExportManager.Exporter[i];
474     if REc<>TFPreportPreviewExport then
475       begin
476       MI:=TExportMenuItem.Create(Self);
477       MI.TheClass:=Rec;
478       MI.Caption:=Rec.Description;
479       MI.Hint:=Rec.Description;
480       MI.OnClick:=@DoExport;
481       PMExport.Items.Add(MI);
482       end;
483     end;
484 end;
485 
486 initialization
487   TFPreportPreviewExport.DefaultPreviewFormClass:=TFPReportPreviewForm;
488 end.
489 
490