frxaggregate.pas

这个是功能强大的报表软件

    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 }
{$IFDEF Delphi12}
      while (i <= Length(s)) and (CharInSet(s[i], Spaces)) do
{$ELSE}
      while (i <= Length(s)) and (s[i] in Spaces) do
{$ENDIF}
        Inc(i);

      case s[i] of
        '<':
          begin
          {$IFDEF Delphi12}
            FindIn(frxGetBrackedVariableW(s, '<', '>', i, j));
          {$ELSE}
            FindIn(frxGetBrackedVariable(s, '<', '>', i, j));
          {$ENDIF}
            i := j;
          end;

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

        '(':
          begin
          {$IFDEF Delphi12}
            FindIn(frxGetBrackedVariableW(s, '(', ')', i, j));
          {$ELSE}
            FindIn(frxGetBrackedVariable(s, '(', ')', i, j));
          {$ENDIF}
            if i = j then
              Inc(i) else
              i := j;
          end;
        else
        begin
          j := i;
          {$IFDEF Delphi12}
          while (i <= Length(s)) and not (CharInSet(s[i], IdentSpaces)) do
          {$ELSE}
          while (i <= Length(s)) and not (s[i] in IdentSpaces) do
          {$ENDIF}
            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);
{$IFDEF Delphi12}
      s1 := frxGetBrackedVariableW(s, dc1, dc2, i, j);
{$ELSE}
      s1 := frxGetBrackedVariable(s, dc1, dc2, i, j);
{$ENDIF}
      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
       (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.


//