699 lines
17 KiB
ObjectPascal
699 lines
17 KiB
ObjectPascal
|
|
||
|
|
{******************************************}
|
||
|
|
{ }
|
||
|
|
{ FastReport v4.0 }
|
||
|
|
{ Aggregate Functions }
|
||
|
|
{ }
|
||
|
|
{ Copyright (c) 1998-2008 }
|
||
|
|
{ by Alexander Tzyganenko, }
|
||
|
|
{ Fast Reports Inc. }
|
||
|
|
{ }
|
||
|
|
{******************************************}
|
||
|
|
|
||
|
|
unit FMX.frxAggregate;
|
||
|
|
|
||
|
|
interface
|
||
|
|
|
||
|
|
{$I fmx.inc}
|
||
|
|
{$I frx.inc}
|
||
|
|
|
||
|
|
uses
|
||
|
|
System.SysUtils, System.Classes, FMX.frxClass, System.Variants;
|
||
|
|
|
||
|
|
|
||
|
|
type
|
||
|
|
TfrxAggregateFunction = (agSum, agAvg, agMin, agMax, agCount);
|
||
|
|
|
||
|
|
TfrxAggregateItem = class(TObject)
|
||
|
|
private
|
||
|
|
FAggregateFunction: TfrxAggregateFunction;
|
||
|
|
FBand: TfrxDataBand;
|
||
|
|
FCountInvisibleBands: Boolean;
|
||
|
|
FDontReset: Boolean;
|
||
|
|
FExpression: String;
|
||
|
|
FIsPageFooter: Boolean;
|
||
|
|
FItemsArray: Variant; { used for vbands }
|
||
|
|
FItemsCount: Integer;
|
||
|
|
FItemsCountArray: Variant; { used for vbands }
|
||
|
|
FItemsValue: Variant;
|
||
|
|
FKeeping: Boolean;
|
||
|
|
FLastCount: Integer;
|
||
|
|
FLastValue: Variant;
|
||
|
|
FMemoName: String;
|
||
|
|
FOriginalName: String;
|
||
|
|
FParentBand: TfrxBand;
|
||
|
|
FReport: TfrxReport;
|
||
|
|
FTempItemsCount: Integer;
|
||
|
|
FTempItemsValue: Variant;
|
||
|
|
FVColumn: Integer; { used for vbands }
|
||
|
|
public
|
||
|
|
procedure Calc;
|
||
|
|
procedure DeleteValue;
|
||
|
|
procedure Reset;
|
||
|
|
procedure StartKeep;
|
||
|
|
procedure EndKeep;
|
||
|
|
function Value: Variant;
|
||
|
|
end;
|
||
|
|
|
||
|
|
TfrxAggregateList = class(TObject)
|
||
|
|
private
|
||
|
|
FList: TList;
|
||
|
|
FReport: TfrxReport;
|
||
|
|
function GetItem(Index: Integer): TfrxAggregateItem;
|
||
|
|
procedure FindAggregates(Memo: TfrxCustomMemoView; DataBand: TfrxDataBand);
|
||
|
|
procedure ParseName(const ComplexName: String; var Func: TfrxAggregateFunction;
|
||
|
|
var Expr: String; var Band: TfrxDataBand; var CountInvisible, DontReset: Boolean);
|
||
|
|
property Items[Index: Integer]: TfrxAggregateItem read GetItem; default;
|
||
|
|
public
|
||
|
|
constructor Create(AReport: TfrxReport);
|
||
|
|
destructor Destroy; override;
|
||
|
|
procedure Clear;
|
||
|
|
procedure ClearValues;
|
||
|
|
|
||
|
|
procedure AddItems(Page: TfrxReportPage);
|
||
|
|
procedure AddValue(Band: TfrxBand; VColumn: Integer = 0);
|
||
|
|
procedure DeleteValue(Band: TfrxBand);
|
||
|
|
procedure EndKeep;
|
||
|
|
procedure Reset(ParentBand: TfrxBand);
|
||
|
|
procedure StartKeep;
|
||
|
|
function GetValue(ParentBand: TfrxBand; const ComplexName: String;
|
||
|
|
VColumn: Integer = 0): Variant; overload;
|
||
|
|
function GetValue(ParentBand: TfrxBand; VColumn: Integer;
|
||
|
|
const Name, Expression: String; Band: TfrxBand; Flags: Integer): Variant; overload;
|
||
|
|
end;
|
||
|
|
|
||
|
|
|
||
|
|
implementation
|
||
|
|
|
||
|
|
uses
|
||
|
|
FMX.frxVariables, FMX.frxUtils, FMX.frxFMX;
|
||
|
|
|
||
|
|
|
||
|
|
type
|
||
|
|
THackComponent = class(TfrxComponent);
|
||
|
|
|
||
|
|
procedure Get3Params(const s: String; var i: Integer;
|
||
|
|
var s1, s2, s3: String);
|
||
|
|
var
|
||
|
|
c, d, e, oi, ci: Integer;
|
||
|
|
begin
|
||
|
|
s1 := ''; s2 := ''; s3 := '';
|
||
|
|
c := 1; d := 1; e := 1; oi := i + 1; ci := 1;
|
||
|
|
repeat
|
||
|
|
Inc(i);
|
||
|
|
if s[i] = '''' then
|
||
|
|
if (d = 1) and (e = 1) then Inc(d) else d := 1;
|
||
|
|
if (d = 1) and (s[i] = '"') then
|
||
|
|
if e = 1 then Inc(e) else e := 1;
|
||
|
|
if (d = 1) and (e = 1) then
|
||
|
|
begin
|
||
|
|
if s[i] = '(' then
|
||
|
|
Inc(c) else
|
||
|
|
if s[i] = ')' then Dec(c);
|
||
|
|
if (s[i] = ',') and (c = 1) then
|
||
|
|
begin
|
||
|
|
if ci = 1 then
|
||
|
|
s1 := Copy(s, oi, i - oi) else
|
||
|
|
s2 := Copy(s, oi, i - oi);
|
||
|
|
oi := i + 1; Inc(ci);
|
||
|
|
end;
|
||
|
|
end;
|
||
|
|
until (c = 0) or (i >= Length(s));
|
||
|
|
case ci of
|
||
|
|
1: s1 := Copy(s, oi, i - oi);
|
||
|
|
2: s2 := Copy(s, oi, i - oi);
|
||
|
|
3: s3 := Copy(s, oi, i - oi);
|
||
|
|
end;
|
||
|
|
Inc(i);
|
||
|
|
end;
|
||
|
|
|
||
|
|
|
||
|
|
{ TfrxAggregateItem }
|
||
|
|
|
||
|
|
procedure TfrxAggregateItem.Calc;
|
||
|
|
var
|
||
|
|
Value: Variant;
|
||
|
|
i: Integer;
|
||
|
|
begin
|
||
|
|
if not FBand.Visible and not FCountInvisibleBands then Exit;
|
||
|
|
|
||
|
|
FReport.CurObject := FMemoName;
|
||
|
|
if FAggregateFunction <> agCount then
|
||
|
|
Value := FReport.Calc(FExpression) else
|
||
|
|
Value := Null;
|
||
|
|
|
||
|
|
if VarType(Value) = varBoolean then
|
||
|
|
if Value = True then
|
||
|
|
Value := 1;
|
||
|
|
|
||
|
|
{ process vbands }
|
||
|
|
if FVColumn > 0 then
|
||
|
|
begin
|
||
|
|
if VarIsNull(FItemsArray) then
|
||
|
|
begin
|
||
|
|
FItemsArray := VarArrayCreate([0, 1000], varVariant);
|
||
|
|
FItemsCountArray := VarArrayCreate([0, 1000], varVariant);
|
||
|
|
for i := 0 to 1000 do
|
||
|
|
begin
|
||
|
|
FItemsArray[i] := Null;
|
||
|
|
FItemsCountArray[i] := 0;
|
||
|
|
end;
|
||
|
|
end;
|
||
|
|
|
||
|
|
if (FAggregateFunction <> agAvg) or (Value <> Null) then
|
||
|
|
FItemsCountArray[FVColumn] := FItemsCountArray[FVColumn] + 1;
|
||
|
|
if FItemsArray[FVColumn] = Null then
|
||
|
|
FItemsArray[FVColumn] := Value
|
||
|
|
else if Value <> Null then
|
||
|
|
case FAggregateFunction of
|
||
|
|
agSum, agAvg:
|
||
|
|
FItemsArray[FVColumn] := FItemsArray[FVColumn] + Value;
|
||
|
|
agMin:
|
||
|
|
if Value < FItemsArray[FVColumn] then
|
||
|
|
FItemsArray[FVColumn] := Value;
|
||
|
|
agMax:
|
||
|
|
if Value > FItemsArray[FVColumn] then
|
||
|
|
FItemsArray[FVColumn] := Value;
|
||
|
|
end;
|
||
|
|
end
|
||
|
|
else if FKeeping then
|
||
|
|
begin
|
||
|
|
if (FAggregateFunction <> agAvg) or (Value <> Null) then
|
||
|
|
Inc(FTempItemsCount);
|
||
|
|
if FTempItemsValue = Null then
|
||
|
|
FTempItemsValue := Value
|
||
|
|
else if Value <> Null then
|
||
|
|
case FAggregateFunction of
|
||
|
|
agSum, agAvg:
|
||
|
|
FTempItemsValue := FTempItemsValue + Value;
|
||
|
|
agMin:
|
||
|
|
if Value < FTempItemsValue then
|
||
|
|
FTempItemsValue := Value;
|
||
|
|
agMax:
|
||
|
|
if Value > FTempItemsValue then
|
||
|
|
FTempItemsValue := Value;
|
||
|
|
end;
|
||
|
|
end
|
||
|
|
else
|
||
|
|
begin
|
||
|
|
FLastCount := FItemsCount;
|
||
|
|
FLastValue := FItemsValue;
|
||
|
|
if (FAggregateFunction <> agAvg) or (Value <> Null) then
|
||
|
|
Inc(FItemsCount);
|
||
|
|
if FItemsValue = Null then
|
||
|
|
FItemsValue := Value
|
||
|
|
else if Value <> Null then
|
||
|
|
case FAggregateFunction of
|
||
|
|
agSum, agAvg:
|
||
|
|
FItemsValue := FItemsValue + Value;
|
||
|
|
agMin:
|
||
|
|
if Value < FItemsValue then
|
||
|
|
FItemsValue := Value;
|
||
|
|
agMax:
|
||
|
|
if Value > FItemsValue then
|
||
|
|
FItemsValue := Value;
|
||
|
|
end;
|
||
|
|
end;
|
||
|
|
end;
|
||
|
|
|
||
|
|
procedure TfrxAggregateItem.DeleteValue;
|
||
|
|
begin
|
||
|
|
FItemsCount := FLastCount;
|
||
|
|
FItemsValue := FLastValue;
|
||
|
|
end;
|
||
|
|
|
||
|
|
procedure TfrxAggregateItem.Reset;
|
||
|
|
begin
|
||
|
|
if FDontReset and (FItemsCount <> 0) then Exit;
|
||
|
|
|
||
|
|
FItemsCount := 0;
|
||
|
|
FItemsValue := Null;
|
||
|
|
FItemsArray := Null;
|
||
|
|
FItemsCountArray := Null;
|
||
|
|
end;
|
||
|
|
|
||
|
|
procedure TfrxAggregateItem.StartKeep;
|
||
|
|
begin
|
||
|
|
if not FIsPageFooter or FKeeping then Exit;
|
||
|
|
FKeeping := True;
|
||
|
|
|
||
|
|
FTempItemsCount := 0;
|
||
|
|
FTempItemsValue := Null;
|
||
|
|
end;
|
||
|
|
|
||
|
|
procedure TfrxAggregateItem.EndKeep;
|
||
|
|
begin
|
||
|
|
if not FIsPageFooter or not FKeeping then Exit;
|
||
|
|
FKeeping := False;
|
||
|
|
|
||
|
|
FItemsCount := FItemsCount + FTempItemsCount;
|
||
|
|
if FItemsValue = Null then
|
||
|
|
FItemsValue := FTempItemsValue
|
||
|
|
else if FTempItemsValue <> Null then
|
||
|
|
case FAggregateFunction of
|
||
|
|
agMin:
|
||
|
|
if FTempItemsValue < FItemsValue then
|
||
|
|
FItemsValue := FTempItemsValue;
|
||
|
|
agMax:
|
||
|
|
if FTempItemsValue > FItemsValue then
|
||
|
|
FItemsValue := FTempItemsValue;
|
||
|
|
else
|
||
|
|
FItemsValue := FItemsValue + FTempItemsValue;
|
||
|
|
end;
|
||
|
|
end;
|
||
|
|
|
||
|
|
function TfrxAggregateItem.Value: Variant;
|
||
|
|
begin
|
||
|
|
Result := Null;
|
||
|
|
if not VarIsNull(FItemsArray) then
|
||
|
|
begin
|
||
|
|
case FAggregateFunction of
|
||
|
|
agSum, agMin, agMax:
|
||
|
|
Result := FItemsArray[FVColumn];
|
||
|
|
agAvg:
|
||
|
|
Result := FItemsArray[FVColumn] / FItemsCountArray[FVColumn];
|
||
|
|
agCount:
|
||
|
|
Result := FItemsCountArray[FVColumn];
|
||
|
|
end
|
||
|
|
end
|
||
|
|
else
|
||
|
|
case FAggregateFunction of
|
||
|
|
agSum, agMin, agMax:
|
||
|
|
Result := FItemsValue;
|
||
|
|
agAvg:
|
||
|
|
Result := FItemsValue / FItemsCount;
|
||
|
|
agCount:
|
||
|
|
Result := FItemsCount;
|
||
|
|
end;
|
||
|
|
|
||
|
|
if VarIsNull(Result) then
|
||
|
|
Result := 0;
|
||
|
|
end;
|
||
|
|
|
||
|
|
|
||
|
|
{ TfrxAggregateList }
|
||
|
|
|
||
|
|
constructor TfrxAggregateList.Create(AReport: TfrxReport);
|
||
|
|
begin
|
||
|
|
FList := TList.Create;
|
||
|
|
FReport := AReport;
|
||
|
|
end;
|
||
|
|
|
||
|
|
destructor TfrxAggregateList.Destroy;
|
||
|
|
begin
|
||
|
|
Clear;
|
||
|
|
FList.Free;
|
||
|
|
inherited;
|
||
|
|
end;
|
||
|
|
|
||
|
|
procedure TfrxAggregateList.Clear;
|
||
|
|
begin
|
||
|
|
while FList.Count > 0 do
|
||
|
|
begin
|
||
|
|
TObject(FList[0]).Free;
|
||
|
|
FList.Delete(0);
|
||
|
|
end;
|
||
|
|
end;
|
||
|
|
|
||
|
|
function TfrxAggregateList.GetItem(Index: Integer): TfrxAggregateItem;
|
||
|
|
begin
|
||
|
|
Result := FList[Index];
|
||
|
|
end;
|
||
|
|
|
||
|
|
procedure TfrxAggregateList.ParseName(const ComplexName: String;
|
||
|
|
var Func: TfrxAggregateFunction; var Expr: String; var Band: TfrxDataBand;
|
||
|
|
var CountInvisible, DontReset: Boolean);
|
||
|
|
var
|
||
|
|
i: Integer;
|
||
|
|
Name, Param1, Param2, Param3: String;
|
||
|
|
begin
|
||
|
|
i := Pos('(', ComplexName);
|
||
|
|
Name := UpperCase(Trim(Copy(ComplexName, 1, i - 1)));
|
||
|
|
Get3Params(ComplexName, i, Param1, Param2, Param3);
|
||
|
|
Param1 := Trim(Param1);
|
||
|
|
Param2 := Trim(Param2);
|
||
|
|
Param3 := Trim(Param3);
|
||
|
|
|
||
|
|
if Name = 'SUM' then
|
||
|
|
Func := agSum
|
||
|
|
else if Name = 'MIN' then
|
||
|
|
Func := agMin
|
||
|
|
else if Name = 'MAX' then
|
||
|
|
Func := agMax
|
||
|
|
else if Name = 'AVG' then
|
||
|
|
Func := agAvg
|
||
|
|
else //if Name = 'COUNT' then
|
||
|
|
Func := agCount;
|
||
|
|
|
||
|
|
if Name <> 'COUNT' then
|
||
|
|
begin
|
||
|
|
Expr := Param1;
|
||
|
|
if Param2 <> '' then
|
||
|
|
Band := TfrxDataBand(FReport.FindObject(Param2)) else
|
||
|
|
Band := nil;
|
||
|
|
if Param3 <> '' then
|
||
|
|
i := StrToInt(Param3) else
|
||
|
|
i := 0;
|
||
|
|
end
|
||
|
|
else
|
||
|
|
begin
|
||
|
|
Expr := '';
|
||
|
|
Band := TfrxDataBand(FReport.FindObject(Param1));
|
||
|
|
if Param2 <> '' then
|
||
|
|
i := StrToInt(Param2) else
|
||
|
|
i := 0;
|
||
|
|
end;
|
||
|
|
|
||
|
|
CountInvisible := (i and 1) <> 0;
|
||
|
|
DontReset := (i and 2) <> 0;
|
||
|
|
end;
|
||
|
|
|
||
|
|
procedure TfrxAggregateList.FindAggregates(Memo: TfrxCustomMemoView;
|
||
|
|
DataBand: TfrxDataBand);
|
||
|
|
const
|
||
|
|
Spaces = [#1..#32, '!', '#', '$', '%', '^', '&', '|', '+', '-', '*', '/',
|
||
|
|
'=', '.', ',', '[', ']', '0'..'9'];
|
||
|
|
IdentSpaces = Spaces - ['0'..'9'] + ['('];
|
||
|
|
var
|
||
|
|
i, j: Integer;
|
||
|
|
s, s1, dc1, dc2: String;
|
||
|
|
Report: TfrxReport;
|
||
|
|
|
||
|
|
procedure FindIn(const s: String); forward;
|
||
|
|
|
||
|
|
procedure SkipString(const s: String; var i: Integer);
|
||
|
|
var
|
||
|
|
ch: Char;
|
||
|
|
begin
|
||
|
|
ch := s[i];
|
||
|
|
Inc(i);
|
||
|
|
while (i <= Length(s)) and (s[i] <> ch) do
|
||
|
|
Inc(i);
|
||
|
|
Inc(i);
|
||
|
|
end;
|
||
|
|
|
||
|
|
function Check(s: String): Boolean;
|
||
|
|
var
|
||
|
|
i: Integer;
|
||
|
|
ds: TfrxDataSet;
|
||
|
|
s1: String;
|
||
|
|
VarVal: Variant;
|
||
|
|
begin
|
||
|
|
Result := False;
|
||
|
|
if s = '' then Exit;
|
||
|
|
|
||
|
|
{ searching in the variables }
|
||
|
|
i := Report.Variables.IndexOf(s);
|
||
|
|
if i <> -1 then
|
||
|
|
begin
|
||
|
|
VarVal := Report.Variables.Items[i].Value;
|
||
|
|
if VarIsNull(VarVal) then
|
||
|
|
s := ''
|
||
|
|
else
|
||
|
|
s := VarVal;
|
||
|
|
FindIn(s);
|
||
|
|
Result := True;
|
||
|
|
Exit;
|
||
|
|
end;
|
||
|
|
|
||
|
|
{ maybe it's a dataset/field? }
|
||
|
|
Report.GetDataSetAndField(s, ds, s1);
|
||
|
|
if (ds <> nil) and (s1 <> '') then
|
||
|
|
Result := True;
|
||
|
|
end;
|
||
|
|
|
||
|
|
procedure AddAggregate(const ComplexName: String);
|
||
|
|
var
|
||
|
|
Item: TfrxAggregateItem;
|
||
|
|
begin
|
||
|
|
Item := TfrxAggregateItem.Create;
|
||
|
|
FList.Add(Item);
|
||
|
|
|
||
|
|
ParseName(ComplexName, Item.FAggregateFunction, Item.FExpression,
|
||
|
|
Item.FBand, Item.FCountInvisibleBands, Item.FDontReset);
|
||
|
|
if Item.FBand = nil then
|
||
|
|
Item.FBand := DataBand;
|
||
|
|
|
||
|
|
Item.FReport := FReport;
|
||
|
|
Item.FParentBand := TfrxBand(Memo.Parent);
|
||
|
|
if Item.FParentBand.Vertical and (THackComponent(Memo).FOriginalBand <> nil) and
|
||
|
|
(TfrxBand(THackComponent(Memo).FOriginalBand).BandNumber in [1, 3, 5, 13]) then
|
||
|
|
Item.FParentBand := TfrxBand(THackComponent(Memo).FOriginalBand);
|
||
|
|
Item.FIsPageFooter := Item.FParentBand is TfrxPageFooter;
|
||
|
|
Item.FOriginalName := Trim(ComplexName);
|
||
|
|
Item.FMemoName := Memo.Name;
|
||
|
|
Item.Reset;
|
||
|
|
end;
|
||
|
|
|
||
|
|
procedure FindIn(const s: String);
|
||
|
|
var
|
||
|
|
i, j: Integer;
|
||
|
|
s1, s2, s3, s4: String;
|
||
|
|
begin
|
||
|
|
if Check(s) then
|
||
|
|
Exit;
|
||
|
|
|
||
|
|
{ this is an expression }
|
||
|
|
i := 1;
|
||
|
|
while i <= Length(s) do
|
||
|
|
begin
|
||
|
|
{ skip non-significant chars }
|
||
|
|
while (i <= Length(s)) and (CharInSet(s[i], Spaces)) do
|
||
|
|
Inc(i);
|
||
|
|
|
||
|
|
case s[i] of
|
||
|
|
'<':
|
||
|
|
begin
|
||
|
|
FindIn(frxGetBrackedVariableW(s, '<', '>', i, j));
|
||
|
|
i := j;
|
||
|
|
end;
|
||
|
|
|
||
|
|
'''', '"':
|
||
|
|
SkipString(s, i);
|
||
|
|
|
||
|
|
'(':
|
||
|
|
begin
|
||
|
|
FindIn(frxGetBrackedVariableW(s, '(', ')', i, j));
|
||
|
|
if i = j then
|
||
|
|
Inc(i) else
|
||
|
|
i := j;
|
||
|
|
end;
|
||
|
|
else
|
||
|
|
begin
|
||
|
|
j := i;
|
||
|
|
while (i <= Length(s)) and not (CharInSet(s[i], IdentSpaces)) do
|
||
|
|
Inc(i);
|
||
|
|
s1 := UpperCase(Copy(s, j, i - j));
|
||
|
|
|
||
|
|
if (s1 = 'SUM') or (s1 = 'MIN') or (s1 = 'MAX') or
|
||
|
|
(s1 = 'AVG') or (s1 = 'COUNT') then
|
||
|
|
begin
|
||
|
|
if (i < Length(s)) and (s[i] = '(') then
|
||
|
|
begin
|
||
|
|
Get3Params(s, i, s2, s3, s4);
|
||
|
|
AddAggregate(Copy(s, j, i - j));
|
||
|
|
end;
|
||
|
|
end
|
||
|
|
else
|
||
|
|
Check(s1);
|
||
|
|
end;
|
||
|
|
end;
|
||
|
|
end;
|
||
|
|
end;
|
||
|
|
|
||
|
|
begin
|
||
|
|
Report := Memo.Report;
|
||
|
|
if Memo.AllowExpressions then
|
||
|
|
begin
|
||
|
|
s := Memo.Text;
|
||
|
|
i := 1;
|
||
|
|
dc1 := Memo.ExpressionDelimiters;
|
||
|
|
dc2 := Copy(dc1, Pos(',', dc1) + 1, 255);
|
||
|
|
dc1 := Copy(dc1, 1, Pos(',', dc1) - 1);
|
||
|
|
|
||
|
|
repeat
|
||
|
|
while (i < Length(s)) and (Copy(s, i, Length(dc1)) <> dc1) do Inc(i);
|
||
|
|
s1 := frxGetBrackedVariableW(s, dc1, dc2, i, j);
|
||
|
|
if i <> j then
|
||
|
|
begin
|
||
|
|
FindIn(s1);
|
||
|
|
i := j;
|
||
|
|
j := 0;
|
||
|
|
end;
|
||
|
|
until i = j;
|
||
|
|
end;
|
||
|
|
end;
|
||
|
|
|
||
|
|
procedure TfrxAggregateList.AddItems(Page: TfrxReportPage);
|
||
|
|
|
||
|
|
procedure EnumObjects(ParentBand: TfrxBand; DataBand: TfrxDataBand);
|
||
|
|
var
|
||
|
|
i: Integer;
|
||
|
|
c: TfrxComponent;
|
||
|
|
begin
|
||
|
|
if ParentBand = nil then Exit;
|
||
|
|
|
||
|
|
for i := 0 to ParentBand.Objects.Count - 1 do
|
||
|
|
begin
|
||
|
|
c := ParentBand.Objects[i];
|
||
|
|
if c is TfrxCustomMemoView then
|
||
|
|
FindAggregates(TfrxCustomMemoView(c), DataBand);
|
||
|
|
end;
|
||
|
|
|
||
|
|
if ParentBand.Child <> nil then
|
||
|
|
EnumObjects(ParentBand.Child, DataBand);
|
||
|
|
end;
|
||
|
|
|
||
|
|
procedure EnumGroups(GroupHeader: TfrxGroupHeader; DataBand: TfrxDataBand);
|
||
|
|
var
|
||
|
|
i: Integer;
|
||
|
|
g: TfrxGroupHeader;
|
||
|
|
begin
|
||
|
|
if GroupHeader = nil then Exit;
|
||
|
|
|
||
|
|
for i := 0 to GroupHeader.FSubBands.Count - 1 do
|
||
|
|
begin
|
||
|
|
g := GroupHeader.FSubBands[i];
|
||
|
|
EnumObjects(g.FFooter, DataBand);
|
||
|
|
end;
|
||
|
|
end;
|
||
|
|
|
||
|
|
procedure EnumDataBands(List: TList);
|
||
|
|
var
|
||
|
|
i: Integer;
|
||
|
|
d: TfrxDataBand;
|
||
|
|
begin
|
||
|
|
for i := 0 to List.Count - 1 do
|
||
|
|
begin
|
||
|
|
d := List[i];
|
||
|
|
EnumObjects(d.FFooter, d);
|
||
|
|
EnumGroups(TfrxGroupHeader(d.FGroup), d);
|
||
|
|
EnumDataBands(d.FSubBands);
|
||
|
|
if d.Vertical then
|
||
|
|
EnumObjects(d, d);
|
||
|
|
end;
|
||
|
|
end;
|
||
|
|
|
||
|
|
begin
|
||
|
|
EnumDataBands(Page.FSubBands);
|
||
|
|
EnumDataBands(Page.FVSubBands);
|
||
|
|
if Page.FSubBands.Count > 0 then
|
||
|
|
begin
|
||
|
|
EnumObjects(Page.FindBand(TfrxPageFooter), Page.FSubBands[0]);
|
||
|
|
EnumObjects(Page.FindBand(TfrxColumnFooter), Page.FSubBands[0]);
|
||
|
|
EnumObjects(Page.FindBand(TfrxReportSummary), Page.FSubBands[0]);
|
||
|
|
end;
|
||
|
|
end;
|
||
|
|
|
||
|
|
procedure TfrxAggregateList.AddValue(Band: TfrxBand; VColumn: Integer = 0);
|
||
|
|
var
|
||
|
|
i: Integer;
|
||
|
|
begin
|
||
|
|
for i := 0 to FList.Count - 1 do
|
||
|
|
if Items[i].FBand = Band then
|
||
|
|
begin
|
||
|
|
Items[i].FVColumn := VColumn;
|
||
|
|
Items[i].Calc;
|
||
|
|
end;
|
||
|
|
end;
|
||
|
|
|
||
|
|
procedure TfrxAggregateList.DeleteValue(Band: TfrxBand);
|
||
|
|
var
|
||
|
|
i: Integer;
|
||
|
|
begin
|
||
|
|
for i := 0 to FList.Count - 1 do
|
||
|
|
if Items[i].FBand = Band then
|
||
|
|
Items[i].DeleteValue;
|
||
|
|
end;
|
||
|
|
|
||
|
|
function TfrxAggregateList.GetValue(ParentBand: TfrxBand;
|
||
|
|
const ComplexName: String; VColumn: Integer = 0): Variant;
|
||
|
|
var
|
||
|
|
i: Integer;
|
||
|
|
begin
|
||
|
|
Result := Null;
|
||
|
|
|
||
|
|
for i := 0 to FList.Count - 1 do
|
||
|
|
if (Items[i].FParentBand = ParentBand) and
|
||
|
|
(frxCompareText(Items[i].FOriginalName, Trim(ComplexName)) = 0) then
|
||
|
|
begin
|
||
|
|
Items[i].FVColumn := VColumn;
|
||
|
|
Result := Items[i].Value;
|
||
|
|
break;
|
||
|
|
end;
|
||
|
|
end;
|
||
|
|
|
||
|
|
function TfrxAggregateList.GetValue(ParentBand: TfrxBand; VColumn: Integer;
|
||
|
|
const Name, Expression: String; Band: TfrxBand; Flags: Integer): Variant;
|
||
|
|
var
|
||
|
|
i: Integer;
|
||
|
|
fn: TfrxAggregateFunction;
|
||
|
|
begin
|
||
|
|
Result := Null;
|
||
|
|
if Name = 'SUM' then
|
||
|
|
fn := agSum
|
||
|
|
else if Name = 'AVG' then
|
||
|
|
fn := agAvg
|
||
|
|
else if Name = 'MIN' then
|
||
|
|
fn := agMin
|
||
|
|
else if Name = 'MAX' then
|
||
|
|
fn := agMax
|
||
|
|
else
|
||
|
|
fn := agCount;
|
||
|
|
|
||
|
|
for i := 0 to FList.Count - 1 do
|
||
|
|
if (Items[i].FParentBand = ParentBand) and
|
||
|
|
(Items[i].FAggregateFunction = fn) and
|
||
|
|
(frxCompareText(Items[i].FExpression, Trim(Expression)) = 0) and
|
||
|
|
((Band = nil) or (Items[i].FBand = Band)) and
|
||
|
|
(Items[i].FCountInvisibleBands = ((Flags and 1) <> 0)) and
|
||
|
|
(Items[i].FDontReset = ((Flags and 2) <> 0)) then
|
||
|
|
begin
|
||
|
|
Items[i].FVColumn := VColumn;
|
||
|
|
Result := Items[i].Value;
|
||
|
|
break;
|
||
|
|
end;
|
||
|
|
end;
|
||
|
|
|
||
|
|
procedure TfrxAggregateList.Reset(ParentBand: TfrxBand);
|
||
|
|
var
|
||
|
|
i: Integer;
|
||
|
|
begin
|
||
|
|
for i := 0 to FList.Count - 1 do
|
||
|
|
if Items[i].FParentBand = ParentBand then
|
||
|
|
Items[i].Reset;
|
||
|
|
end;
|
||
|
|
|
||
|
|
procedure TfrxAggregateList.StartKeep;
|
||
|
|
var
|
||
|
|
i: Integer;
|
||
|
|
begin
|
||
|
|
for i := 0 to FList.Count - 1 do
|
||
|
|
Items[i].StartKeep;
|
||
|
|
end;
|
||
|
|
|
||
|
|
procedure TfrxAggregateList.EndKeep;
|
||
|
|
var
|
||
|
|
i: Integer;
|
||
|
|
begin
|
||
|
|
for i := 0 to FList.Count - 1 do
|
||
|
|
Items[i].EndKeep;
|
||
|
|
end;
|
||
|
|
|
||
|
|
procedure TfrxAggregateList.ClearValues;
|
||
|
|
var
|
||
|
|
i: Integer;
|
||
|
|
SaveReset: Boolean;
|
||
|
|
begin
|
||
|
|
for i := 0 to FList.Count - 1 do
|
||
|
|
begin
|
||
|
|
SaveReset := Items[i].FDontReset;
|
||
|
|
Items[i].FDontReset := False;
|
||
|
|
Items[i].Reset;
|
||
|
|
Items[i].FDontReset := SaveReset;
|
||
|
|
end;
|
||
|
|
end;
|
||
|
|
|
||
|
|
end.
|
||
|
|
|