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