frxaggregate.pas

报表源码 FastReport 3 is new generation of the report generators components. It consists of report engin

  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 (s[i] in Spaces) do
        Inc(i);

      case s[i] of
        '<':
          begin
            FindIn(frxGetBrackedVariable(s, '<', '>', i, j));
            i:= j;
          end;

        '''', '"':
          SkipString(s, i);

        '(':
          begin
            FindIn(frxGetBrackedVariable(s, '(', ')', i, j));
            if i = j then
              Inc(i) else
              i:= j;
          end;
        else
        begin
          j:= i;
          while (i <= Length(s)) and not (s[i] in 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:= frxGetBrackedVariable(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;
  end;

  procedure EnumGroups(GroupHeader:TfrxGroupHeader; DataBand:TfrxDataBand);
  var
    i:Integer;
    g:TfrxGroupHeader;
  begin
    if GroupHeader = nil then Exit;
    EnumObjects(GroupHeader.FFooter, DataBand);

    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;

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
       (AnsiCompareText(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
      (AnsiCompareText(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.