rptexpressions.pp 6.8 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270
  1. unit rptexpressions;
  2. {$mode objfpc}{$H+}
  3. {$I demos.inc}
  4. interface
  5. uses
  6. Classes,
  7. SysUtils,
  8. fpreport,
  9. udapp;
  10. type
  11. { TExpressionsDemo }
  12. TExpressionsDemo = class(TReportDemoApp)
  13. private
  14. FReportData: TFPReportUserData;
  15. sl: TStringList;
  16. procedure DoBeforePrint(Sender: TFPReportElement);
  17. procedure GetReportDataFirst(Sender: TObject);
  18. procedure GetReportDataValue(Sender: TObject; const AValueName: String; var AValue: Variant);
  19. procedure GetReportDataEOF(Sender: TObject; var IsEOF: Boolean);
  20. procedure GetReportFieldNames(Sender: TObject; List: TStrings);
  21. protected
  22. procedure InitialiseData; override;
  23. procedure CreateReportDesign; override;
  24. public
  25. constructor Create(AOwner : TComponent); override;
  26. destructor Destroy; override;
  27. Class function Description : string; override;
  28. end;
  29. implementation
  30. { TExpressionsDemo }
  31. procedure TExpressionsDemo.GetReportDataFirst(Sender: TObject);
  32. begin
  33. {$IFDEF gdebug}
  34. writeln('GetReportDataFirst');
  35. {$ENDIF}
  36. end;
  37. procedure TExpressionsDemo.DoBeforePrint(Sender: TFPReportElement);
  38. begin
  39. With rpt.Variables.FindVariable('isEven') do
  40. AsBoolean:=Not AsBoolean;
  41. end;
  42. procedure TExpressionsDemo.GetReportDataValue(Sender: TObject; const AValueName: String; var AValue: Variant);
  43. begin
  44. {$IFDEF gdebug}
  45. writeln(Format('GetReportDataValue - %d', [lReportData.RecNo]));
  46. {$ENDIF}
  47. if AValueName = 'element' then
  48. begin
  49. AValue := sl[FReportData.RecNo-1];
  50. end;
  51. end;
  52. procedure TExpressionsDemo.GetReportDataEOF(Sender: TObject; var IsEOF: Boolean);
  53. begin
  54. {$IFDEF gdebug}
  55. writeln(Format('GetReportDataEOF - %d', [lReportData.RecNo]));
  56. {$ENDIF}
  57. if FReportData.RecNo > sl.Count then
  58. IsEOF := True
  59. else
  60. IsEOF := False;
  61. end;
  62. procedure TExpressionsDemo.GetReportFieldNames(Sender: TObject; List: TStrings);
  63. begin
  64. List.Add('element');
  65. end;
  66. procedure TExpressionsDemo.InitialiseData;
  67. var
  68. i: integer;
  69. begin
  70. sl := TStringList.Create;
  71. for i := 1 to 15 do
  72. sl.Add(Format(Char(64+i)+'-Item %d', [i]));
  73. end;
  74. procedure TExpressionsDemo.CreateReportDesign;
  75. var
  76. p: TFPReportPage;
  77. TitleBand: TFPReportTitleBand;
  78. DataBand: TFPReportDataBand;
  79. Memo: TFPReportMemo;
  80. PageFooter: TFPReportPageFooterBand;
  81. DataHeader: TFPReportDataHeaderBand;
  82. begin
  83. Inherited;
  84. rpt.Author := 'Graeme Geldenhuys';
  85. rpt.Title := 'FPReport Demo 2 - Expression Evaluation';
  86. // Line zero : even..
  87. rpt.Variables.AddVariable('isEven').AsBoolean:=True;
  88. p := TFPReportPage.Create(rpt);
  89. p.Orientation := poPortrait;
  90. p.PageSize.PaperName := 'A4';
  91. { page margins }
  92. p.Margins.Left := 20;
  93. p.Margins.Top := 20;
  94. p.Margins.Right := 20;
  95. p.Margins.Bottom := 20;
  96. p.Data := FReportData;
  97. p.Font.Name := 'LiberationSans';
  98. TitleBand := TFPReportTitleBand.Create(p);
  99. TitleBand.Layout.Height := 40;
  100. {$ifdef ColorBands}
  101. TitleBand.Frame.Shape := fsRectangle;
  102. TitleBand.Frame.BackgroundColor := clReportTitleSummary;
  103. {$endif}
  104. Memo := TFPReportMemo.Create(TitleBand);
  105. Memo.Layout.Left := 55;
  106. Memo.Layout.Top := 10;
  107. Memo.Layout.Width := 50;
  108. Memo.Layout.Height := 8;
  109. Memo.Text := 'THE REPORT TITLE';
  110. Memo := TFPReportMemo.Create(TitleBand);
  111. Memo.Layout.Left := 125;
  112. Memo.Layout.Top := 20;
  113. Memo.Layout.Width := 50;
  114. Memo.Layout.Height := 8;
  115. {$IFDEF fptestX}
  116. Memo.Text := 'Report Date: 2020-01-15';
  117. {$ELSE}
  118. Memo.Text := 'Report Date: [TODAY]';
  119. {$ENDIF}
  120. Memo := TFPReportMemo.Create(TitleBand);
  121. Memo.Layout.Left := 0;
  122. Memo.Layout.Top := 0;
  123. Memo.Layout.Width := 30;
  124. Memo.Layout.Height := 5;
  125. Memo.Text := '1 + 2 = [1 + 2].';
  126. Memo.Options := [moDisableExpressions];
  127. DataHeader := TFPReportDataHeaderBand.Create(p);
  128. DataHeader.Layout.Height := 10;
  129. {$ifdef ColorBands}
  130. DataHeader.Frame.Shape := fsRectangle;
  131. DataHeader.Frame.BackgroundColor := clDataHeaderFooter;
  132. {$endif}
  133. DataHeader.UseParentFont := False;
  134. DataHeader.Font.Name := 'LiberationSans-Bold';
  135. DataHeader.Data:=FReportData;
  136. Memo := TFPReportMemo.Create(DataHeader);
  137. Memo.Layout.Left := 5;
  138. Memo.Layout.Top := 0;
  139. Memo.Layout.Width := 75;
  140. Memo.Layout.Height := 5;
  141. Memo.Text := 'Complex Example';
  142. Memo.Frame.Lines := [flBottom];
  143. Memo.TextAlignment.Vertical := tlCenter;
  144. Memo := TFPReportMemo.Create(DataHeader);
  145. Memo.Layout.Left := 85;
  146. Memo.Layout.Top := 0;
  147. Memo.Layout.Width := 25;
  148. Memo.Layout.Height := 5;
  149. Memo.Text := 'Single Calc';
  150. Memo.Frame.Lines := [flBottom];
  151. Memo.TextAlignment.Vertical := tlCenter;
  152. Memo := TFPReportMemo.Create(DataHeader);
  153. Memo.Layout.Left := 120;
  154. Memo.Layout.Top := 0;
  155. Memo.Layout.Width := 35;
  156. Memo.Layout.Height := 5;
  157. Memo.Text := 'System Variables';
  158. Memo.StretchMode := smActualHeight;
  159. Memo.Frame.Lines := [flBottom];
  160. Memo.TextAlignment.Vertical := tlCenter;
  161. DataBand := TFPReportDataBand.Create(p);
  162. DataBand.Layout.Height := 10;
  163. {$ifdef ColorBands}
  164. DataBand.Frame.Shape := fsRectangle;
  165. DataBand.Frame.BackgroundColor := clDataBand;
  166. {$endif}
  167. DataBand.OnBeforePrint:=@DoBeforePrint;
  168. DataBand.Data:=FReportData;
  169. Memo := TFPReportMemo.Create(DataBand);
  170. Memo.Layout.Left := 5;
  171. Memo.Layout.Top := 2;
  172. Memo.Layout.Width := 75;
  173. Memo.Layout.Height := 5;
  174. Memo.Text := 'Even row: [isEven]. Hello world "[element]", and first letter is "[COPY(element, 1, 1)]".';
  175. Memo.Options := [];
  176. Memo := TFPReportMemo.Create(DataBand);
  177. Memo.Layout.Left := 85;
  178. Memo.Layout.Top := 2;
  179. Memo.Layout.Width := 25;
  180. Memo.Layout.Height := 5;
  181. Memo.Text := '[2 + RecNo('''') - 6]';
  182. Memo.Options := [moHideZeros];
  183. Memo := TFPReportMemo.Create(DataBand);
  184. Memo.Layout.Left := 120;
  185. Memo.Layout.Top := 2;
  186. Memo.Layout.Width := 25;
  187. Memo.Layout.Height := 5;
  188. Memo.Text := 'RecNo = [RecNo('''')].';
  189. PageFooter := TFPReportPageFooterBand.Create(p);
  190. PageFooter.Layout.Height := 20;
  191. {$ifdef ColorBands}
  192. PageFooter.Frame.Shape := fsRectangle;
  193. PageFooter.Frame.BackgroundColor := clPageHeaderFooter;
  194. {$endif}
  195. Memo := TFPReportMemo.Create(PageFooter);
  196. Memo.Layout.Left := 135;
  197. Memo.Layout.Top := 13;
  198. Memo.Layout.Width := 20;
  199. Memo.Layout.Height := 5;
  200. Memo.Text := 'Page [PageNo]';
  201. Memo := TFPReportMemo.Create(PageFooter);
  202. Memo.Layout.Left := 0;
  203. Memo.Layout.Top := 0;
  204. Memo.Layout.Width := 30;
  205. Memo.Layout.Height := 5;
  206. Memo.Text := '1 + 2 = [1 + 2].';
  207. end;
  208. constructor TExpressionsDemo.Create(AOwner: TComponent);
  209. begin
  210. Inherited;
  211. FReportData := TFPReportUserData.Create(self);
  212. FReportData.OnGetValue := @GetReportDataValue;
  213. FReportData.OnGetEOF := @GetReportDataEOF;
  214. FReportData.OnFirst := @GetReportDataFirst;
  215. FReportData.OnGetNames := @GetReportFieldNames;
  216. end;
  217. destructor TExpressionsDemo.Destroy;
  218. begin
  219. FreeAndNil(FReportData);
  220. FreeAndNil(sl);
  221. inherited Destroy;
  222. end;
  223. class function TExpressionsDemo.Description: string;
  224. begin
  225. Result:='Demo with expressions in Memos';
  226. end;
  227. end.