/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
- unit Unit1;
- {$mode objfpc}{$H+}
- interface
- uses
- Classes, SysUtils, LResources, Forms, Controls, Graphics, Dialogs, LR_DSet,
- LR_Class, Buttons, StdCtrls;
- {.$DEFINE DEBUG}
- type
- { TForm1 }
- TForm1 = class(TForm)
- btnShowReport: TButton;
- Button1: TButton;
- Button2: TButton;
- frReport1: TfrReport;
- MasterDS: TfrUserDataset;
- ColumnsDS: TfrUserDataset;
- procedure Button1Click(Sender: TObject);
- procedure Button2Click(Sender: TObject);
- procedure ColumnsDSCheckEOF(Sender: TObject; var IsEof: Boolean);
- procedure ColumnsDSFirst(Sender: TObject);
- procedure ColumnsDSNext(Sender: TObject);
- procedure FormCreate(Sender: TObject);
- procedure btnShowReportClick(Sender: TObject);
- procedure frReport1BeginBand(Band: TfrBand);
- procedure frReport1BeginColumn(Band: TfrBand);
- procedure frReport1BeginDoc;
- procedure frReport1BeginPage(pgNo: Integer);
- procedure frReport1EndBand(Band: TfrBand);
- procedure frReport1EndDoc;
- procedure frReport1EndPage(pgNo: Integer);
- procedure frReport1EnterRect(Memo: TStringList; View: TfrView);
- procedure frReport1GetValue(const ParName: String; var ParValue: Variant);
- procedure frReport1PrintColumn(ColNo: Integer; var AWidth: Integer);
- procedure frReport1Progress(n: Integer);
- procedure frReport1UserFunction(const AName: String; p1, p2, p3: Variant;
- var Val: Variant);
- procedure MasterDSCheckEOF(Sender: TObject; var ISEof: Boolean);
- procedure MasterDSFirst(Sender: TObject);
- procedure MasterDSNext(Sender: TObject);
- private
- { private declarations }
- public
- { public declarations }
- FRow: Integer;
- FCol: Integer;
- end;
- var
- Form1: TForm1;
- implementation
- {$R unit1.lfm}
- uses lclproc, unit2;
- { TForm1 }
- procedure TForm1.frReport1GetValue(const ParName: String; var ParValue: Variant);
- begin
- {$IFDEF DEBUG}
- WriteLn('TForm1.frReport1GetValue: ParName=',ParName);
- {$ENDIF}
- if ParName='I' then
- ParValue:=FCol
- else
- if ParName='J' then
- ParValue:=FRow
- else
- if ParName='S1' then begin
- if FRow=0 then
- ParValue:=''
- else
- ParValue:='Row'+IntToStr(FRow);
- end;
- end;
- procedure TForm1.frReport1PrintColumn(ColNo: Integer; var AWidth: Integer);
- begin
- aWidth:=60;
- {$IFDEF DEBUG}
- WriteLn('TForm1.frReport1PrintColumn: ColNo',COlNo,' Width=',AWidth);
- {$ENDIF}
- end;
- procedure TForm1.frReport1Progress(n: Integer);
- begin
- {$IFDEF DEBUG}
- WriteLn('TForm1.frReport1Progress: n=',n);
- {$ENDIF}
- end;
- procedure TForm1.frReport1UserFunction(const AName: String; p1, p2, p3: Variant;
- var Val: Variant);
- begin
- {$IFDEF DEBUG}
- WriteLn('TForm1.frReport1UserFuncion: Name=',AName,' P1=',P1,' P2=',P2,' P3=',P3, ' Val=',Val);
- {$ENDIF}
- end;
- procedure TForm1.frReport1EnterRect(Memo: TStringList; View: TfrView);
- begin
- {$IFDEF DEBUG}
- WriteLn('TForm1.frReport1EnterRect: INI, Memo: "', Dbgstr(Memo.Text),'" View=', View.Name,' View.FillColor=', ColorToString(View.FillColor) );
- {$ENDIF}
- if FRow=0 then
- view.FillColor := clWhite
- else
- if FCol mod 4=0 then
- view.FillColor := clYellow;
-
- if (FCol=3)and(FRow=3) then
- view.Memo.Text := 'HELLO';
-
- {$IFDEF DEBUG}
- WriteLn('TForm1.frReport1EnterRect: END, Memo: "', Dbgstr(Memo.Text),'" View=', View.Name,' View.FillColor=', ColorToString(View.FillColor) );
- {$ENDIF}
- end;
- procedure TForm1.frReport1BeginBand(Band: TfrBand);
- begin
- {$IFDEF DEBUG}
- WriteLn('TForm1.frReport1BeginBand: Band=',Band.Name);
- {$ENDIF}
- end;
- procedure TForm1.btnShowReportClick(Sender: TObject);
- begin
- frReport1.ShowReport;
- end;
- procedure TForm1.FormCreate(Sender: TObject);
- begin
- frReport1.LoadFromFile('usuario.lrf');
- end;
- procedure TForm1.Button1Click(Sender: TObject);
- begin
- frReport1.DesignReport;
- end;
- procedure TForm1.Button2Click(Sender: TObject);
- begin
- form2.show;
- end;
- procedure TForm1.ColumnsDSFirst(Sender: TObject);
- begin
- FCol:=1;
- {$IFDEF DEBUG}
- WriteLn('TForm1.ColumnsDSFirst: FCol=',FCol);
- {$ENDIF}
- end;
- procedure TForm1.ColumnsDSNext(Sender: TObject);
- begin
- Inc(FCol);
- {$IFDEF DEBUG}
- WriteLn('TForm1.ColumnsDSNext: FCol=',FCol);
- {$ENDIF}
- end;
- procedure TForm1.ColumnsDSCheckEOF(Sender: TObject; var ISEof: Boolean);
- begin
- IsEOF:=FCol>9;
- {$IFDEF DEBUG}
- WriteLn('TForm1.ColumnsDSCheckEOF: FCol=',FCol,' IsEOF=',IsEOF);
- {$ENDIF}
- end;
- procedure TForm1.frReport1BeginColumn(Band: TfrBand);
- begin
- {$IFDEF DEBUG}
- WriteLn('TForm1.frReport1BeginColumn: Band=',Band.Name);
- {$ENDIF}
- end;
- procedure TForm1.frReport1BeginDoc;
- begin
- {$IFDEF DEBUG}
- WriteLn('TForm1.frReport1BeginDoc;');
- {$ENDIF}
- end;
- procedure TForm1.frReport1BeginPage(pgNo: Integer);
- begin
- {$IFDEF DEBUG}
- WriteLn('TForm1.frReport1BeginPage: PgNo=',PgNo);
- {$ENDIF}
- end;
- procedure TForm1.frReport1EndBand(Band: TfrBand);
- begin
- {$IFDEF DEBUG}
- WriteLn('TForm1.frReport1EndBand: Band=',Band.Name);
- {$ENDIF}
- end;
- procedure TForm1.frReport1EndDoc;
- begin
- {$IFDEF DEBUG}
- WriteLn('TForm1.frReport1EndDoc:');
- {$ENDIF}
- end;
- procedure TForm1.frReport1EndPage(pgNo: Integer);
- begin
- {$IFDEF DEBUG}
- WriteLn('TForm1.frReport1EndPage: PgNo=',PgNo);
- {$ENDIF}
- end;
- procedure TForm1.MasterDSFirst(Sender: TObject);
- begin
- FRow:=0;
- {$IFDEF DEBUG}
- WriteLn('TForm1.MasterDSFirst: FRow=',FRow);
- {$ENDIF}
- end;
- procedure TForm1.MasterDSNext(Sender: TObject);
- begin
- Inc(FRow);
- {$IFDEF DEBUG}
- WriteLn('TForm1.MasterDSNext: FRow=',FRow);
- {$ENDIF}
- end;
- procedure TForm1.MasterDSCheckEOF(Sender: TObject; var IsEof: Boolean);
- begin
- IsEof:=FRow>40;
- {$IFDEF DEBUG}
- WriteLn('TForm1.MasterDSCheckEOF: FRow=',FRow,' IsEOF=',IsEOF);
- {$ENDIF}
- end;
- end.