Delphi/FastReport_FMX_2.8.12
Delphi/FastReport_FMX_2.8.12
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity
f4b3d937f8
FastReport_FMX_2.8.12/Source/FMX.frxEngine.pas

2811 lines
74 KiB
ObjectPascal
Raw Normal View History

Init
2024-01-10 21:50:38 +01:00
{******************************************}
{ }
{ FastReport v4.0 }
{ Report engine }
{ }
{ Copyright (c) 1998-2008 }
{ by Alexander Tzyganenko, }
{ Fast Reports Inc. }
{ }
{******************************************}
unit FMX.frxEngine;
interface
{$I fmx.inc}
{$I frx.inc}
uses
System.SysUtils, System.Classes, System.Variants, System.UITypes, System.Types,
FMX.Forms,
FMX.frxClass, FMX.frxAggregate, FMX.frxXML, FMX.frxDMPClass;
type
{ TfrxHeaderList holds a set of bands that should appear on each new page.
This includes page header, column header and header bands with
"Reprint on new page" setting }
TfrxHeaderListItem = class(TObject)
public
Band: TfrxBand;
Left: Extended;
IsInKeepList: Boolean;
end;
TfrxHeaderList = class(TObject)
private
FList: TList;
function GetCount: Integer;
function GetItems(Index: Integer): TfrxHeaderListItem;
public
constructor Create;
destructor Destroy; override;
procedure Clear;
procedure AddItem(ABand: TfrxBand; ALeft: Extended; AInKeepList: Boolean);
procedure RemoveItem(ABand: TfrxBand);
property Count: Integer read GetCount;
property Items[Index: Integer]: TfrxHeaderListItem read GetItems; default;
end;
TfrxEngine = class(TfrxCustomEngine)
private
FAggregates: TfrxAggregateList;
FCallFromAddPage: Boolean;
FCallFromEndPage: Boolean;
FCurBand: TfrxBand;
FLastBandOnPage: TfrxBand;
FDontShowHeaders: Boolean;
FHeaderList: TfrxHeaderList; { list of header bands }
FFirstReportPage: Boolean; { needed for correct setting of PreviewPages.FirstPage }
FFirstColumnY: Extended; { position of the first column }
FIsFirstBand: Boolean; { needed for KeepTogether }
FIsFirstPage: Boolean; { first and last page flags }
FIsLastPage: Boolean; { }
FTitlePrinted: Boolean;
FHBandNamesTree: TStrings; { need for correct work with drill down in master-detail-subtetail-... }
FKeepBand: TfrxBand;
FKeepFooter: Boolean;
FKeeping: Boolean;
FKeepHeader: Boolean;
FKeepCurY: Extended; { need when group doesn't fit on the whole page}
FPrevFooterHeight: Extended; {need for correct freespace calculation when use printOnPreviousPage}
FKeepOutline: TfrxXMLItem;
FKeepPosition: Integer;
FKeepAnchor: Integer;
FCallFromPHeader: Boolean; { endless loop fix }
FOutputTo: TfrxNullBand; { used in the subreports }
FPage: TfrxReportPage; { currently proceeded page }
FPageCurX: Extended;
FStartNewPageBand: TfrxBand; { needed in addpage }
FVHeaderList: TList; { list of vheader bands }
FVMasterBand: TfrxBand; { master hband for vbands }
FVPageList: TList; { list of page breaks for vbands }
FFastCanvas: TObject;
procedure AddBandOutline(Band: TfrxBand);
procedure AddColumn;
procedure AddPage;
procedure AddPageOutline;
procedure AddToHeaderList(Band: TfrxBand);
procedure AddToVHeaderList(Band: TfrxBand);
procedure CheckBandColumns(Band: TfrxDataBand; ColumnKeepPos: Integer;
SaveCurY: Extended);
procedure CheckDrill(Master: TfrxDataBand; Band: TfrxGroupHeader);
procedure CheckGroups(Master: TfrxDataBand; Band: TfrxGroupHeader;
ColumnKeepPos: Integer; SaveCurY: Extended);
procedure CheckSubReports(Band: TfrxBand);
procedure CheckSuppress(Band: TfrxBand);
procedure DoShow(Band: TfrxBand);
procedure DrawSplit(Band: TfrxBand);
procedure EndColumn;
procedure EndKeep(Band: TfrxBand);
procedure InitGroups(Master: TfrxDataBand; Band: TfrxGroupHeader;
Index: Integer; ResetLineN: Boolean = False);
procedure InitPage;
procedure NotifyObjects(Band: TfrxBand);
procedure OutlineRoot;
procedure OutlineUp(Band: TfrxBand);
procedure PreparePage(ErrorList: TStrings; PrepareVBands: Boolean);
procedure PrepareShiftTree(Band: TfrxBand);
procedure RemoveFromHeaderList(Band: TfrxBand);
procedure RemoveFromVHeaderList(Band: TfrxBand);
procedure ResetSuppressValues(Band: TfrxBand);
procedure RunPage(Page: TfrxReportPage);
procedure RunReportPages;
procedure ShowGroupFooters(Band: TfrxGroupHeader; Index: Integer; Master: TfrxDataBand);
procedure ShowVBands(HBand: TfrxBand);
procedure StartKeep(Band: TfrxBand; Position: Integer = 0);
procedure Stretch(Band: TfrxBand);
procedure UnStretch(Band: TfrxBand);
function CanShow(Obj: TObject; PrintIfDetailEmpty: Boolean): Boolean;
function FindBand(Band: TfrxBandClass): TfrxBand;
function RunDialogs: Boolean;
protected
function GetPageHeight: Double; override;
public
constructor Create(AReport: TfrxReport); override;
destructor Destroy; override;
procedure EndPage; override;
procedure NewColumn; override;
procedure NewPage; override;
function Run: Boolean; override;
procedure ShowBand(Band: TfrxBand); overload; override;
procedure ShowBand(Band: TfrxBandClass); overload; override;
function HeaderHeight: Double; override;
function FooterHeight: Double; override;
function FreeSpace: Double; override;
procedure BreakAllKeep; override; { used in crosstab }
function GetAggregateValue(const Name, Expression: String;
Band: TfrxBand; Flags: Integer): Variant; override;
function Initialize: Boolean;
procedure Finalize;
end;
implementation
uses
FMX.frxUtils, FMX.frxPreviewPages, FMX.frxRes, FMX.frxFMX;
type
THackComponent = class(TfrxComponent);
THackMemoView = class(TfrxCustomMemoView);
{ TfrxHeaderList }
constructor TfrxHeaderList.Create;
begin
FList := TList.Create;
end;
destructor TfrxHeaderList.Destroy;
begin
Clear;
FList.Free;
inherited;
end;
procedure TfrxHeaderList.Clear;
begin
while FList.Count > 0 do
begin
TObject(FList[0]).Free;
FList.Delete(0);
end;
end;
function TfrxHeaderList.GetCount: Integer;
begin
Result := FList.Count;
end;
function TfrxHeaderList.GetItems(Index: Integer): TfrxHeaderListItem;
begin
Result := FList[Index];
end;
procedure TfrxHeaderList.AddItem(ABand: TfrxBand; ALeft: Extended; AInKeepList: Boolean);
var
Item: TfrxHeaderListItem;
begin
Item := TfrxHeaderListItem.Create;
Item.Band := ABand;
Item.Left := ALeft;
Item.IsInKeepList := AInKeepList;
FList.Add(Item);
end;
procedure TfrxHeaderList.RemoveItem(ABand: TfrxBand);
var
i: Integer;
begin
for i := 0 to Count - 1 do
if Items[i].Band = ABand then
begin
Items[i].Free;
FList.Delete(i);
break;
end;
end;
{ TfrxEngine }
constructor TfrxEngine.Create(AReport: TfrxReport);
begin
inherited;
FHeaderList := TfrxHeaderList.Create;
FVHeaderList := TList.Create;
FVPageList := TList.Create;
FAggregates := TfrxAggregateList.Create(AReport);
FHBandNamesTree := TStringList.Create;
FLastBandOnPage := nil;
FFastCanvas := nil;
if frxCanvasClass <> nil then
FFastCanvas := frxCanvasClass.Create;
end;
destructor TfrxEngine.Destroy;
begin
FHeaderList.Free;
FVHeaderList.Free;
FVPageList.Free;
FAggregates.Free;
FHBandNamesTree.Free;
if Assigned(FFastCanvas) then
FFastCanvas.Free;
inherited;
end;
function TfrxEngine.Initialize: Boolean;
var
i, j: Integer;
b: TfrxDataBand;
begin
FPrevFooterHeight := 0;
PreviewPages.Initialize;
PreviewPages.AddPageAction := apAdd;
StartDate := Date;
StartTime := Time;
Running := True;
FKeeping := False;
CurVColumn := 0;
FOutputTo := nil;
{ clear all aggregate items }
FAggregates.Clear;
{ add all report pages to the PreviewPages }
for i := 0 to Report.PagesCount - 1 do
if Report.Pages[i] is TfrxReportPage then
begin
{ set the current page }
FPage := TfrxReportPage(Report.Pages[i]);
{ create band tree for the current page }
PreparePage(Report.Errors, False);
PreparePage(Report.Errors, True);
end;
{ check datasets used }
for i := 0 to Report.PagesCount - 1 do
if Report.Pages[i] is TfrxReportPage then
begin
FPage := TfrxReportPage(Report.Pages[i]);
if (Report.DataSet <> nil) and (Report.DataSet = FPage.DataSet) then
begin
Report.Errors.Add('Cannot use the same dataset for Report.DataSet and Page.DataSet');
break;
end;
for j := 0 to FPage.FSubBands.Count - 1 do
begin
b := FPage.FSubBands[j];
if (b <> nil) and (b.DataSet <> nil) then
if Report.DataSet = b.DataSet then
begin
Report.Errors.Add('Cannot use the same dataset for Report.DataSet and Band.DataSet');
break;
end
else if FPage.DataSet = b.DataSet then
begin
Report.Errors.Add('Cannot use the same dataset for Page.DataSet and Band.DataSet');
break;
end
end;
end;
Result := Report.Errors.Count = 0;
end;
procedure TfrxEngine.Finalize;
begin
try
Report.DataSets.Finalize;
finally
PreviewPages.Finish;
Running := False;
end;
end;
function TfrxEngine.Run: Boolean;
var
i: Integer;
begin
Result := False;
try
if Initialize then
try
Report.DataSets.Initialize;
Report.DoNotifyEvent(Report, Report.OnStartReport);
if RunDialogs then
begin
Result := True;
{ add all report pages to the PreviewPages }
for i := 0 to Report.PagesCount - 1 do
if Report.Pages[i] is TfrxReportPage then
begin
FPage := TfrxReportPage(Report.Pages[i]);
PreviewPages.AddSourcePage(FPage);
{ find aggregates }
FAggregates.AddItems(FPage);
end;
{ start the report }
FinalPass := not DoublePass;
TotalPages := 0;
PreviewPages.BeginPass;
RunReportPages;
if DoublePass then
begin
TotalPages := PreviewPages.Count;
PreviewPages.CurPage := PreviewPages.Count - 1;
PreviewPages.ClearFirstPassPages;
FAggregates.ClearValues;
FinalPass := True;
RunReportPages;
end;
end
finally
Report.DoNotifyEvent(Report, Report.OnStopReport);
end;
finally
Finalize;
end;
end;
{$HINTS OFF}
function TfrxEngine.RunDialogs: Boolean;
var
i: Integer;
p: TfrxDialogPage;
v: Variant;
begin
Result := True;
{$IFNDEF FR_VER_BASIC}
if Trim(Report.OnRunDialogs) <> '' then
begin
v := VarArrayOf([True]);
Report.DoParamEvent(Report.OnRunDialogs, v);
Result := v[0];
end
else
for i := 0 to Report.PagesCount - 1 do
if (Report.Pages[i] is TfrxDialogPage) and Report.Pages[i].Visible then
begin
p := TfrxDialogPage(Report.Pages[i]);
{ refresh the border style - it was bsSizeable in the designer }
p.DialogForm.BorderStyle := p.BorderStyle;
{ don't show empty form }
if p.DialogForm.ChildrenCount <> 0 then
begin
if Assigned(OnRunDialog) then
OnRunDialog(p) else
p.ShowModal;
if p.ModalResult = mrCancel then
begin
Result := False;
break;
end;
end;
end;
{$ENDIF}
end;
{$HINTS ON}
procedure TfrxEngine.RunReportPages;
procedure DoPages;
var
i: Integer;
begin
for i := 0 to Report.PagesCount - 1 do
if Report.Pages[i] is TfrxReportPage then
begin
FPage := TfrxReportPage(Report.Pages[i]);
{ ignore subreport pages and invisible pages }
if not FPage.IsSubReport and FPage.Visible then
RunPage(FPage);
if Report.Terminated then break;
FFirstReportPage := False;
end;
end;
begin
FFirstReportPage := True;
if Report.DataSet = nil then
DoPages
else
begin
Report.DataSet.First;
while not Report.DataSet.Eof do
begin
if Report.Terminated then break;
DoPages;
Report.DataSet.Next;
end;
end;
end;
procedure TfrxEngine.PreparePage(ErrorList: TStrings; PrepareVBands: Boolean);
var
i, j, k: Integer;
t, c: TfrxComponent;
b: TfrxBand;
Bands: TList;
SortBands: TStringList;
procedure ClearNils;
var
i: Integer;
begin
i := 0;
while i < Bands.Count do
if Bands[i] = nil then
Bands.Delete(i) else
Inc(i);
end;
procedure MakeTree(Obj: TObject; From: Integer);
var
i: Integer;
b: TfrxBand;
begin
if Obj is TfrxReportPage then
begin
{ fill the first level - TfrxReportPage.FMasterBands }
for i := 0 to Bands.Count - 1 do
begin
b := Bands[i];
if b = nil then continue;
if b is TfrxMasterData then
begin
// if TfrxDataBand(b).DataSet <> nil then { ignore empty datasets }
if PrepareVBands then
TfrxReportPage(Obj).FVSubBands.Add(b)
else
TfrxReportPage(Obj).FSubBands.Add(b);
Bands[i] := nil;
MakeTree(b, i + 1);
end;
end;
end
else
begin
{ fill next levels - TfrxBand.FSubBands }
for i := From to Bands.Count - 1 do
begin
b := Bands[i];
if b = nil then continue;
{ looking for sub-level bands }
if b.BandNumber = TfrxBand(Obj).BandNumber + 1 then
begin
// if TfrxDataBand(b).DataSet <> nil then { ignore empty datasets }
TfrxBand(Obj).FSubBands.Add(b);
Bands[i] := nil;
if not (b is TfrxDataBand6) then
MakeTree(b, i + 1);
end
else if b.BandNumber <= TfrxBand(Obj).BandNumber then
break; { found higher-level data band }
end;
end;
end;
procedure ConnectHeaders;
var
i: Integer;
b1, b2: TfrxBand;
begin
for i := 0 to Bands.Count - 1 do
begin
b1 := Bands[i];
{ looking for data band }
if b1 is TfrxDataBand then
begin
if i > 0 then
begin
b2 := Bands[i - 1];
if b2 is TfrxHeader then { if top band is header, connect it }
begin
b1.FHeader := b2;
Bands[i - 1] := nil;
end;
end;
if i < Bands.Count - 1 then { if bottom band is footer, connect it }
begin
b2 := Bands[i + 1];
if b2 is TfrxFooter then
begin
b1.FFooter := b2;
Bands[i + 1] := nil;
end;
end;
end;
end;
ClearNils;
{ now all headers/footers must be connected. If not, add an error }
for i := 0 to Bands.Count - 1 do
begin
b1 := Bands[i];
if (b1 is TfrxHeader) or (b1 is TfrxFooter) then
begin
ErrorList.Add(frxResources.Get('enUnconnHeader') + ' ' + b1.Name);
Bands[i] := nil;
end;
end;
ClearNils;
end;
procedure ConnectGroups;
var
i, j: Integer;
b1, b2: TfrxBand;
begin
{ connect group headers }
i := 0;
while i < Bands.Count do
begin
b1 := Bands[i];
if b1 is TfrxGroupHeader then
begin
b1.FSubBands.Add(b1);
Inc(i);
{ add all subsequent headers to the first header's FSubBands }
while (i < Bands.Count) and (TfrxBand(Bands[i]) is TfrxGroupHeader) do
begin
b1.FSubBands.Add(Bands[i]);
Inc(i);
end;
{ search for databand }
while (i < Bands.Count) and not (TfrxBand(Bands[i]) is TfrxDataBand) do
Inc(i);
{ now we expect to see the databand }
if (i = Bands.Count) or not (TObject(Bands[i]) is TfrxDataBand) then
ErrorList.Add(frxResources.Get('enUnconnGroup') + ' ' + b1.Name)
else
TfrxBand(Bands[i]).FGroup := b1;
end
else
Inc(i);
end;
{ connect group footers }
for i := 0 to Bands.Count - 1 do
begin
b1 := Bands[i];
if b1 is TfrxGroupFooter then
for j := i - 1 downto 0 do
begin
b2 := Bands[j];
if b2 is TfrxGroupHeader then { connect to top-nearest header }
begin
b2.FFooter := b1;
Bands[i] := nil;
Bands[j] := nil;
break;
end;
end;
end;
{ remove header bands from the list }
for i := 0 to Bands.Count - 1 do
begin
b1 := Bands[i];
if b1 is TfrxGroupHeader then
Bands[i] := nil;
end;
{ looking for footers w/o corresponding header }
for i := 0 to Bands.Count - 1 do
begin
b1 := Bands[i];
if b1 is TfrxGroupFooter then
begin
ErrorList.Add(frxResources.Get('enUnconnGFooter') + ' ' + b1.Name);
Bands[i] := nil;
end;
end;
ClearNils;
end;
begin
SortBands := TfrxStringList.Create;
SortBands.Sorted := True;
{ align all objects with Align property <> baNone }
FPage.AlignChildren;
{ clear all page SubBands }
if PrepareVBands then
FPage.FVSubBands.Clear
else
FPage.FSubBands.Clear;
for i := 0 to FPage.Objects.Count - 1 do
begin
t := FPage.Objects[i];
if t is TfrxBand then
begin
b := TfrxBand(t);
if b.Vertical <> PrepareVBands then
continue;
PrepareShiftTree(b);
b.FSubBands.Clear;
b.FHeader := nil;
b.FFooter := nil;
b.FGroup := nil;
b.FHasVBands := False;
if b is TfrxDataBand then
if (TfrxDataBand(b).DataSet = nil) and (TfrxDataBand(b).RowCount > 0) then
begin
TfrxDataBand(b).DataSet := TfrxDataBand(b).VirtualDataSet;
TfrxDataBand(b).DataSet.Initialize;
end;
{ connect objects to vertical bands }
if (not PrepareVBands) and not (b is TfrxOverlay) then
for j := 0 to FPage.Objects.Count - 1 do
begin
t := FPage.Objects[j];
if (t is TfrxBand) and TfrxBand(t).Vertical then
begin
k := 0;
while k < b.Objects.Count do
begin
c := b.Objects[k];
if (c.Left >= t.Left - 1e-4) and
(c.Left + c.Width <= t.Left + t.Width + 1e-4) then
begin
b.FHasVBands := True;
c.Parent := t;
THackComponent(c).FOriginalBand := b;
c.Left := c.Left - t.Left;
end
else
Inc(k);
end;
end;
end;
end;
end;
{ sort bands by position }
for i := 0 to FPage.Objects.Count - 1 do
begin
t := FPage.Objects[i];
if t is TfrxBand then
begin
b := TfrxBand(t);
if b.Vertical <> PrepareVBands then
continue;
if b.BandNumber in [4..13] then
if b.Vertical then
SortBands.AddObject(Format('%9.2f', [b.Left]), b)
else
SortBands.AddObject(Format('%9.2f', [b.Top]), b);
end;
end;
{ copy sorted items to TList - it's easier to work with it }
Bands := TList.Create;
for i := 0 to SortBands.Count - 1 do
begin
t := TfrxComponent(SortBands.Objects[i]);
Bands.Add(t);
end;
SortBands.Free;
ConnectGroups;
ConnectHeaders;
MakeTree(FPage, 0);
ClearNils;
for i := 0 to Bands.Count - 1 do
begin
t := Bands[i];
ErrorList.Add(frxResources.Get('enBandPos') + ' ' + t.Name);
end;
Bands.Free;
end;
procedure TfrxEngine.PrepareShiftTree(Band: TfrxBand);
var
i, j, k: Integer;
c0, c1, c2, top: TfrxReportComponent;
allObjects: TStringList;
Found: Boolean;
area0, area1, area2, area01: TfrxRectArea;
begin
if Band.FShiftChildren.Count <> 0 then
Exit;
allObjects := TfrxStringList.Create;
allObjects.Duplicates := dupAccept;
{ temporary top object }
top := TfrxMemoView.Create(nil);
top.SetBounds(0, Band.Top-2, Band.Width, 1);
{ sort objects }
for i := 0 to Band.Objects.Count - 1 do
begin
c0 := Band.Objects[i];
allObjects.AddObject(Format('%9.2f', [c0.Top]), c0);
c0.FShiftChildren.Clear;
end;
allObjects.Sort;
allObjects.InsertObject(0, Format('%10.2f', [top.Top]), top);
for i := 0 to allObjects.Count - 1 do
begin
c0 := TfrxReportComponent(allObjects.Objects[i]);
area0 := TfrxRectArea.Create(c0);
{ find an object under c0 }
for j := i + 1 to allObjects.Count - 1 do
begin
c1 := TfrxReportComponent(allObjects.Objects[j]);
area1 := TfrxRectArea.Create(c1);
if not (area0.InterceptsY(area1)) and (area0.Y < area1.Y) and
area0.InterceptsX(area1) then
begin
area01 := area0.InterceptX(area1);
Found := False;
{ check if there is no other objects between c1 and c0 }
for k := j - 1 downto i + 1 do
begin
c2 := TfrxReportComponent(allObjects.Objects[k]);
area2 := TfrxRectArea.Create(c2);
if not (area0.InterceptsY(area2)) and not (area1.InterceptsY(area2)) and
area01.InterceptsX(area2) then
Found := True;
area2.Free;
if Found then
break;
end;
if not Found then
c0.FShiftChildren.Add(c1);
area01.Free;
end;
area1.Free;
end;
area0.Free;
end;
{ copy children from the top object to the band }
Band.FShiftChildren.Clear;
for i := 0 to top.FShiftChildren.Count - 1 do
Band.FShiftChildren.Add(top.FShiftChildren[i]);
allObjects.Free;
top.Free;
end;
function TfrxEngine.CanShow(Obj: TObject; PrintIfDetailEmpty: Boolean): Boolean;
var
i: Integer;
Bands: TList;
b: TfrxDataBand;
res: Boolean;
begin
if Obj is TfrxReportPage then
Bands := TfrxReportPage(Obj).FSubBands else
Bands := TfrxBand(Obj).FSubBands;
Result := True;
{ Check all subdetail bands to ensure they all have records }
if not PrintIfDetailEmpty then
begin
Result := False;
if (Bands.Count = 0) and not (Obj is TfrxPage) then
Result := True;
for i := 0 to Bands.Count - 1 do
begin
b := Bands[i];
if b.DataSet <> nil then
begin
Report.DoNotifyEvent(b, b.OnMasterDetail);
b.DataSet.First;
while not b.DataSet.Eof do
begin
res := CanShow(b, b.PrintIfDetailEmpty);
if res then
begin
Result := True;
break;
end
else
b.DataSet.Next;
end;
end;
end;
end;
end;
procedure TfrxEngine.ResetSuppressValues(Band: TfrxBand);
var
i: Integer;
begin
for i := 0 to Band.Objects.Count - 1 do
if TObject(Band.Objects[i]) is TfrxCustomMemoView then
THackMemoView(Band.Objects[i]).FLastValue := Null;
end;
procedure TfrxEngine.InitGroups(Master: TfrxDataBand; Band: TfrxGroupHeader;
Index: Integer; ResetLineN: Boolean = False);
var
i: Integer;
b: TfrxGroupHeader;
begin
for i := Index to Band.FSubBands.Count - 1 do
begin
b := Band.FSubBands[i];
if ResetLineN then
begin
b.FLineN := 1;
b.FLineThrough := 1;
ResetSuppressValues(b);
end
else
begin
Inc(b.FLineN);
if i < Band.FSubBands.Count - 1 then
TfrxBand(Band.FSubBands[i + 1]).FLineN := 0;
Inc(b.FLineThrough);
end;
end;
CheckDrill(Master, Band);
for i := Index to Band.FSubBands.Count - 1 do
begin
b := Band.FSubBands[i];
CurLine := b.FLineN;
CurLineThrough := b.FLineThrough;
Report.CurObject := b.Name;
b.FLastValue := Report.Calc(b.Condition);
if b.KeepTogether then
StartKeep(b);
ShowBand(b);
AddBandOutline(b);
if b.Vertical then
AddToVHeaderList(b)
else
AddToHeaderList(b);
end;
end;
procedure TfrxEngine.ShowGroupFooters(Band: TfrxGroupHeader; Index: Integer;
Master: TfrxDataBand);
var
i: Integer;
b: TfrxGroupHeader;
begin
for i := Band.FSubBands.Count - 1 downto Index do
begin
b := Band.FSubBands[i];
if b.FFooter <> nil then
if not TfrxGroupFooter(b.FFooter).HideIfSingleDataRecord or (Master.FLineN > 2) then
ShowBand(b.FFooter)
else
FAggregates.Reset(b.FFooter);
OutlineUp(b);
if b.Vertical then
RemoveFromVHeaderList(b)
else
RemoveFromHeaderList(b);
if b.KeepTogether then
EndKeep(b);
end;
end;
procedure TfrxEngine.CheckDrill(Master: TfrxDataBand; Band: TfrxGroupHeader);
var
i, j: Integer;
b, b1: TfrxGroupHeader;
drillVisible: Boolean;
BandNamesList: TStrings;
begin
BandNamesList := FHBandNamesTree;
for i := 0 to Band.FSubBands.Count - 1 do
begin
b := Band.FSubBands[i];
if b.DrillDown then
begin
b.DrillName := '';
for j := 0 to BandNamesList.Count - 1 do
b.DrillName := b.DrillName + BandNamesList[j] + '.' + IntToStr(Integer(BandNamesList.Objects[j])) + '.';
b.DrillName := b.DrillName + b.Name + '.' + IntToStr(b.FLineThrough);
drillVisible := Report.DrillState.IndexOf(b.DrillName) <> -1;
if b.ExpandDrillDown then
drillVisible := not DrillVisible;
if (b.Child <> nil) and not Band.ShowChildIfDrillDown then
b.Child.Visible := drillVisible;
for j := i + 1 to Band.FSubBands.Count - 1 do
begin
b1 := Band.FSubBands[j];
b1.Visible := drillVisible;
if b1.FFooter <> nil then
b1.FFooter.Visible := drillVisible;
end;
Master.Visible := drillVisible;
if not b.ShowFooterIfDrillDown and (b.FFooter <> nil) then
b.FFooter.Visible := drillVisible;
if not drillVisible then
break;
end;
end;
end;
procedure TfrxEngine.CheckGroups(Master: TfrxDataBand; Band: TfrxGroupHeader;
ColumnKeepPos: Integer; SaveCurY: Extended);
var
i: Integer;
b: TfrxGroupHeader;
NextNeeded: Boolean;
begin
CheckDrill(Master, Band);
for i := 0 to Band.FSubBands.Count - 1 do
begin
b := Band.FSubBands[i];
Report.CurObject := b.Name;
if Report.Calc(b.Condition) <> b.FLastValue then
begin
Master.CurColumn := Master.Columns;
CheckBandColumns(Master, ColumnKeepPos, SaveCurY);
{ avoid exception in uni-directional datasets }
NextNeeded := True;
try
Master.DataSet.Prior;
except
NextNeeded := False;
end;
ShowGroupFooters(Band, i, Master);
if NextNeeded then
Master.DataSet.Next;
InitGroups(Master, Band, i);
Master.FLineN := 1;
ResetSuppressValues(Master);
break;
end;
end;
end;
procedure TfrxEngine.CheckBandColumns(Band: TfrxDataBand; ColumnKeepPos: Integer;
SaveCurY: Extended);
begin
if Band.Columns > 1 then
begin
{ collect max position in b.FMaxY }
if CurY > Band.FMaxY then
Band.FMaxY := CurY;
{ all columns have been printed }
if Band.CurColumn >= Band.Columns then
begin
{ need page break, don't break if page has Endless Height}
if ((PageHeight - FooterHeight) - Band.FMaxY <= 1e-4) and (not FPage.EndlessHeight) then
begin
if FKeeping then { standard keep procedure }
NewColumn
else
begin
PreviewPages.CutObjects(ColumnKeepPos);
NewColumn;
PreviewPages.PasteObjects(CurX, CurY);
CurY := CurY + Band.FMaxY - SaveCurY;
end;
end
else
CurY := Band.FMaxY; { start the new band from saved b.FMaxY }
end
else
CurY := SaveCurY; { start the new band from saved SaveCurY }
if Band.Visible then
Band.CurColumn := Band.CurColumn + 1;
end;
end;
procedure TfrxEngine.NotifyObjects(Band: TfrxBand);
var
i: Integer;
c: TfrxComponent;
begin
for i := 0 to NotifyList.Count - 1 do
begin
c := NotifyList[i];
if c <> nil then
c.OnNotify(Band);
end;
end;
procedure TfrxEngine.RunPage(Page: TfrxReportPage);
var
PageCount: Integer;
{$IFNDEF MSWINDOWS}
bIDLE: Boolean;
{$ENDIF}
{ "Null" band contains all free-placed objects that don't have a parent band }
procedure ShowNullBand;
var
i: Integer;
b: TfrxNullBand;
SaveCurY: Extended;
begin
b := TfrxNullBand.Create(nil);
b.Width := PageWidth;
b.Height := PageHeight;
SaveCurY := CurY;
for i := 0 to FPage.Objects.Count - 1 do
if not (TObject(FPage.Objects[i]) is TfrxBand) then
b.Objects.Add(FPage.Objects[i]);
try
b.AlignChildren;
ShowBand(b);
finally
CurY := SaveCurY;
b.Objects.Clear;
b.Free;
end;
end;
{ Band tree is the structure that we created in the PreparePage method }
procedure ShowBandTree(Obj: TObject);
var
i: Integer;
Bands: TList;
b: TfrxDataBand;
FirstTime: Boolean;
FooterKeepPos, ColumnKeepPos: Integer;
SaveCurY: Extended;
begin
if not Report.EngineOptions.EnableThreadSafe then
{$IFDEF MSWINDOWS}
Application.ProcessMessages;
{$ELSE}
Application.DoIdle(bIDLE);
{$ENDIF}
if Report.Terminated then Exit;
FooterKeepPos := 0;
ColumnKeepPos := 0;
SaveCurY := CurY;
if Obj is TfrxReportPage then
Bands := TfrxReportPage(Obj).FSubBands else
Bands := TfrxBand(Obj).FSubBands;
for i := 0 to Bands.Count - 1 do
begin
b := Bands[i];
if b.DataSet = nil then
continue;
b.DataSet.First;
b.FLineN := 1;
b.FLineThrough := 1;
b.CurColumn := 1;
FirstTime := True;
ResetSuppressValues(b);
while not b.DataSet.Eof do
begin
if CanShow(b, b.PrintIfDetailEmpty) then
begin
if FirstTime then
begin
if b.KeepHeader and (b.FHeader <> nil) then
begin
if FIsFirstBand then
FIsFirstBand := not FTitlePrinted;
FKeepHeader := not FIsFirstBand;
StartKeep(b);
end;
AddToHeaderList(b.FHeader);
ShowBand(b.FHeader);
if b.KeepTogether then
StartKeep(b);
end
{ keeping a master-detail differs from keeping a group }
else if (b.FGroup = nil) and b.KeepTogether then
StartKeep(b);
if b.FGroup <> nil then
if FirstTime then
InitGroups(b, TfrxGroupHeader(b.FGroup), 0, True) else
CheckGroups(b, TfrxGroupHeader(b.FGroup), ColumnKeepPos, SaveCurY);
if b.KeepFooter then
FooterKeepPos := PreviewPages.GetCurPosition;
if (b.Columns > 1) and (b.CurColumn = 1) then
ColumnKeepPos := PreviewPages.GetCurPosition;
SaveCurY := CurY;
CurLine := b.FLineN;
CurLineThrough := b.FLineThrough;
ShowBand(b);
FKeepHeader := False;
NotifyObjects(b);
if FirstTime then
if b.KeepHeader and (b.FHeader <> nil) then
EndKeep(b);
FirstTime := False;
FHBandNamesTree.AddObject(b.Name, TObject(b.FLineThrough));
Inc(b.FLineN);
Inc(b.FLineThrough);
CheckBandColumns(b, ColumnKeepPos, SaveCurY);
AddBandOutline(b);
ShowBandTree(b);
FHBandNamesTree.Delete(FHBandNamesTree.Count - 1);
OutlineUp(b);
FIsFirstBand := False;
if b.FooterAfterEach then
ShowBand(b.FFooter);
end;
{ keeping a master-detail differs from keeping a group }
if (b.FGroup = nil) and b.KeepTogether then
EndKeep(b);
b.DataSet.Next;
if b.RowCount <> 0 then
if b.FLineN > b.RowCount then break;
if Report.Terminated then break;
end;
{ update the CurY if band is multicolumn }
b.CurColumn := b.Columns;
CheckBandColumns(b, ColumnKeepPos, SaveCurY);
if not FirstTime then { some bands have been printed }
begin
if b.FGroup <> nil then
ShowGroupFooters(TfrxGroupHeader(b.FGroup), 0, b);
if FKeeping then
RemoveFromHeaderList(b.FHeader);
if not b.FooterAfterEach then
begin
if b.KeepFooter then
StartKeep(b, FooterKeepPos);
FKeepFooter := True;
ShowBand(b.FFooter);
if b.KeepFooter then
EndKeep(b);
FKeepFooter := False;
end;
RemoveFromHeaderList(b.FHeader);
if (b.FGroup <> nil) and b.KeepTogether then
EndKeep(b);
end;
if Report.Terminated then break;
FIsFirstBand := False;
end;
end;
procedure ShowPage;
var
pgWidth, pgHeight: Extended;
begin
if CanShow(FPage, Report.EngineOptions.PrintIfEmpty) then
begin
InitPage;
ShowNullBand;
if Assigned(Report.OnManualBuild) then
Report.OnManualBuild(FPage)
else if Trim(FPage.OnManualBuild) <> '' then
Report.DoNotifyEvent(FPage, FPage.OnManualBuild)
else
ShowBandTree(FPage);
FIsLastPage := True;
if FPage.EndlessHeight or FPage.EndlessWidth then
begin
if FPage.EndlessWidth then
pgWidth := PageWidth + FPage.LeftMargin * fr01cm + FPage.RightMargin * fr01cm
else
pgWidth := FPage.PaperWidth * fr01cm;
if FPage.EndlessHeight then
begin
PageHeight := CurY + FooterHeight;
pgHeight := PageHeight + FPage.TopMargin * fr01cm + FPage.BottomMargin * fr01cm
end
else
pgHeight := FPage.PaperHeight * fr01cm;
TfrxPreviewPages(PreviewPages).UpdatePageDimensions(FPage, pgWidth, pgHeight);
end;
EndPage;
FIsLastPage := False;
end;
end;
begin
{ The Page parameter needed only for subreport pages. General is FPage }
if Page.IsSubReport then
begin
ShowBandTree(Page);
Exit;
end;
FIsFirstBand := True;
Report.DoNotifyEvent(FPage, FPage.OnBeforePrint);
if FPage.DataSet <> nil then
begin
FPage.DataSet.First;
while not FPage.DataSet.Eof do
begin
if Report.Terminated then break;
ShowPage;
FPage.DataSet.Next;
end;
end
else
for PageCount := 1 to FPage.PageCount do
begin
if Report.Terminated then break;
ShowPage;
end;
Report.DoNotifyEvent(FPage, FPage.OnAfterPrint);
end;
procedure TfrxEngine.ShowVBands(HBand: TfrxBand);
var
SavePageNo: Integer;
procedure ShowBandTree(Bands: TList);
var
i: Integer;
b: TfrxDataBand;
FirstTime: Boolean;
begin
if Report.Terminated then Exit;
for i := 0 to Bands.Count - 1 do
begin
b := Bands[i];
if b.DataSet = nil then
continue;
b.DataSet.First;
b.FLineN := 1;
b.FLineThrough := 1;
b.CurColumn := 1;
CurLine := b.FLineN;
CurLineThrough := b.FLineThrough;
FirstTime := True;
ResetSuppressValues(b);
while not b.DataSet.Eof do
begin
if FirstTime then
begin
ShowBand(b.FHeader);
AddToVHeaderList(b.FHeader);
end;
if b.FGroup <> nil then
if FirstTime then
InitGroups(b, TfrxGroupHeader(b.FGroup), 0, True) else
CheckGroups(b, TfrxGroupHeader(b.FGroup), 0, 0);
FirstTime := False;
CurLine := b.FLineN;
CurLineThrough := b.FLineThrough;
ShowBand(b);
NotifyObjects(b);
Inc(b.FLineN);
Inc(b.FLineThrough);
ShowBandTree(b.FSubBands);
if b.FooterAfterEach then
ShowBand(b.FFooter);
b.DataSet.Next;
if b.RowCount <> 0 then
if b.FLineN > b.RowCount then break;
if Report.Terminated then break;
end;
if b.FGroup <> nil then
ShowGroupFooters(TfrxGroupHeader(b.FGroup), 0, b);
if not FirstTime then { some bands have been printed }
begin
RemoveFromVHeaderList(b.FHeader);
if not b.FooterAfterEach then
ShowBand(b.FFooter);
end;
if Report.Terminated then break;
end;
end;
begin
FVMasterBand := HBand;
FVMasterBand.FOriginalObjectsCount := FVMasterBand.Objects.Count;
FVMasterBand.AllowSplit := False;
SavePageNo := PreviewPages.CurPage;
FVHeaderList.Clear;
FVPageList.Clear;
FVPageList.Add(Pointer(0));
CurVColumn := 0;
ShowBandTree(TfrxReportPage(HBand.Page).FVSubBands);
FVPageList.Add(Pointer(FVMasterBand.Objects.Count));
PreviewPages.CurPage := SavePageNo;
end;
procedure TfrxEngine.InitPage;
begin
{ fill in the header/footer lists }
FHeaderList.Clear;
if FPage.TitleBeforeHeader then
begin
FHeaderList.AddItem(FindBand(TfrxReportTitle), 0, False);
FHeaderList.AddItem(FindBand(TfrxPageHeader), 0, False);
end
else
begin
FHeaderList.AddItem(FindBand(TfrxPageHeader), 0, False);
FHeaderList.AddItem(FindBand(TfrxReportTitle), 0, False);
end;
{ calculating the page/footer sizes }
PageHeight := FPage.PaperHeight * fr01cm - FPage.TopMargin * fr01cm -
FPage.BottomMargin * fr01cm;
PageWidth := FPage.PaperWidth * fr01cm - FPage.LeftMargin * fr01cm -
FPage.RightMargin * fr01cm;
{ reset the current position }
CurX := 0;
CurY := 0;
CurColumn := 1;
FPageCurX := 0;
FVMasterBand := nil;
FIsFirstPage := True;
FIsLastPage := False;
OutlineRoot;
if FPage.ResetPageNumbers then
PreviewPages.ResetLogicalPageNumber;
if (PreviewPages.Count = 0) or not FPage.PrintOnPreviousPage then
AddPage
else
begin
PreviewPages.CurPage := PreviewPages.Count - 1;
CurY := PreviewPages.GetLastY;
RemoveFromHeaderList(FindBand(TfrxReportTitle));
ShowBand(TfrxReportTitle);
end;
if FFirstReportPage then
PreviewPages.FirstPage := PreviewPages.CurPage;
FFirstColumnY := CurY;
ShowBand(TfrxColumnHeader);
FHeaderList.AddItem(FindBand(TfrxColumnHeader), 0, False);
RemoveFromHeaderList(FindBand(TfrxReportTitle));
AddPageOutline;
end;
function TfrxEngine.HeaderHeight: Double;
var
Band: TfrxBand;
begin
Result := 0;
Band := FindBand(TfrxColumnHeader);
while Band <> nil do
begin
Result := Result + Band.Height;
Band := Band.Child;
end;
Band := FindBand(TfrxPageHeader);
while Band <> nil do
begin
Result := Result + Band.Height;
Band := Band.Child;
end;
end;
function TfrxEngine.FooterHeight: Double;
var
Band: TfrxBand;
begin
Result := 0;
Band := FindBand(TfrxColumnFooter);
if Band <> nil then
Result := Result + Band.Height;
Band := FindBand(TfrxPageFooter);
if Band <> nil then
Result := Result + Band.Height;
end;
function TfrxEngine.FindBand(Band: TfrxBandClass): TfrxBand;
begin
Result := FPage.FindBand(Band);
end;
procedure TfrxEngine.ShowBand(Band: TfrxBand);
var
chBand: TfrxBand;
begin
if Band <> nil then
begin
if Band.KeepChild then
StartKeep(Band);
DoShow(Band);
if (Band is TfrxDataBand) and (TfrxDataBand(Band).CurColumn > 1) then { dont show childs for columns}
chBand := nil
else
chBand := Band.Child;
if (chBand <> nil) and (Band.Visible or Band.PrintChildIfInvisible) then
ShowBand(chBand);
if Band.KeepChild then
EndKeep(Band);
if Band is TfrxDataBand then
FAggregates.AddValue(Band);
end;
end;
procedure TfrxEngine.ShowBand(Band: TfrxBandClass);
begin
ShowBand(FindBand(Band));
end;
procedure TfrxEngine.AddToHeaderList(Band: TfrxBand);
begin
{ only header bands with "Reprint on new page" flag can be added }
if ((Band is TfrxHeader) and TfrxHeader(Band).ReprintOnNewPage) or
((Band is TfrxGroupHeader) and TfrxGroupHeader(Band).ReprintOnNewPage) then
FHeaderList.AddItem(Band, FPageCurX, FKeeping and not (Band is TfrxHeader));
end;
procedure TfrxEngine.AddToVHeaderList(Band: TfrxBand);
begin
{ only header bands with "Reprint on new page" flag can be added }
if ((Band is TfrxHeader) and TfrxHeader(Band).ReprintOnNewPage) or
((Band is TfrxGroupHeader) and TfrxGroupHeader(Band).ReprintOnNewPage) then
FVHeaderList.Add(Band);
end;
procedure TfrxEngine.BreakAllKeep;
begin
inherited;
FKeepCurY := 0;
FKeeping := False;
FKeepBand := nil;
FAggregates.EndKeep;
FKeepHeader := False;
end;
procedure TfrxEngine.RemoveFromHeaderList(Band: TfrxBand);
begin
if Band <> nil then
FHeaderList.RemoveItem(Band);
end;
procedure TfrxEngine.RemoveFromVHeaderList(Band: TfrxBand);
begin
if Band <> nil then
FVHeaderList.Remove(Band);
end;
function TfrxEngine.FreeSpace: Double;
begin
if FPage.EndlessHeight then
Result := 1e+6
else
if FPrevFooterHeight <> 0 then
Result := PageHeight - FPrevFooterHeight - CurY
else Result := PageHeight - FooterHeight - CurY;
end;
procedure TfrxEngine.Stretch(Band: TfrxBand);
var
i: Integer;
h, maxh: Extended;
c, maxc: TfrxView;
HaveSub, NeedShift: Boolean;
procedure DoSubReports;
var
i: Integer;
SaveCurX, SaveCurY, SavePageCurX: Extended;
Sub: TfrxSubreport;
MainBand: Boolean;
AllObjects: TList;
c: TfrxComponent;
begin
{ create a band which will accepts all subsequent output }
MainBand := False;
if FOutputTo = nil then
begin
Band.FOriginalObjectsCount := Band.Objects.Count;
FOutputTo := TfrxNullBand.Create(nil);
MainBand := True;
end;
{ save the current position }
SaveCurX := CurX;
SaveCurY := CurY;
SavePageCurX := FPageCurX;
{ looking for subreport objects }
for i := 0 to Band.Objects.Count - 1 do
if TObject(Band.Objects[i]) is TfrxSubreport then
begin
Sub := TfrxSubreport(Band.Objects[i]);
if not Sub.Visible or not Sub.PrintOnParent or not MainBand then continue;
{ set up all properties... }
FPageCurX := SavePageCurX + Sub.Left;
CurX := Sub.Left;
CurY := Sub.Top;
{ ...and run the subreport }
RunPage(Sub.Page);
end;
{ restore saved position }
CurX := SaveCurX;
CurY := SaveCurY;
FPageCurX := SavePageCurX;
if MainBand then
begin
{ copy all output to the band }
AllObjects := FOutputTo.AllObjects;
for i := 0 to AllObjects.Count - 1 do
begin
c := AllObjects[i];
if (c is TfrxView) and not (c is TfrxSubreport) then
begin
c.Left := c.AbsLeft;
c.Top := c.AbsTop;
c.ParentFont := False;
c.Parent := Band;
end;
if c is TfrxStretcheable then
TfrxStretcheable(c).StretchMode := smDontStretch;
end;
{ Clear the FOutputTo property. Extra objects will be freed
in the Unstretch method. }
FOutputTo.Free;
FOutputTo := nil;
end;
end;
procedure ShiftObjects(Parent: TfrxReportComponent; Amount: Extended);
var
i: Integer;
v: TfrxView;
diff: Extended;
begin
for i := 0 to Parent.FShiftChildren.Count - 1 do
begin
v := Parent.FShiftChildren[i];
if v.ShiftMode = smAlways then
begin
v.Top := v.Top + Amount;
ShiftObjects(v, Amount + v.FShiftAmount);
end
else if v.ShiftMode = smWhenOverlapped then
begin
if not (Parent is TfrxBand) and (v.Top < Parent.Top + Parent.Height) then
begin
diff := Parent.Top + Parent.Height - v.Top;
v.Top := Parent.Top + Parent.Height;
ShiftObjects(v, diff + v.FShiftAmount);
end
else
ShiftObjects(v, v.FShiftAmount);
end
else {if v.FShiftAmount <> 0 then}
ShiftObjects(v, Amount + v.FShiftAmount);
v.FShiftAmount := 0;
end;
end;
begin
FCurBand := Band;
HaveSub := False;
NeedShift := False;
PrepareShiftTree(Band);
{ it is not necessary for vertical bands }
if Band <> FVMasterBand then
begin
{ firing band OnBeforePrint event }
Report.CurObject := Band.Name;
Band.BeforePrint;
Report.DoBeforePrint(Band);
end;
{ firing OnBeforePrint events, stretching objects }
for i := 0 to Band.Objects.Count - 1 do
begin
c := Band.Objects[i];
if (c is TfrxSubreport) and TfrxSubreport(c).PrintOnParent then
HaveSub := True;
{ skip getdata for vertical bands' objects }
if (Band <> FVMasterBand) or (i < Band.FOriginalObjectsCount) then
begin
Report.CurObject := c.Name;
c.BeforePrint;
if Band.Visible then
begin
Report.DoBeforePrint(c);
if c.Visible then
begin
c.GetData;
Report.DoNotifyEvent(c, c.OnAfterData);
end;
end;
end;
if not Band.Visible or not c.Visible then continue;
if (c is TfrxStretcheable) and (TfrxStretcheable(c).StretchMode <> smDontStretch) then
begin
TfrxStretcheable(c).SetFastCanvas(TfrxFastCanvaslayer(FFastCanvas));
h := TfrxStretcheable(c).CalcHeight;
TfrxStretcheable(c).SetFastCanvas(nil);
if h > c.Height then
begin
c.FShiftAmount := h - c.Height; { needed to shift underlying objects }
c.Height := h; { stretch the object }
NeedShift := True;
end
else
c.FShiftAmount := 0;
end;
end;
if not Band.Visible then Exit;
{ shift objects }
if NeedShift then
ShiftObjects(Band, 0);
{ check subreports that have PrintOnParent option }
if HaveSub then
DoSubReports;
{ calculate the max height of the band }
maxh := 0;
maxc := nil;
for i := 0 to Band.Objects.Count - 1 do
begin
c := Band.Objects[i];
if c.Top + c.Height > maxh then
begin
maxh := c.Top + c.Height;
maxc := c;
end;
end;
if (maxc <> nil) and (maxc is TfrxDMPMemoView) and
(ftBottom in TfrxDMPMemoView(maxc).Frame.Typ) then
maxh := maxh + fr1CharY;
if Band.Stretched then
Band.Height := maxh;
{ fire Band.OnAfterCalcHeight event }
Report.CurObject := Band.Name;
Report.DoNotifyEvent(Band, Band.OnAfterCalcHeight);
{ set the height of objects that should stretch to max height }
for i := 0 to Band.Objects.Count - 1 do
begin
c := Band.Objects[i];
if (c is TfrxStretcheable) and (TfrxStretcheable(c).StretchMode = smMaxHeight) then
begin
c.Height := maxh - c.Top;
if (c is TfrxDMPMemoView) and (ftBottom in TfrxDMPMemoView(c).Frame.Typ) then
c.Height := c.Height - fr1CharY;
end;
end;
end;
procedure TfrxEngine.UnStretch(Band: TfrxBand);
var
i: Integer;
c: TfrxView;
begin
{ fire OnAfterPrint event }
if Band.Visible then
for i := 0 to Band.Objects.Count - 1 do
begin
c := Band.Objects[i];
Report.CurObject := c.Name;
Report.DoAfterPrint(c);
end;
{ restore state }
for i := 0 to Band.Objects.Count - 1 do
if (Band <> FVMasterBand) or (i < Band.FOriginalObjectsCount) then
begin
c := Band.Objects[i];
c.AfterPrint;
end
else break;
Report.CurObject := Band.Name;
Report.DoAfterPrint(Band);
Band.AfterPrint;
{ remove extra band objects if any }
if Band.FOriginalObjectsCount <> -1 then
begin
while Band.Objects.Count > Band.FOriginalObjectsCount do
TObject(Band.Objects[Band.Objects.Count - 1]).Free;
Band.FOriginalObjectsCount := -1;
end;
end;
procedure TfrxEngine.AddPage;
var
i: Integer;
SaveCurX: Extended;
SaveCurLine, SaveCurLineThrough: Integer;
Band: TfrxBand;
IsHeaderBand: Boolean;
begin
FPrevFooterHeight := 0;
PreviewPages.AddPage(FPage);
CurY := 0;
Band := FindBand(TfrxOverlay);
if (Band <> nil) and not TfrxOverlay(Band).PrintOnTop then
ShowBand(Band);
CurY := 0;
SaveCurX := CurX;
FFirstColumnY := 0;
for i := 0 to FHeaderList.Count - 1 do
begin
{ use own CurX - we may be inside subreports now }
CurX := FHeaderList[i].Left;
Band := FHeaderList[i].Band;
if Band = FStartNewPageBand then
continue;
if FIsFirstPage and (Band is TfrxPageHeader) and
not TfrxPageHeader(Band).PrintOnFirstPage then
begin
if Band.PrintChildIfInvisible then
Band := Band.Child
else
continue;
end;
IsHeaderBand := (Band is TfrxHeader);
if Band <> nil then
if not (FKeepHeader and IsHeaderBand) and not FHeaderList[i].IsInKeepList or FKeepFooter
{or (FKeeping and (FKeepBand.FHeader = Band))} then
begin
if (IsHeaderBand and FDontShowHeaders) or (IsHeaderBand and (FLastBandOnPage = Band)) or
((Band is TfrxGroupHeader) and FDontShowHeaders) then
continue;
Band.Overflow := True;
SaveCurLine := CurLine;
SaveCurLineThrough := CurLineThrough;
CurLine := Band.FLineN;
CurLineThrough := Band.FLineThrough;
FCallFromAddPage := True;
FCallFromPHeader := (Band is TfrxPageHeader);
{ fix the stack overflow error if call NewPage from ReportTitle }
if Band is TfrxReportTitle then
FHeaderList[i].Band := nil;
ShowBand(Band);
{ correct column y position }
if Band is TfrxPageHeader then
FFirstColumnY := Band.FStretchedHeight;
if (FIsFirstBand) and (Band is TfrxReportTitle) then
FTitlePrinted := True;
FCallFromPHeader := False;
FCallFromAddPage := False;
Band.Overflow := False;
CurLine := SaveCurLine;
CurLineThrough := SaveCurLineThrough;
end;
end;
CurX := SaveCurX;
end;
procedure TfrxEngine.EndPage;
var
Band: TfrxBand;
Offset: Extended;
procedure ShowBand(Band: TfrxBand);
begin
if Band = nil then Exit;
Stretch(Band);
try
if Band.Visible then
begin
Band.Left := 0;
Band.Top := CurY;
if Band is TfrxPageFooter then
if (FIsFirstPage and not TfrxPageFooter(Band).PrintOnFirstPage) or
(FIsLastPage and not TfrxPageFooter(Band).PrintOnLastPage and not FCallFromEndPage) then
Exit;
if not PreviewPages.BandExists(Band) then
PreviewPages.AddObject(Band);
CurY := CurY + Band.Height;
end;
finally
UnStretch(Band);
end;
FAggregates.Reset(Band);
end;
begin
if not FCallFromEndPage then
EndColumn;
if not FIsLastPage then
begin
CurX := FPageCurX;
CurColumn := 1;
end;
if FIsLastPage and not FCallFromEndPage then
begin
{ avoid stack overflow if reportsummary does not fit on the page }
FCallFromEndPage := True;
try
Offset := CurY;
Band := FindBand(TfrxReportSummary);
Self.ShowBand(Band);
if (Band <> nil) and (FPage.EndlessHeight) then
begin
Offset := CurY - Offset;
PageHeight := PageHeight + Offset;
TfrxPreviewPages(PreviewPages).UpdatePageDimensions(FPage, PageWidth + FPage.LeftMargin * fr01cm + FPage.RightMargin * fr01cm, PageHeight + FPage.TopMargin * fr01cm + FPage.BottomMargin * fr01cm);
end;
finally
FCallFromEndPage := False;
end;
end;
Band := FindBand(TfrxPageFooter);
if Band <> nil then
begin
CurY := PageHeight - Band.Height;
if FIsLastPage and TfrxPageFooter(Band).PrintOnLastPage and not FCallFromEndPage then
FPrevFooterHeight := Band.Height
else FPrevFooterHeight := 0;
end;
ShowBand(Band);
Band := FindBand(TfrxOverlay);
if (Band <> nil) and TfrxOverlay(Band).PrintOnTop then
begin
CurY := 0;
ShowBand(Band);
end;
FIsFirstPage := False;
end;
procedure TfrxEngine.AddColumn;
var
i: Integer;
AddX: Extended;
procedure DoShow(Band: TfrxBand);
begin
Band.Overflow := True;
Stretch(Band);
try
if Band.Visible then
begin
Band.Left := CurX;
Band.Top := CurY;
PreviewPages.AddObject(Band);
CurY := CurY + Band.Height;
end;
finally
UnStretch(Band);
Band.Overflow := False;
end;
end;
procedure ShowBand(Band: TfrxBand);
begin
while Band <> nil do
begin
DoShow(Band);
if Band.Visible or Band.PrintChildIfInvisible then
Band := Band.Child else
break;
end;
end;
begin
CurColumn := CurColumn + 1;
AddX := frxStrToFloat(FPage.ColumnPositions[CurColumn - 1]) * fr01cm;
CurY := FFirstColumnY;
for i := 0 to FHeaderList.Count - 1 do
begin
CurX := FHeaderList[i].Left + AddX;
if not (FHeaderList[i].Band is TfrxPageHeader) {and ((FHeaderList[i].Band is TfrxHeader)} and
(FLastBandOnPage <> FHeaderList[i].Band) and not FHeaderList[i].IsInKeepList and not FKeepHeader then
ShowBand(FHeaderList[i].Band);
end;
CurX := FPageCurX + AddX;
end;
procedure TfrxEngine.EndColumn;
var
Band: TfrxBand;
begin
Band := FindBand(TfrxColumnFooter);
if Band = nil then Exit;
Stretch(Band);
try
if Band.Visible then
begin
Band.Left := CurX - FPageCurX;
Band.Top := CurY;
PreviewPages.AddObject(Band);
{ move the current position }
CurY := CurY + Band.Height;
end;
finally
UnStretch(Band);
end;
FAggregates.Reset(Band);
end;
procedure TfrxEngine.NewPage;
var
CorrPage: TfrxReportPage;
RepeatedHeader: TfrxBand;
LastY: Extended;
begin
{ keep objects doesn't fit on whole page, so break keeping and leave the objets }
if (FKeepBand <> nil) and (CurY - FKeepCurY + FKeepBand.Height > PageHeight - FooterHeight) then
begin
FKeeping := False;
FAggregates.EndKeep;
end;
RepeatedHeader := nil;
if FKeeping then
begin
if FKeepFooter then
FAggregates.DeleteValue(FKeepBand);
PreviewPages.CutObjects(FKeepPosition);
LastY := PreviewPages.GetLastY;
if (ABS(LastY - CurY) >= 1e-4) and (FCurBand is TfrxDataband) then
RepeatedHeader := TfrxDataband(FCurBand).FHeader;
RemoveFromHeaderList(RepeatedHeader);
end;
FLastBandOnPage := FCurBand;
EndPage;
{ fix for report with several pages and EndlessHeight }
{ data dictionary doesn't using in this case }
if FPage.EndlessHeight then
with TfrxPreviewPages(PreviewPages) do
begin
CorrPage := Page[Count - 1];
CorrPage.PaperWidth := PageWidth / fr01cm + FPage.LeftMargin + FPage.RightMargin;
CorrPage.PaperHeight := (CurY + FooterHeight) / fr01cm + FPage.TopMargin + FPage.BottomMargin;
CorrPage.PaperSize := 256;
ModifyPage(Count - 1, CorrPage);
end;
AddPage;
FLastBandOnPage := nil;
if FKeeping then
begin
FAggregates.EndKeep;
PreviewPages.PasteObjects(0, CurY);
PreviewPages.Outline.ShiftItems(FKeepOutline, Round(CurY));
PreviewPages.ShiftAnchors(FKeepAnchor, Round(CurY));
// if (FKeepBand is TfrxDataBand) and (TfrxDataBand(FKeepBand).CurColumn = 1) then
// FSaveCurY := CurY;
CurY := PreviewPages.GetLastY;
if FKeepFooter then
FAggregates.AddValue(FKeepBand);
AddToHeaderList(RepeatedHeader);
end;
FKeeping := False;
FKeepHeader := False;
FKeepCurY := 0;
AddPageOutline;
end;
procedure TfrxEngine.NewColumn;
begin
if CurColumn >= FPage.Columns then
NewPage
else
begin
{ keeping for columns }
if FKeeping then
begin
if FKeepFooter then
FAggregates.DeleteValue(FKeepBand);
PreviewPages.CutObjects(FKeepPosition);
CurY := PreviewPages.GetLastY;
end;
FLastBandOnPage := FCurBand;
EndColumn;
AddColumn;
FLastBandOnPage := nil;
if FKeeping then
begin
FAggregates.EndKeep;
PreviewPages.PasteObjects(CurX, CurY);
PreviewPages.Outline.ShiftItems(FKeepOutline, Round(CurY));
PreviewPages.ShiftAnchors(FKeepAnchor, Round(CurY));
{ new version of GetLastY has one parameter by default = 0,}
{ it determinate column position for correct Y out result. }
{ if parameter = 0 ,then function return last position on the page, }
{ in other cases it return last Y position on X coordinate .}
CurY := PreviewPages.GetLastY(CurX);
if FKeepFooter then
FAggregates.AddValue(FKeepBand);
end;
FKeeping := False;
FKeepHeader := False;
end;
end;
procedure TfrxEngine.DrawSplit(Band: TfrxBand);
var
i, ObjCount: Integer;
List, SaveObjects, ShiftedList: TList;
View: TfrxView;
StrView: TfrxStretcheable;
CurHeight, Corr, SavedHeight: Extended;
ObjStretch, HasNextPart: Boolean;
{$IFNDEF MSWINDOWS}
bIDLE: Boolean;
{$ENDIF}
procedure ShiftObjects(TopView: TfrxView; Delta: Extended);
var
i: Integer;
View: TfrxView;
begin
for i := 0 to List.Count - 1 do
begin
View := List[i];
if (View <> TopView) and (ShiftedList.IndexOf(View) = -1) and
(View.Top >= TopView.Top + TopView.Height) and
// (View.Left < TopView.Left + TopView.Width) and
(TopView.Left + TopView.Width - View.Left > 1e-4) and // MB: 10212009
// (TopView.Left < View.Left + View.Width)
(View.Left + View.Width - TopView.Left > 1e-4) // MB: 10212009
then
begin
View.Top := View.Top + Delta;
ShiftedList.Add(View);
end;
end;
end;
procedure DrawPart;
var
i: Integer;
View: TfrxView;
begin
{ draw current objects }
Band.Left := CurX;
Band.Top := CurY;
PreviewPages.AddObject(Band);
{ add new column/page }
CurY := CurY + Band.Height;
FCurBand := Band;
if List.Count > 0 then NewColumn;
{ correct the top coordinate of remained objects }
Band.Objects.Clear;
for i := 0 to List.Count - 1 do
begin
View := List[i];
View.Top := View.Top - CurHeight;
{ restore the height of stretched objects }
if View is TfrxStretcheable then
begin
{ there is no splited objects, correct top positions }
if not ObjStretch and (List.Count = ObjCount) then
View.Top := TfrxStretcheable(View).FSavedTop;
if View.Top < 0 then
View.Top := 0;
View.Height := TfrxStretcheable(View).FSaveHeight;
end;
end;
end;
procedure CalcBandHeight;
var
i: Integer;
View: TfrxView;
begin
Band.Height := 0;
{ calculate the band's height }
for i := 0 to Band.Objects.Count - 1 do
begin
View := Band.Objects[i];
if View.Top + View.Height > Band.Height then
Band.Height := View.Top + View.Height;
end;
{ correct objects with StretchToMaxHeight or BandAlign = baBottom }
if List.Count = 0 then
for i := 0 to Band.Objects.Count - 1 do
begin
View := Band.Objects[i];
if View.Align = baBottom then
View.Top := Band.Height - View.Height
else if (View is TfrxStretcheable) and
(TfrxStretcheable(View).StretchMode = smMaxHeight) then
View.Height := Band.Height - View.Top;
end;
end;
begin
List := TList.Create;
SaveObjects := TList.Create;
ShiftedList := TList.Create;
ObjStretch := False;
{ initializing lists }
for i := 0 to Band.Objects.Count - 1 do
begin
View := Band.Objects[i];
if not (View is TfrxSubreport) then
List.Add(View);
SaveObjects.Add(View);
if View is TfrxStretcheable then
begin
TfrxStretcheable(View).InitPart;
TfrxStretcheable(View).FSaveHeight := View.Height;
end;
end;
Band.Objects.Clear;
ObjCount := List.Count;
CurHeight := FreeSpace;
while List.Count > 0 do
begin
ShiftedList.Clear;
i := 0;
if not Report.EngineOptions.EnableThreadSafe then
{$IFDEF MSWINDOWS}
Application.ProcessMessages;
{$ELSE}
Application.DoIdle(bIDLE);
{$ENDIF}
if Report.Terminated then Break;
while i < List.Count do
begin
View := List[i];
Corr := 0;
SavedHeight := View.Height;
HasNextPart := False;
{ call DrawPart above to proceess /page tag in rich object }
if View is TfrxStretcheable then
begin
{ Save object top for streched object }
StrView := List[i];
StrView.FSavedTop := StrView.Top;
StrView.Height := CurHeight - StrView.Top;
StrView.SetFastCanvas(TfrxFastCanvaslayer(FFastCanvas));
if StrView.Top < CurHeight then
{ trying to place it }
{ DrawPart method returns the amount of unused space. If view
can't fit in the height, this method returns the Height }
Corr := StrView.DrawPart;
StrView.SetFastCanvas(nil);
SavedHeight := StrView.FSaveHeight;
{ check: does object has new part of data independently from it size}
HasNextPart := StrView.HasNextDataPart;
end;
{ whole object fits in the page }
if (View.Top + SavedHeight <= CurHeight) and not HasNextPart then
begin
View.Height := SavedHeight;
{ add to band and remove from list }
Band.Objects.Add(View);
List.Remove(View);
continue;
end;
if View is TfrxStretcheable then
begin
StrView := List[i];
{ view is inside draw area }
if StrView.Top < CurHeight then
begin
ShiftObjects(StrView, Corr);
if Abs(Corr - StrView.Height) < 1e-4 then
begin
{ view can't fit, return back the height and correct the top }
StrView.Top := CurHeight;
{ shift the underlying objects down }
StrView.Height := StrView.FSaveHeight;
end
else
begin
{ view can draw something }
Band.Objects.Add(StrView);
{ decrease the remained height }
StrView.FSaveHeight := StrView.FSaveHeight - StrView.Height + Corr;
ObjStretch := True;
end;
end;
end
else
begin
{ non-stretcheable view can't be splitted, draw it in the next page }
if View.Height > PageHeight - FooterHeight then
begin
{ add to band and remove from list }
Band.Objects.Add(View);
List.Remove(View);
{ prepare last part of text }
continue;
end
else if View.Top < CurHeight then
begin
{ shift the underlying objects down }
ShiftObjects(View, CurHeight - View.Top);
View.Top := CurHeight;
end;
end;
Inc(i);
end;
{ draw the visible part }
CalcBandHeight;
DrawPart;
CurHeight := FreeSpace;
end;
{ get objects back to the band }
Band.Objects.Clear;
for i := 0 to SaveObjects.Count - 1 do
Band.Objects.Add(SaveObjects[i]);
List.Free;
SaveObjects.Free;
ShiftedList.Free;
end;
procedure TfrxEngine.CheckSuppress(Band: TfrxBand);
var
i: Integer;
c: TfrxComponent;
hasSuppress: Boolean;
begin
hasSuppress := False;
for i := 0 to Band.Objects.Count - 1 do
begin
c := Band.Objects[i];
if (c is TfrxCustomMemoView) and TfrxCustomMemoView(c).SuppressRepeated then
begin
hasSuppress := True;
TfrxCustomMemoView(c).ResetSuppress;
end;
end;
if hasSuppress and not Band.FHasVBands then
begin
UnStretch(Band);
CurLine := Band.FLineN;
CurLineThrough := Band.FLineThrough;
SecondScriptCall := True;
try
Stretch(Band);
finally
SecondScriptCall := False;
end;
end;
end;
procedure TfrxEngine.DoShow(Band: TfrxBand);
var
IsMultiColumnBand, IsSplit: Boolean;
TempBand: TfrxBand;
SaveCurX: Extended;
SavePageList: TList;
SaveVMasterBand: TfrxBand;
i: Integer;
procedure RenderVBand;
var
i, j, SavePageN: Integer;
SaveCurY: Extended;
c: TfrxComponent;
SaveObjects: TList;
begin
SaveObjects := TList.Create;
SavePageN := PreviewPages.CurPage;
SaveCurY := CurY;
{ the next NewPage call shouldn't form a new page }
PreviewPages.AddPageAction := apWriteOver;
{ save hband objects }
for i := 0 to FVMasterBand.Objects.Count - 1 do
SaveObjects.Add(FVMasterBand.Objects[i]);
for i := 0 to FVPageList.Count - 2 do
begin
FVMasterBand.Objects.Clear;
for j := Integer(FVPageList[i]) to Integer(FVPageList[i + 1]) - 1 do
begin
c := SaveObjects[j];
FVMasterBand.Objects.Add(c);
end;
PreviewPages.AddObject(FVMasterBand);
if i <> FVPageList.Count - 2 then
begin
FDontShowHeaders := True;
NewPage;
FDontShowHeaders := False;
end
else
EndPage;
end;
{ restore hband objects }
FVMasterBand.Objects.Clear;
for i := 0 to SaveObjects.Count - 1 do
FVMasterBand.Objects.Add(SaveObjects[i]);
SaveObjects.Free;
PreviewPages.CurPage := SavePageN;
CurY := SaveCurY;
CurX := SaveCurX;
{ the next NewPage call should form a new page }
PreviewPages.AddPageAction := apAdd;
end;
procedure AddVBand;
var
i: Integer;
c, c1: TfrxReportComponent;
begin
if Band is TfrxDataBand then
CurVColumn := CurVColumn + 1;
if (Band is TfrxFooter) or (Band is TfrxGroupFooter) then
FCurBand := Band
else
FCurBand := FVMasterBand;
{ fire beforeprint }
Report.CurObject := Band.Name;
Band.BeforePrint;
Report.DoBeforePrint(Band);
if Band.Visible then
begin
if CurX + Band.Width > PageWidth then
if FPage.EndlessWidth then
PageWidth := PageWidth + Band.Width
else
begin
{need for correct Page calculation when move VBand to the next page}
with PreviewPages do
begin
if Count - 1 <= CurPage then
AddPage(FPage)
else
CurPage := CurPage + 1;
end;
CurX := 0;
FVPageList.Add(Pointer(FVMasterBand.Objects.Count));
{ reprint headers }
for i := 0 to FVHeaderList.Count - 1 do
ShowBand(TfrxBand(FVHeaderList[i]));
end;
{ find objects that intersect with vertical Band }
for i := 0 to Band.Objects.Count - 1 do
begin
c := Band.Objects[i];
if THackComponent(c).FOriginalBand = FVMasterBand then
begin
{ fire beforeprint and getdata }
Report.CurObject := c.Name;
c.BeforePrint;
Report.DoBeforePrint(c);
c.GetData;
Report.DoNotifyEvent(c, c.OnAfterData);
{ copy the object }
c1 := TfrxReportComponent(c.NewInstance);
c1.Create(FVMasterBand);
c1.Assign(c);
with THackComponent(c1) do
begin
FAliasName := THackComponent(c).FAliasName;
FOriginalComponent := THackComponent(c).FOriginalComponent;
end;
c1.Left := c1.Left + CurX;
{ restore the object's state }
c.AfterPrint;
end;
end;
CurX := CurX + Band.Width;
end;
{ fire afterprint }
Report.CurObject := Band.Name;
Report.DoAfterPrint(Band);
Band.AfterPrint;
if Band is TfrxDataBand then
FAggregates.AddValue(FVMasterBand, CurVColumn);
{ reset aggregates }
if (Band is TfrxFooter) or (Band is TfrxGroupFooter) then
FAggregates.Reset(Band);
end;
begin
SavePageList := nil;
SaveVMasterBand := nil;
{ make cross-bands }
if Band.FHasVBands and not (Band is TfrxPageHeader) then
begin
SaveCurX := CurX;
{ fire onbeforeprint }
Report.CurObject := Band.Name;
Band.BeforePrint;
Report.DoBeforePrint(Band);
{ show vertical bands }
ShowVBands(Band);
CurX := 0;
{ restore Line variables}
CurLine := Band.FLineN;
CurLineThrough := Band.FLineThrough;
{ the next NewPage call should form a new page }
PreviewPages.AddPageAction := apAdd;
{ save global variables - FVPageList and FVMasterBand }
{ they may be changed in the NewPage call, if cross has a h-header }
{ with ReprintOnNewPage option }
SavePageList := TList.Create;
for i := 0 to FVPageList.Count - 1 do
SavePageList.Add(FVPageList[i]);
SaveVMasterBand := FVMasterBand;
end;
{ show one vertical band }
if Band.Vertical then
begin
AddVBand;
Exit;
end;
IsMultiColumnBand := (Band is TfrxDataBand) and (TfrxDataBand(Band).Columns > 1);
IsSplit := False;
{ check for StartNewPage flag }
if not FCallFromAddPage then
if Band.Visible then { don't process invisible bands }
if Band.StartNewPage then
if FOutputTo = nil then
if not (((Band is TfrxDataBand) or (Band is TfrxGroupHeader)) and (Band.FLineN = 1)) then
begin
FStartNewPageBand := Band;
if (Band is TfrxGroupHeader) and (TfrxGroupHeader(Band).ResetPageNumbers) then
PreviewPages.ResetLogicalPageNumber;
NewPage;
FStartNewPageBand := nil;
end;
Stretch(Band);
Band.FStretchedHeight := Band.Height;
try
if Band.Visible then
begin
{ if band has columns, print all columns in one page. Page feed will be
performed after the last column }
if not IsMultiColumnBand and not (Band is TfrxOverlay) and not (Band is TfrxNullBand) and
(Band.Height > FreeSpace) then
if FOutputTo = nil then
if (Band.AllowSplit and not FKeeping) or
((Band.Height > PageHeight - FooterHeight) and not band.FHasVBands) then
begin
if (not Band.AllowSplit) and (Band.FLineThrough > 1) and (not Band.StartNewPage) then
begin
FCurBand := Band;
NewColumn;
end;
if FKeeping then
EndKeep(Band);
DrawSplit(Band);
IsSplit := True;
end
else
begin
if not FKeeping then
CheckSuppress(Band);
if not((Band is TfrxChild) and FCallFromPHeader) then {endless loop fix}
NewColumn;
end;
if not IsSplit then
begin
if not (Band is TfrxNullBand) then
begin
{ multicolumn band manages its Left property itself }
if IsMultiColumnBand then
begin
Band.Left := Band.Left + CurX;
{if (TfrxDataBand(Band).CurColumn = 1) and (Band.Height > FreeSpace) then
begin
FCurBand := Band;
NewColumn;
// FSaveCurY := CurY;
end;}
end
else
Band.Left := CurX;
Band.Top := CurY;
end;
{ output the band }
if FOutputTo = nil then
begin
if (Band.FHasVBands) and not (Band is TfrxPageHeader) then
begin
{ restore global variables - FVPageList and FVMasterBand }
{ they may be changed in the NewPage call, if cross has a h-header }
{ with ReprintOnNewPage option }
FVPageList.Clear;
for i := 0 to SavePageList.Count - 1 do
FVPageList.Add(SavePageList[i]);
SavePageList.Free;
FVMasterBand := SaveVMasterBand;
Band.Left := 0;
RenderVBand;
end
else if (not FCallFromAddPage) or (not PreviewPages.BandExists(Band)) then
PreviewPages.AddObject(Band)
end
else
begin
TempBand := TfrxBand.Create(FOutputTo);
TempBand.AssignAll(Band, True);
end;
{ move the current position }
CurY := CurY + Band.Height;
end;
end;
finally
UnStretch(Band);
end;
{ reset aggregate values }
// if (Band is TfrxFooter) or (Band is TfrxGroupFooter) or
// (Band is TfrxPageFooter) or (Band is TfrxReportSummary) then
FAggregates.Reset(Band);
{ print subreports contained in this band }
if Band.Visible then
CheckSubReports(Band);
end;
procedure TfrxEngine.CheckSubReports(Band: TfrxBand);
var
i, SavePageN, SaveColumnN: Integer;
SaveCurX, SaveCurY, SavePageCurX: Extended;
HaveSub: Boolean;
Sub: TfrxSubreport;
MaxPageN, MaxColumnN: Integer;
MaxCurY: Extended;
begin
{ save the current position }
HaveSub := False;
SavePageN := PreviewPages.CurPage;
SaveColumnN := CurColumn;
SaveCurX := CurX;
SaveCurY := CurY;
SavePageCurX := FPageCurX;
{ init max position }
MaxPageN := SavePageN; //0
MaxColumnN := SaveColumnN; //0
MaxCurY := SaveCurY; //0
{ looking for subreport objects }
for i := 0 to Band.Objects.Count - 1 do
if TObject(Band.Objects[i]) is TfrxSubreport then
begin
Sub := TfrxSubreport(Band.Objects[i]);
if not Sub.Visible or Sub.PrintOnParent then continue;
HaveSub := True;
{ set up all properties... }
PreviewPages.CurPage := SavePageN;
FPageCurX := SavePageCurX + Sub.Left;
CurColumn := SaveColumnN;
CurX := SaveCurX + Sub.Left;
CurY := SaveCurY - Band.FStretchedHeight + Sub.Top; //SaveCurY - Sub.Height;
{ ...and run the subreport }
RunPage(Sub.Page);
{ calc max position }
if PreviewPages.CurPage > MaxPageN then
begin
MaxPageN := PreviewPages.CurPage;
MaxColumnN := CurColumn;
MaxCurY := CurY;
end
else if PreviewPages.CurPage = MaxPageN then
if CurColumn > MaxColumnN then
begin
MaxColumnN := CurColumn;
MaxCurY := CurY;
end
else if CurColumn = MaxColumnN then
if CurY > MaxCurY then
MaxCurY := CurY;
end;
{ move the current position to the last generated page }
if HaveSub then
begin
PreviewPages.CurPage := MaxPageN;
CurColumn := MaxColumnN;
CurX := SavePageCurX;
if CurColumn > 1 then
CurX := CurX + frxStrToFloat(FPage.ColumnPositions[CurColumn - 1]) * fr01cm;
CurY := MaxCurY;
FPageCurX := SavePageCurX;
end;
end;
procedure TfrxEngine.StartKeep(Band: TfrxBand; Position: Integer = 0);
begin
if FKeeping or FIsFirstBand then Exit;
FKeepCurY := CurY;
FKeeping := True;
FKeepBand := Band;
if Position = 0 then
Position := PreviewPages.GetCurPosition;
FKeepPosition := Position;
FKeepOutline := PreviewPages.Outline.GetCurPosition;
FKeepAnchor := PreviewPages.GetAnchorCurPosition;
FAggregates.StartKeep;
end;
procedure TfrxEngine.EndKeep(Band: TfrxBand);
begin
if FKeepBand = Band then
begin
FKeepCurY := 0;
FKeeping := False;
FKeepBand := nil;
FAggregates.EndKeep;
FKeepHeader := False;
end;
end;
function TfrxEngine.GetAggregateValue(const Name, Expression: String;
Band: TfrxBand; Flags: Integer): Variant;
begin
Result := FAggregates.GetValue(FCurBand, CurVColumn, Name, Expression, Band, Flags);
end;
procedure TfrxEngine.AddBandOutline(Band: TfrxBand);
var
pos: Integer;
begin
if Band.OutlineText <> '' then
begin
Report.CurObject := Band.Name;
if Band.Stretched then
pos := Round(CurY - Band.FStretchedHeight)
else
pos := Round(CurY - Band.Height);
if Band.Visible then
PreviewPages.Outline.AddItem(VarToStr(Report.Calc(Band.OutlineText)), pos);
end;
end;
procedure TfrxEngine.AddPageOutline;
begin
if FPage.OutlineText <> '' then
begin
OutlineRoot;
Report.CurObject := FPage.Name;
PreviewPages.Outline.AddItem(VarToStr(Report.Calc(FPage.OutlineText)), 0);
end;
end;
procedure TfrxEngine.OutlineRoot;
begin
PreviewPages.Outline.LevelRoot;
end;
procedure TfrxEngine.OutlineUp(Band: TfrxBand);
begin
if Band.OutlineText <> '' then
PreviewPages.Outline.LevelUp;
end;
function TfrxEngine.GetPageHeight: Double;
begin
if (FPage <> nil) and FPage.EndlessHeight then
Result := CurY + FooterHeight
else
Result := inherited GetPageHeight;
end;
end.
Reference in New Issue Copy Permalink