paweld/lazarus
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/lazarus/lazarus.git synced 2025-04-13 21:59:36 +02:00
Code Issues Packages Projects Releases Wiki Activity

LazReport, implemented template for printgrid

Browse Source 
git-svn-id: trunk@17784 -
This commit is contained in:
jesus 2008-12-10 16:09:29 +00:00
parent 7163cdb30d
commit 90510e4cb6
1 changed files with 80 additions and 17 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

97
components/lazreport/source/lr_pgrid.pas
View File

@ -20,7 +20,7 @@ interface
{$I LR_Vers.inc}
uses
SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
SysUtils, Classes, Graphics, Controls, Forms, Dialogs, PropEdits,
DB, DBGrids, Printers, LR_DSet, LR_DBSet, LR_Class;
type
@ -53,6 +53,7 @@ type
FWidth : Integer;
FDataSet : TDataset;
FColumnsInfo : array of TColumnInfo;
FTemplate : string;
procedure OnEnterRect(Memo: TStringList; View: TfrView);
procedure OnPrintColumn(ColNo: Integer; var Width: Integer);
@ -61,6 +62,8 @@ type
{ Protected declarations }
procedure Notification(AComponent: TComponent; Operation: TOperation); override;
procedure SetupColumns;
function FindBand(APage: TFrPage; AType: TfrBandType): TFrBandView;
procedure ReplaceTemplate(APage:TFrPage; ABand: TFrBandView; ATemplate,AReplace:String);
public
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
@ -72,6 +75,7 @@ type
property Font: TFont read FFont write FFont;
property TitleFont : TFont read FTitleFont write FTitleFont;
property Caption: String read FCaption write FCaption;
property Template: string read FTemplate write FTemplate;
property ShowCaption: Boolean read FShowCaption write FShowCaption;
property ShowHeaderOnAllPage : boolean read fShowHdOnAllPage write fShowHdOnAllPage default True;
property ShowProgress : Boolean read fShowProgress write fShowProgress default false;
@ -81,10 +85,6 @@ type
implementation
type
THackDBGrid = class(TDBGrid)
end;
{ TfrPrintGrid }
constructor TfrPrintGrid.Create(AOwner: TComponent);
@ -142,6 +142,38 @@ begin
end;
end;
function TfrPrintGrid.FindBand(APage: TFrPage; AType:TfrBandType): TFrBandView;
var
i: Integer;
begin
for i:=0 to APage.Objects.Count-1 do begin
if not (TObject(APage.Objects[i]) is TFrBandView) then
continue;
Result := TFrBandView(APage.Objects[i]);
if Result.BandType=AType then
exit;
end;
result := nil;
end;
procedure TfrPrintGrid.ReplaceTemplate(APage: TFrPage; ABand: TFrBandView;
ATemplate, AReplace: String);
var
i: Integer;
Obj: TfrObject;
begin
for i:=0 to APage.Objects.Count-1 do begin
Obj := TfrObject(APage.Objects[i]);
if Obj is TfrMemoView then begin
if (Obj.y>=ABand.y) and (Obj.y<(ABand.Y+ABand.Dy)) then begin
// this memo is on ABand
TfrMemoView(Obj).Memo.Text := StringReplace(TfrMemoView(Obj).Memo.Text,
ATemplate, AReplace, [rfReplaceAll, rfIgnoreCase]);
end;
end;
end;
end;
procedure TfrPrintGrid.SetDBGrid(const AValue: TDBGrid);
begin
fDBGrid:=aValue;
@ -155,16 +187,23 @@ end;
procedure TfrPrintGrid.PreviewReport;
var
v: TfrView;
b: TfrBandView;
b,h: TfrBandView;
Page: TfrPage;
BM : TBookMark;
yPos: Integer;
begin
if (FDBGrid = nil) or (DBGrid.Datasource = nil) or
(DBGrid.Datasource.Dataset = nil) then Exit;
FDataSet := DBGrid.Datasource.Dataset;
if (FTemplate<>'') and not FileExists(FTemplate) then
raise Exception.CreateFmt('Template file %s does not exists',[FTemplate]);
FReport := TfrReport.Create(Self);
if FTemplate<>'' then
FReport.LoadFromFile(FTemplate);
FDataSet := DBGrid.Datasource.Dataset;
FReport.OnEnterRect :=@OnEnterRect;
FReport.OnPrintColumn:=@OnPrintColumn;
FReport.ShowProgress :=fShowProgress;
@ -182,13 +221,29 @@ begin
try
FReportDataSet.DataSource := DBGrid.DataSource;
FReport.Pages.Add;
Page := FReport.Pages[0];
if FReport.Pages.Count=0 then
FReport.Pages.add;
Page := FReport.Pages[FReport.Pages.Count-1];
with Page do
ChangePaper(pgSize, Width, Height, FOrientation);
if FShowCaption then
begin
YPos := -1;
b := FindBand(Page, btReportTitle);
if b<>nil then begin
if FShowCaption then
ReplaceTemplate(Page, b, '<title>', FCaption);
YPos := b.y + b.dy + 10;
end;
h := FindBand(Page, btPageHeader);
if h<>nil then begin
if FShowCaption then
ReplaceTemplate(Page, h, '<title>', FCaption);
YPos := h.y + h.dy + 10;
end;
if FShowCaption and (b=nil) and (h=nil) then begin
b := TfrBandView(frCreateObject(gtBand, ''));
b.SetBounds(10, 20, 1000, 25);
b.BandType := btReportTitle;
@ -199,17 +254,21 @@ begin
TfrMemoView(v).Font.Assign(FTitleFont);
v.Memo.Add(FCaption);
Page.Objects.Add(v);
YPos := b.y + b.dy + 10;
end;
if YPos<0 then
YPos := 60;
b := TfrBandView(frCreateObject(gtBand, ''));
b.BandType := btMasterHeader;
if self.fShowHdOnAllPage then
b.Flags:=b.Flags+flBandRepeatHeader;
b.SetBounds(20, 60, 1000, 20);
b.SetBounds(20, YPos, 1000, 20);
Page.Objects.Add(b);
v := frCreateObject(gtMemo, '');
v.SetBounds(20, 60, 20, 20);
v.SetBounds(20, YPos, 20, 20);
TfrMemoView(v).Alignment:=taCenter;
TfrMemoView(v).FillColor := clSilver;
TfrMemoView(v).Font.Assign(FTitleFont);
@ -218,10 +277,12 @@ begin
v.Memo.Add('[Header]');
Page.Objects.Add(v);
YPos := YPos + 40;
b := TfrBandView(frCreateObject(gtBand, ''));
b.BandType := btMasterData;
b.Dataset := FReportDataSet.Name;
b.SetBounds(0, 100, 1000, 18);
b.SetBounds(0, YPos, 1000, 18);
Page.Objects.Add(b);
b := TfrBandView(frCreateObject(gtBand, ''));
@ -231,7 +292,7 @@ begin
Page.Objects.Add(b);
v := frCreateObject(gtMemo, '');
v.SetBounds(20, 100, 20, 18);
v.SetBounds(20, YPos, 20, 18);
v.Memo.Add('[Cell]');
TfrMemoView(v).Font.Assign(FFont);
TfrMemoView(v).Frames:=frAllFrames;
@ -265,7 +326,7 @@ begin
exit;
C := TColumn(DbGrid.Columns[FColumnsInfo[i].Column]);
if C<>nil then
if (C<>nil)and(Memo.Count>0) then
begin
if (Memo[0]='[Cell]') and (C.Field<>nil) then
begin
@ -288,5 +349,7 @@ begin
Width := FColumnsInfo[ColNo-1].ColumnWidth;
end;
initialization
RegisterPropertyEditor(TypeInfo(AnsiString),
TFrPrintGrid,'Template',TFileNamePropertyEditor);
end.