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

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