/components/lazreport/samples/userds/unit1.pas

http://github.com/graemeg/lazarus · Pascal · 245 lines · 162 code · 38 blank · 45 comment · 7 complexity · 335340518adbe9221d42f1812cdd0ce3 MD5 · raw file

  1. unit Unit1;
  2. {$mode objfpc}{$H+}
  3. interface
  4. uses
  5. Classes, SysUtils, LResources, Forms, Controls, Graphics, Dialogs, LR_DSet,
  6. LR_Class, Buttons, StdCtrls;
  7. {.$DEFINE DEBUG}
  8. type
  9. { TForm1 }
  10. TForm1 = class(TForm)
  11. btnShowReport: TButton;
  12. Button1: TButton;
  13. Button2: TButton;
  14. frReport1: TfrReport;
  15. MasterDS: TfrUserDataset;
  16. ColumnsDS: TfrUserDataset;
  17. procedure Button1Click(Sender: TObject);
  18. procedure Button2Click(Sender: TObject);
  19. procedure ColumnsDSCheckEOF(Sender: TObject; var IsEof: Boolean);
  20. procedure ColumnsDSFirst(Sender: TObject);
  21. procedure ColumnsDSNext(Sender: TObject);
  22. procedure FormCreate(Sender: TObject);
  23. procedure btnShowReportClick(Sender: TObject);
  24. procedure frReport1BeginBand(Band: TfrBand);
  25. procedure frReport1BeginColumn(Band: TfrBand);
  26. procedure frReport1BeginDoc;
  27. procedure frReport1BeginPage(pgNo: Integer);
  28. procedure frReport1EndBand(Band: TfrBand);
  29. procedure frReport1EndDoc;
  30. procedure frReport1EndPage(pgNo: Integer);
  31. procedure frReport1EnterRect(Memo: TStringList; View: TfrView);
  32. procedure frReport1GetValue(const ParName: String; var ParValue: Variant);
  33. procedure frReport1PrintColumn(ColNo: Integer; var AWidth: Integer);
  34. procedure frReport1Progress(n: Integer);
  35. procedure frReport1UserFunction(const AName: String; p1, p2, p3: Variant;
  36. var Val: Variant);
  37. procedure MasterDSCheckEOF(Sender: TObject; var ISEof: Boolean);
  38. procedure MasterDSFirst(Sender: TObject);
  39. procedure MasterDSNext(Sender: TObject);
  40. private
  41. { private declarations }
  42. public
  43. { public declarations }
  44. FRow: Integer;
  45. FCol: Integer;
  46. end;
  47. var
  48. Form1: TForm1;
  49. implementation
  50. {$R unit1.lfm}
  51. uses lclproc, unit2;
  52. { TForm1 }
  53. procedure TForm1.frReport1GetValue(const ParName: String; var ParValue: Variant);
  54. begin
  55. {$IFDEF DEBUG}
  56. WriteLn('TForm1.frReport1GetValue: ParName=',ParName);
  57. {$ENDIF}
  58. if ParName='I' then
  59. ParValue:=FCol
  60. else
  61. if ParName='J' then
  62. ParValue:=FRow
  63. else
  64. if ParName='S1' then begin
  65. if FRow=0 then
  66. ParValue:=''
  67. else
  68. ParValue:='Row'+IntToStr(FRow);
  69. end;
  70. end;
  71. procedure TForm1.frReport1PrintColumn(ColNo: Integer; var AWidth: Integer);
  72. begin
  73. aWidth:=60;
  74. {$IFDEF DEBUG}
  75. WriteLn('TForm1.frReport1PrintColumn: ColNo',COlNo,' Width=',AWidth);
  76. {$ENDIF}
  77. end;
  78. procedure TForm1.frReport1Progress(n: Integer);
  79. begin
  80. {$IFDEF DEBUG}
  81. WriteLn('TForm1.frReport1Progress: n=',n);
  82. {$ENDIF}
  83. end;
  84. procedure TForm1.frReport1UserFunction(const AName: String; p1, p2, p3: Variant;
  85. var Val: Variant);
  86. begin
  87. {$IFDEF DEBUG}
  88. WriteLn('TForm1.frReport1UserFuncion: Name=',AName,' P1=',P1,' P2=',P2,' P3=',P3, ' Val=',Val);
  89. {$ENDIF}
  90. end;
  91. procedure TForm1.frReport1EnterRect(Memo: TStringList; View: TfrView);
  92. begin
  93. {$IFDEF DEBUG}
  94. WriteLn('TForm1.frReport1EnterRect: INI, Memo: "', Dbgstr(Memo.Text),'" View=', View.Name,' View.FillColor=', ColorToString(View.FillColor) );
  95. {$ENDIF}
  96. if FRow=0 then
  97. view.FillColor := clWhite
  98. else
  99. if FCol mod 4=0 then
  100. view.FillColor := clYellow;
  101. if (FCol=3)and(FRow=3) then
  102. view.Memo.Text := 'HELLO';
  103. {$IFDEF DEBUG}
  104. WriteLn('TForm1.frReport1EnterRect: END, Memo: "', Dbgstr(Memo.Text),'" View=', View.Name,' View.FillColor=', ColorToString(View.FillColor) );
  105. {$ENDIF}
  106. end;
  107. procedure TForm1.frReport1BeginBand(Band: TfrBand);
  108. begin
  109. {$IFDEF DEBUG}
  110. WriteLn('TForm1.frReport1BeginBand: Band=',Band.Name);
  111. {$ENDIF}
  112. end;
  113. procedure TForm1.btnShowReportClick(Sender: TObject);
  114. begin
  115. frReport1.ShowReport;
  116. end;
  117. procedure TForm1.FormCreate(Sender: TObject);
  118. begin
  119. frReport1.LoadFromFile('usuario.lrf');
  120. end;
  121. procedure TForm1.Button1Click(Sender: TObject);
  122. begin
  123. frReport1.DesignReport;
  124. end;
  125. procedure TForm1.Button2Click(Sender: TObject);
  126. begin
  127. form2.show;
  128. end;
  129. procedure TForm1.ColumnsDSFirst(Sender: TObject);
  130. begin
  131. FCol:=1;
  132. {$IFDEF DEBUG}
  133. WriteLn('TForm1.ColumnsDSFirst: FCol=',FCol);
  134. {$ENDIF}
  135. end;
  136. procedure TForm1.ColumnsDSNext(Sender: TObject);
  137. begin
  138. Inc(FCol);
  139. {$IFDEF DEBUG}
  140. WriteLn('TForm1.ColumnsDSNext: FCol=',FCol);
  141. {$ENDIF}
  142. end;
  143. procedure TForm1.ColumnsDSCheckEOF(Sender: TObject; var ISEof: Boolean);
  144. begin
  145. IsEOF:=FCol>9;
  146. {$IFDEF DEBUG}
  147. WriteLn('TForm1.ColumnsDSCheckEOF: FCol=',FCol,' IsEOF=',IsEOF);
  148. {$ENDIF}
  149. end;
  150. procedure TForm1.frReport1BeginColumn(Band: TfrBand);
  151. begin
  152. {$IFDEF DEBUG}
  153. WriteLn('TForm1.frReport1BeginColumn: Band=',Band.Name);
  154. {$ENDIF}
  155. end;
  156. procedure TForm1.frReport1BeginDoc;
  157. begin
  158. {$IFDEF DEBUG}
  159. WriteLn('TForm1.frReport1BeginDoc;');
  160. {$ENDIF}
  161. end;
  162. procedure TForm1.frReport1BeginPage(pgNo: Integer);
  163. begin
  164. {$IFDEF DEBUG}
  165. WriteLn('TForm1.frReport1BeginPage: PgNo=',PgNo);
  166. {$ENDIF}
  167. end;
  168. procedure TForm1.frReport1EndBand(Band: TfrBand);
  169. begin
  170. {$IFDEF DEBUG}
  171. WriteLn('TForm1.frReport1EndBand: Band=',Band.Name);
  172. {$ENDIF}
  173. end;
  174. procedure TForm1.frReport1EndDoc;
  175. begin
  176. {$IFDEF DEBUG}
  177. WriteLn('TForm1.frReport1EndDoc:');
  178. {$ENDIF}
  179. end;
  180. procedure TForm1.frReport1EndPage(pgNo: Integer);
  181. begin
  182. {$IFDEF DEBUG}
  183. WriteLn('TForm1.frReport1EndPage: PgNo=',PgNo);
  184. {$ENDIF}
  185. end;
  186. procedure TForm1.MasterDSFirst(Sender: TObject);
  187. begin
  188. FRow:=0;
  189. {$IFDEF DEBUG}
  190. WriteLn('TForm1.MasterDSFirst: FRow=',FRow);
  191. {$ENDIF}
  192. end;
  193. procedure TForm1.MasterDSNext(Sender: TObject);
  194. begin
  195. Inc(FRow);
  196. {$IFDEF DEBUG}
  197. WriteLn('TForm1.MasterDSNext: FRow=',FRow);
  198. {$ENDIF}
  199. end;
  200. procedure TForm1.MasterDSCheckEOF(Sender: TObject; var IsEof: Boolean);
  201. begin
  202. IsEof:=FRow>40;
  203. {$IFDEF DEBUG}
  204. WriteLn('TForm1.MasterDSCheckEOF: FRow=',FRow,' IsEOF=',IsEOF);
  205. {$ENDIF}
  206. end;
  207. end.