rptsimplelist.pp 4.8 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199
  1. unit rptsimplelist;
  2. {$mode objfpc}{$H+}
  3. {$I demos.inc}
  4. interface
  5. uses
  6. Classes,
  7. SysUtils,
  8. fpreport,
  9. udapp;
  10. type
  11. { TSimpleListDemo }
  12. TSimpleListDemo = class(TReportDemoApp)
  13. private
  14. lReportData: TFPReportUserData;
  15. sl: TStringList;
  16. procedure GetReportDataFirst(Sender: TObject);
  17. procedure GetReportDataValue(Sender: TObject; const AValueName: String; var AValue: Variant);
  18. procedure GetReportDataEOF(Sender: TObject; var IsEOF: Boolean);
  19. procedure GetReportDataNames(Sender: TObject; List: TStrings);
  20. Protected
  21. procedure InitialiseData; override;
  22. procedure CreateReportDesign; override;
  23. public
  24. constructor Create(AOwner : TComponent); override;
  25. destructor Destroy; override;
  26. Class function Description : string; override;
  27. end;
  28. implementation
  29. uses
  30. fpTTF;
  31. { TSimpleListDemo }
  32. procedure TSimpleListDemo.GetReportDataFirst(Sender: TObject);
  33. begin
  34. {$IFDEF gdebug}
  35. writeln('GetReportDataFirst');
  36. {$ENDIF}
  37. end;
  38. procedure TSimpleListDemo.GetReportDataValue(Sender: TObject; const AValueName: String; var AValue: Variant);
  39. begin
  40. {$IFDEF gdebug}
  41. writeln(Format('GetReportDataValue - %d', [lReportData.RecNo]));
  42. {$ENDIF}
  43. if AValueName = 'element' then
  44. begin
  45. AValue := sl[lReportData.RecNo-1];
  46. end;
  47. end;
  48. procedure TSimpleListDemo.GetReportDataEOF(Sender: TObject; var IsEOF: Boolean);
  49. begin
  50. {$IFDEF gdebug}
  51. writeln(Format('GetReportDataEOF - %d', [lReportData.RecNo]));
  52. {$ENDIF}
  53. if lReportData.RecNo > sl.Count then
  54. IsEOF := True
  55. else
  56. IsEOF := False;
  57. end;
  58. procedure TSimpleListDemo.GetReportDataNames(Sender: TObject; List: TStrings);
  59. begin
  60. List.Add('element');
  61. end;
  62. procedure TSimpleListDemo.InitialiseData;
  63. var
  64. i: integer;
  65. begin
  66. sl := TStringList.Create;
  67. for i := 1 to 30 do
  68. sl.Add(Format('Item %d', [i]));
  69. end;
  70. procedure TSimpleListDemo.CreateReportDesign;
  71. var
  72. p: TFPReportPage;
  73. TitleBand: TFPReportTitleBand;
  74. DataBand: TFPReportDataBand;
  75. Memo: TFPReportMemo;
  76. PageFooter: TFPReportPageFooterBand;
  77. SummaryBand: TFPReportSummaryBand;
  78. begin
  79. Inherited;
  80. rpt.Author := 'Graeme Geldenhuys';
  81. rpt.Title := 'FPReport Demo 1 - Simple Listing';
  82. p := TFPReportPage.Create(rpt);
  83. p.Orientation := poPortrait;
  84. p.PageSize.PaperName := 'A4';
  85. { page margins }
  86. p.Margins.Left := 30;
  87. p.Margins.Top := 20;
  88. p.Margins.Right := 30;
  89. p.Margins.Bottom := 20;
  90. p.Data := lReportData;
  91. p.Font.Name := 'LiberationSans';
  92. TitleBand := TFPReportTitleBand.Create(p);
  93. TitleBand.Layout.Height := 40;
  94. {$ifdef ColorBands}
  95. TitleBand.Frame.Shape := fsRectangle;
  96. TitleBand.Frame.BackgroundColor := clReportTitleSummary;
  97. {$endif}
  98. Memo := TFPReportMemo.Create(TitleBand);
  99. Memo.Layout.Left := 55;
  100. Memo.Layout.Top := 20;
  101. Memo.Layout.Width := 50;
  102. Memo.Layout.Height := 10;
  103. Memo.Text := 'THE REPORT TITLE';
  104. DataBand := TFPReportDataBand.Create(p);
  105. DataBand.Layout.Height := 10;
  106. {$ifdef ColorBands}
  107. DataBand.Frame.Shape := fsRectangle;
  108. DataBand.Frame.BackgroundColor := clDataBand;
  109. {$endif}
  110. Memo := TFPReportMemo.Create(DataBand);
  111. Memo.Layout.Left := 5;
  112. Memo.Layout.Top := 0;
  113. Memo.Layout.Width := 60;
  114. Memo.Layout.Height := 5;
  115. Memo.Text := 'Hello world <[element]>.';
  116. PageFooter := TFPReportPageFooterBand.Create(p);
  117. PageFooter.Layout.Height := 20;
  118. {$ifdef ColorBands}
  119. PageFooter.Frame.Shape := fsRectangle;
  120. PageFooter.Frame.BackgroundColor := clPageHeaderFooter;
  121. {$endif}
  122. Memo := TFPReportMemo.Create(PageFooter);
  123. Memo.Layout.Left := 135;
  124. Memo.Layout.Top := 13;
  125. Memo.Layout.Width := 20;
  126. Memo.Layout.Height := 5;
  127. Memo.Text := 'Page [PageNo]';
  128. SummaryBand := TFPReportSummaryBand.Create(p);
  129. SummaryBand.Layout.Height := 40;
  130. {$ifdef ColorBands}
  131. SummaryBand.Frame.Shape := fsRectangle;
  132. SummaryBand.Frame.BackgroundColor := clReportTitleSummary;
  133. {$endif}
  134. Memo := TFPReportMemo.Create(SummaryBand);
  135. Memo.Layout.Left := 19;
  136. Memo.Layout.Top := 10;
  137. Memo.Layout.Width := 70;
  138. Memo.Layout.Height := 25;
  139. Memo.StretchMode := smActualHeight;
  140. Memo.Text := 'This is some long text that should be wrapping inside the memo. It has a 10mm left margin, and a 7mm right margin. 0mm margin top and bottom.';
  141. Memo.TextAlignment.LeftMargin := 10;
  142. Memo.TextAlignment.RightMargin := 7;
  143. Memo.TextAlignment.Horizontal := taWidth;
  144. Memo.Frame.Shape := fsRectangle;
  145. Memo.Frame.BackgroundColor := clLtGray;
  146. end;
  147. constructor TSimpleListDemo.Create(AOwner : TComponent);
  148. begin
  149. Inherited;
  150. lReportData := TFPReportUserData.Create(Self);
  151. lReportData.OnGetValue := @GetReportDataValue;
  152. lReportData.OnGetEOF := @GetReportDataEOF;
  153. lReportData.OnFirst := @GetReportDataFirst;
  154. lReportData.OnGetNames := @GetReportDataNames;
  155. end;
  156. destructor TSimpleListDemo.Destroy;
  157. begin
  158. FreeAndNil(lReportData);
  159. FreeAndNil(sl);
  160. inherited Destroy;
  161. end;
  162. class function TSimpleListDemo.Description: string;
  163. begin
  164. Result:='Simple list of countries';
  165. end;
  166. end.