1 unit UnitReporter;
2
3 {$mode objfpc}{$H+}
4
5 interface
6
7 uses
8 Classes, SysUtils, LazLogger, Graphics, LR_Class, LR_DBSet, LR_BarC, LR_Shape,
9 LR_RRect, LR_ChBox, LR_CrossTab, LR_CodeReport,
10 lr_e_pdf, lr_e_fclpdf, LR_E_TXT, LR_E_CSV, LR_E_HTM, LR_e_img, LR_e_htmldiv,
11 le_e_spreadsheet,
12 dbf, DB;
13
14 const
15 PDF_FILE = 'report.pdf';
16 DATAPATH = 'data' + PathDelim;
17
18 type
19
20 TExportBackend = (ebPowerPDF, ebFCLPDF, ebTxt, ebCSV, ebHtml, ebHtmlDiv,
21 ebBmp, ebJpg, ebPng,
22 ebOpenDoc, ebXLS, ebOOXML);
23
24 { TReporter }
25
26 TReporter=class
27 private
28 fDbf: TDbf;
29 fExportedFile: string;
30 fExportBackend: TExportBackend;
31 fSrc: TDatasource;
32 fReport: TfrReport;
33 flrDataset: TfrDBDataset;
34 flrCode: TlrCodeReport;
35 procedure CheckReport;
36 procedure OnExportFilterSetup(Sender: TfrExportFilter);
37 procedure OnLRCodeReportTest(Sender: TObject);
DoExportReportnull38 function DoExportReport: boolean;
BackendNamenull39 function BackendName: string;
BackendExtnull40 function BackendExt: string;
41 public
42 constructor create;
43 destructor destroy; override;
44 procedure LoadReport(filename: string);
45 procedure PrepareDisksReport;
46 procedure PrepareCrossTabReport;
PrepareLRCodeReportnull47 function PrepareLRCodeReport: boolean;
ProcessExportReportnull48 function ProcessExportReport(reportName:string): boolean;
49
50 property ExportBackend: TExportBackend read fExportBackend write fExportBackend;
51 property ExportedFile:string read fExportedFile;
52 property Report: TfrReport read fReport;
53 end;
54
55 implementation
56
57 { TReporter }
58
59 procedure TReporter.CheckReport;
60 begin
61 if fReport=nil then begin
62 fReport := TfrReport.Create(nil);
63 fReport.OnExportFilterSetup := @OnExportFilterSetup;
64 //flrPDFExport := TfrTNPDFExport.Create(nil);
65 end;
66 end;
67
68 procedure TReporter.OnExportFilterSetup(Sender: TfrExportFilter);
69 begin
70 //if Sender is TfrHtmlDivExportFilter then begin
71 // TfrHtmlDivExportFilter(Sender).EmbeddedImages := false;
72 //end;
73 end;
74
75 procedure TReporter.OnLRCodeReportTest(Sender: TObject);
76 var
77 BoxText: TlrTextRectStyle;
78 n: integer;
79 X: double;
80 Picture: TPicture;
81 begin
82 with Sender as TlrCodeReport do
83 begin
84 // Important. Before drawing, add a page
85 NewPage;
86 // Set paper... 1=Letter 9=A4....
87 //SetPaper(1, poLandscape); // try uncomment this line to test another paper size
88 // Set up a custom style
89 BoxText := GetDefaultTextRectStyle;
90 BoxText.FontName := 'Times';
91 BoxText.FontSize := 12;
92 BoxText.FontStyle := [fsBold, fsItalic];
93 BoxText.FontColor := clBlue;
94 BoxText.FillColor := clYellow;
95 BoxText.Line.LColor := clRed;
96 BoxText.Line.LWidth := 2;
97 BoxText.BorderLines := [frbLeft, frbTop, frbRight, frbBottom];
98 BoxText.Alignment := taRightJustify;
99 //*******************************************************************
100 //SetRatio(1, 1); // working with pixels
101 //NOTE: by default values are in pixels
102 LineStyle.LColor := clBlue;
103 DrawHLine(0, 5, GetPageWidth);
104 DrawVLine(5, 0, GetPageHeight);
105
106 // check values uncomment to try
107 //ShowMessage('Width: ' + FormatFloat('0.00', GetPageWidth) +
108 // 'pixels' + 'Height: ' + FormatFloat('0.00', GetPageHeight) + 'pixels.');
109
110 // working with mm
111 EnableMillimeters; // workign in millimeters
112
113 //// check values uncomment to try
114 //ShowMessage('Width: ' + FormatFloat('0.00', GetPageWidth) +
115 // ' mm.' + 'Height: ' + FormatFloat('0.00', GetPageHeight) + ' mm.');
116
117 // Draw text
118 DrawText(0, 0, GetPageWidth, 10, 'Text example áéóâ € jgÑ€', BoxText);
119 DrawText(0, 15, GetPageWidth, 10, 'Text example áéóâ E jgNE', BoxText);
120 DrawText(0, 30, GetPageWidth, 10, '1234', BoxText);
121 // Testing cursor
122 // Set AutoSize
123 BoxText.Autosize := True;
124 DrawText(0, Cursor.YBottom, GetPageWidth, 6, 'Testing cursors', BoxText);
125 DrawText(0, Cursor.YBottom, GetPageWidth, 6, 'next line', BoxText);
126 DrawText(0, Cursor.YBottom, GetPageWidth, 6, 'another line', BoxText);
127 // Align Left
128 BoxText.Alignment := taLeftJustify;
129 DrawText(0, Cursor.YBottom, GetPageWidth, 6, 'Testing cursors', BoxText);
130 DrawText(0, Cursor.YBottom, GetPageWidth, 6, 'next line', BoxText);
131 DrawText(0, Cursor.YBottom, GetPageWidth, 6, 'another line', BoxText);
132 // center it
133 BoxText.FontName := 'Arial';
134 BoxText.Alignment := taCenter;
135 BoxText.Autosize := False;
136 DrawText(0, Cursor.YBottom, GetPageWidth, 6, 'Testing cursors', BoxText);
137 DrawText(0, Cursor.YBottom, GetPageWidth, 6, 'next line', BoxText);
138 DrawText(0, Cursor.YBottom, GetPageWidth, 6, 'another line', BoxText);
139 // Layout
140 x := Cursor.YBottom + 5;
141 BoxText.FillColor := clSilver;
142 BoxText.Line.LColor := clGreen;
143 BoxText.FontColor := clRed;
144 BoxText.Layout := tlTop;
145 BoxText.Alignment := taLeftJustify;
146 DrawText(20, x, 50, 15, 'TopLeft', BoxText);
147 BoxText.Alignment := taCenter;
148 DrawText(70, x, 50, 15, 'TopCenter', BoxText);
149 BoxText.Alignment := taRightJustify;
150 DrawText(120, x, 50, 15, 'TopRight', BoxText);
151 x := Cursor.YBottom;
152 BoxText.Layout := tlCenter;
153 BoxText.Alignment := taLeftJustify;
154 DrawText(20, x, 50, 15, 'CenterLeft', BoxText);
155 BoxText.Alignment := taCenter;
156 DrawText(70, x, 50, 15, 'CenterCenter', BoxText);
157 BoxText.Alignment := taRightJustify;
158 DrawText(120, x, 50, 15, 'CenterRight', BoxText);
159 x := Cursor.YBottom;
160 BoxText.Layout := tlBottom;
161 BoxText.Alignment := taLeftJustify;
162 DrawText(20, x, 50, 15, 'BottomLeft', BoxText);
163 BoxText.Alignment := taCenter;
164 DrawText(70, x, 50, 15, 'BottomCenter', BoxText);
165 BoxText.Alignment := taRightJustify;
166 DrawText(120, x, 50, 15, 'BottomRight', BoxText);
167 LineStyle.LColor := clMaroon;
168 LineStyle.LWidth := 1;
169 LineStyle.LStyle := frsDashDotDot;
170 DrawHLine(0, 15, GetPageWidth);
171 DrawVLine(15, 0, GetPageHeight);
172 NewPage;
173 LineStyle.LColor := clRed;
174 LineStyle.LStyle := frsDash;
175 DrawHLine(0, 15, GetPageWidth);
176 DrawVLine(15, 0, GetPageHeight);
177
178 NewPage;
179 LineStyle.LColor := clYellow;
180 DrawHLine(0, 15, GetPageWidth);
181 DrawVLine(15, 0, GetPageHeight);
182
183 NewPage;
184 // Testing TextOutRectXY
185 ResetTextRectStyle; // restart default style
186 TextOutRectXY(10, 10, 15, 5, 'This text will be cut');
187 TextRectStyle.FontName := 'Times';
188 TextRectStyle.FontSize := 10;
189 TextRectStyle.FontStyle := [fsBold];
190 TextOutRectXY(10, 50, 15, 45, 'This is a non clipping test', taCenter, False);
191 ResetTextRectStyle;
192
193 // TextOut* testing. write/writeln equivalent
194 NewPage;
195 PageMargin.Top := 10;
196 PageMargin.Bottom := 10;
197 PageMargin.Left := 10;
198 PageMargin.Right := 10;
199 TextOut('World World ');
200 TextOut('World');
201 TextOut('!');
202 TextOut('___');
203 TextOutLn('.');
204 TextOutLn('Hello');
205 TextRectStyle.FontSize := 12;
206 TextOutLn('World - Size 12');
207 TextRectStyle.FontSize := 10;
208 TextOutLn('End! - Size 10');
209 for n := 0 to 250 do
210 begin
211 TextOutLn('Line ' + IntToStr(n));
212 end;
213 NewLine;
214 TextOutLn('1 line below');
215 NewLine(3);
216 TextOutLn('3 lines below');
217
218 NewPage;
219 // Testing TextOutXY
220 TextOutXY(0, 0, 'UL Corner'); // default is left aligned
221 TextOutXY(GetPageWidth, 0, 'UR Corner', taRightJustify);
222 TextOutXY(GetPageWidth / 2, 0, 'Center', taCenter);
223 TextOutXY(GetPageWidth / 2, 13, 'LLLL');
224 TextOutXY(GetPageWidth / 2, 13, 'RRRR', taRightJustify);
225 TextOutXY(0, GetPageHeight - 4, 'LL Corner'); // default is left aligned
226 TextOutXY(GetPageWidth, GetPageHeight - 4, 'LR Corner', taRightJustify);
227 TextOutXY(GetPageWidth / 2, GetPageHeight - 4, 'Center', taCenter);
228
229 NewPage;
230 // Testing rotated up text
231 TextOutXYUp(5, 1, 'Rotated Text UL Corner', taRightJustify);
232 TextOutXYUp(5, GetPageHeight / 2, 'Rotated Text Center', taCenter);
233 TextOutXYUp(5, GetPageHeight - 1, 'Rotated Text LL Corner', taLeftJustify);
234
235 NewPage;
236 // Testing frames
237 DrawFrame(10, 10, 25, 10);
238 FrameStyle.FillColor := clYellow;
239 FrameStyle.Line.LColor := clBlue;
240 DrawFrame(10, 35, 25, 10);
241 FrameStyle.Line.LColor := clNavy;
242 FrameStyle.FillColor := clNavy; // No borders
243 DrawFrame(15, 40, 25, 10);
244 ResetFrameStyle; // start new default style
245 FrameStyle.FillColor := clRed;
246 FrameStyle.Line.LColor := clGreen;
247 FrameStyle.Line.LWidth := 2;
248 FrameStyle.BorderLines := [frbLeft, frbTop, frbBottom]; // no line right side
249 DrawFrame(150, 10, 25, 10);
250 ResetFrameStyle;
251 DrawFrame(10, 100, 24, 10);
252 DrawFrame(34, 100, 24, 10);
253 DrawFrame(58, 100, 24, 10);
254 DrawFrame(82, 100, 24, 10);
255
256 NewPage;
257 // Testing image
258 // using sharedname, this allows us to define one image and reuse it
259 // resulting in less resources usage
260
261 Picture := TPicture.Create;
262 Picture.LoadFromResourceName(Hinstance, 'LOGO1');
263 DrawImage(10, 10, 60, 60, Picture, 'logo1');
264 DrawImage(10, 80, 60, 30, Picture, 'logo1');
265 // keepaspect=false
266 DrawImage(71, 80, 60, 30, Picture, 'logo1', True, False, False);
267 Picture.Free;
268
269 NewPage;
270 // Testing shapes
271 DrawShape(10, 10, 50, 20, ShapeStyle); // full power procedure
272 ShapeStyle.FillColor := clYellow;
273 ShapeStyle.FrameColor := clBlue;
274 DrawRectangle(10, 30, 50, 20);
275 DrawRoundRectangle(10, 50, 50, 20);
276 DrawDiagonalDownRight(10, 70, 50, 20);
277 DrawDiagonalUpRight(10, 90, 50, 20);
278 DrawEllipse(10, 110, 50, 20);
279 DrawTriangle(10, 130, 50, 20);
280
281 NewPage;
282 // Testing BarCodes
283 DrawBarCode(10, 10, 0, 15, 'lazarus-123456789', BarCodeStyle); // Default is Code39
284 BarCodeStyle.Angle := 90;
285 DrawBarCode(10, 30, 15, 0, 'lazarus-123456789', BarCodeStyle);
286 ResetBarCodeStyle;
287 BarCodeStyle.BorderLines := [frbLeft, frbTop, frbRight, frbBottom];
288 BarCodeStyle.FrameColor := clYellow;
289 DrawBarCode(10, 90, 0, 15, 'lazarus-123456789', BarCodeStyle);
290
291 // Testing active page change
292 ResetTextRectStyle;
293 TextRectStyle.FontSize := 7;
294 TextRectStyle.FontColor := clDkGray;
295 for n := 1 to PageCount do
296 begin
297 SetActivePage(n); // move to page n
298 if (n mod 2) = 0 then
299 begin
300 X := PageMargin.Left;
301 TextOutXY(X, GetPageHeight - PageMargin.Bottom,
302 Format('Page %d of %d', [GetActivePage, PageCount]), taLeftJustify);
303 end
304 else
305 begin
306 X := GetPageWidth - PageMargin.Right;
307 TextOutXY(X, GetPageHeight - PageMargin.Bottom,
308 Format('Page %d of %d', [GetActivePage, PageCount]), taRightJustify);
309 end;
310 end;
311
312 // For a really big report (10015 pages), try uncommenting next lines
313
314 //for n:= 1 to 10000 do
315 //begin
316 // NewPage;
317 // TextOut(Format('Page %d', [GetActivePage]));
318 //end;
319 end;
320 end;
321
322 constructor TReporter.create;
323 begin
324 inherited create;
325 fDbf := TDBF.Create(nil);
326 FDbf.Name := 'Dbf1';
327 fDbf.FilePath := DATAPATH;
328 fSrc := TDatasource.Create(nil);
329 fSrc.DataSet := fDbf;
330 //DebugLogger.MaxNestPrefixLen := 100;
331 end;
332
333 destructor TReporter.destroy;
334 begin
335 flrCode.Free;
336 flrDataset.Free;
337 fSrc.Free;
338 fDbf.Free;
339 fReport.Free;
340 inherited destroy;
341 end;
342
343 procedure TReporter.LoadReport(filename: string);
344 begin
345 CheckReport;
346 fReport.LoadFromFile(filename);
347 end;
348
349 procedure TReporter.PrepareDisksReport;
350 begin
351
352 fDbf.close;
353 fDbf.TableName := 'disco.dbf';
354 fDbf.open;
355
356 CheckReport;
357
358 if flrDataset=nil then begin
359 flrDataset := TfrDBDataset.Create(nil);
360 flrDataset.DataSet := fDbf;
361 end;
362
363 fReport.Dataset := flrDataset;
364
365 LoadReport('disks.lrf');
366 end;
367
368 procedure TReporter.PrepareCrossTabReport;
369 begin
370 fDbf.close;
371 fDbf.TableName := 'SalesCustomer.dbf';
372 fDbf.open;
373
374 CheckReport;
375
376 if flrDataset=nil then begin
377 flrDataset := TfrDBDataset.Create(nil);
378 flrDataset.DataSet := fDbf;
379 end;
380
381 fReport.Dataset := flrDataset;
382
383 LoadReport('demo_cross.lrf');
384 end;
385
DoExportReportnull386 function TReporter.DoExportReport: boolean;
387 var
388 FilterClass: TfrExportFilterClass;
389 begin
390 CheckReport;
391 result := fReport.PrepareReport;
392 if result then begin
393 case fExportBackend of
394 ebPowerPDF: filterClass := TfrTNPDFExportFilter;
395 ebFCLPDF: filterClass := TlrPdfExportFilter;
396 ebTxt: filterClass := TfrTextExportFilter;
397 ebCSV: filterClass := TfrCSVExportFilter;
398 ebHtml: filterClass := TfrHTMExportFilter;
399 ebHtmlDiv: filterClass := TfrHtmlDivExportFilter;
400 ebBmp: filterClass := TfrImageExportFilter;
401 ebJpg: filterClass := TfrImageExportFilter;
402 ebPng: filterClass := TfrImageExportFilter;
403 ebOpenDoc: filterClass := TlrSpreadSheetExportFilter;
404 ebXLS: filterClass := TlrSpreadSheetExportFilter;
405 ebOOXML: filterClass := TlrSpreadSheetExportFilter;
406 end;
407 //WriteLn('Class: ', filterclass.ClassName);
408 result := fReport.ExportTo(filterClass, fExportedFile);
409 end;
410 end;
411
BackendNamenull412 function TReporter.BackendName: string;
413 begin
414 case fExportBackend of
415 ebPowerPDF: result := '_powerpdf';
416 ebFCLPDF: result := '_fcl';
417 ebHtml: result := '_html';
418 ebHtmlDiv: result := '_htmldiv';
419 else result := '';
420 end;
421 end;
422
TReporter.BackendExtnull423 function TReporter.BackendExt: string;
424 begin
425 case fExportBackend of
426 ebPowerPDF: result := '.pdf';
427 ebFCLPDF: result := '.pdf';
428 ebHtml: result := '.htm';
429 ebHtmlDiv: result := '.html';
430 ebTxt: result := '.txt';
431 ebCSV: result := '.csv';
432 ebBmp: result := '.bmp';
433 ebJpg: result := '.jpg';
434 ebPng: result := '.png';
435 ebOpenDoc: result := '.ods';
436 ebXLS: result := '.xls';
437 ebOOXML: result := '.xlsx';
438 end;
439 end;
440
TReporter.PrepareLRCodeReportnull441 function TReporter.PrepareLRCodeReport: boolean;
442 begin
443 CheckReport;
444 if flrCode=nil then begin
445 flrCode := TlrCodeReport.Create(nil);
446 flrCode.report := fReport;
447 end;
448 flrCode.Report.Clear; // reset report
449 flrCode.OnBeginReport := @OnLRCodeReportTest;
450 flrCode.RunReport(false); // execute code
451 //fReport.SaveToXMLFile('intermedio.lrf');
452 result := true;
453 end;
454
TReporter.ProcessExportReportnull455 function TReporter.ProcessExportReport(reportName: string): boolean;
456 var
457 aFilename: String;
458 begin
459 aFilename := ChangeFileExt(PDF_FILE, backendExt);
460 aFilename := StringReplace(aFilename, '.', '_%s%s.', []);
461 fExportedFile := format(aFilename,[reportName, backendName]);
462 result := DoExportReport;
463 end;
464
465 end.
466
467