ClientDataset 实现分组求和(Group By)的功能

ClientDataset 实现分组求和(Group By)的功能

调用用方法 按商品ID分组累加数量

try List.Clear; List.Delimiter:='='; List:=SumOfField(PosCDS,PosCDS.FieldByName('SPID'),PosCDS.FieldByName('Qty')); for i:=0 to List.Count-1 do begin FSpItem.sCode:=List.Names[i]; FSpItem.fXSSL:=StrToFloat(List.Values[List.Names[i]]); end; finally List.Free; end;
unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, Grids, DBGrids, DB, DBClient, StdCtrls, DBCtrls;

type
  TForm1 = class(TForm)
    DBGrid1: TDBGrid;
    DataSource1: TDataSource;
    ClientDataSet1: TClientDataSet;
    Button1: TButton;
    Button2: TButton;
    procedure FormCreate(Sender: TObject);
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
  private
    procedure OnGetText_Agg1(Sender: TField; var Text: string;
      DisplayText: Boolean);
    procedure OnGetText_Agg2(Sender: TField; var Text: string;
      DisplayText: Boolean);
  public
  end;

var
  Form1: TForm1;

implementation
{$R *.dfm}
var
  sl: TStringlist;

procedure TForm1.FormCreate(Sender: TObject);
begin
  { 关联数据控件 }
  DBGrid1.DataSource := DataSource1;
  DataSource1.DataSet := ClientDataSet1;

  { 先打开前面例子中留下的测试文件 }
  ClientDataSet1.LoadFromFile('Test.xml');

  { 添加索引, 其中分组级别是 2 }
  ClientDataSet1.AddIndex('Index1', '班级;年龄', [], '', '', 2);
  { 给数据集指定此索引 }
  ClientDataSet1.IndexName := 'Index1';

  { 数据结构变化时一般需要先关闭数据集 }
  ClientDataSet1.Close;

  { 添加统计字段 Agg1: 按班分组统计语文总成绩 }
  with TAggregateField.Create(Self) do begin
    FieldName := 'Agg1';
    Expression := 'Sum(语文成绩)';
    IndexName := 'Index1';
    GroupingLevel := 1;
    Active := True;
    OnGetText := OnGetText_Agg1;
    DataSet := ClientDataSet1;
  end;

  { 添加统计字段 Agg2: 各班分别按年龄分组统计语文总成绩 }
  with TAggregateField.Create(Self) do begin
    FieldName := 'Agg2';
    Expression := 'Sum(语文成绩)';
    IndexName := 'Index1';
    GroupingLevel := 2;
    Active := True;
    OnGetText := OnGetText_Agg2;
    DataSet := ClientDataSet1;
  end;

  { 需要在 DBGrid 中显示的字段 }
  with DBGrid1.Columns do begin
    Add.FieldName := '班级';
    Add.FieldName := '姓名';
    Add.FieldName := '年龄';
    Add.FieldName := '语文成绩';
    Add.FieldName := 'Agg1';
    Add.FieldName := 'Agg2';
  end;
  { 打开数据集并激活统计 }
  ClientDataSet1.Open;
//  ClientDataSet1.AggregatesActive := True;
end;

procedure TForm1.OnGetText_Agg1(Sender: TField; var Text: string; DisplayText: Boolean);
begin
  if gbLast in ClientDataSet1.GetGroupState(1) then begin
    Text := Sender.AsString;
    sl.Append(ClientDataSet1.FieldByName('班级').AsString +  ': ' + Text);
  end
  else
    Text := '';
end;

procedure TForm1.OnGetText_Agg2(Sender: TField; var Text: string; DisplayText: Boolean);
begin
  if gbLast in ClientDataSet1.GetGroupState(2) then
    Text := Sender.AsString
  else
    Text := '';
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
  sl := TStringlist.Create;
  try
    ClientDataSet1.AggregatesActive := false;
    ClientDataSet1.AggregatesActive := True;
    Application.ProcessMessages;
    showmessage(sl.Text)
  finally
    sl.Free;
  end;
end;

function SumOfField(DSt: TDataSet; KeyField, VField: TField): TStringlist;
var
  s: string;
  BM: TBookMark;
begin
  Result := TStringlist.Create;
  BM := DSt.GetBookmark;
  DSt.DisableControls;
  try
    DSt.First;
    while not DSt.Eof do begin
      s := KeyField.AsString;
      if Result.Values[s] = '' then
        Result.Append(s + '=' + VField.AsString)
      else
        Result.Values[s] :=
          inttostr(strtointdef(Result.Values[s], 0) + VField.AsInteger);
      DSt.Next;
    end;
  finally
    DSt.GotoBookmark(BM);
    DSt.FreeBookmark(BM);
    DSt.EnableControls;
  end;
end;


procedure TForm1.Button2Click(Sender: TObject);
var
  sl: TStringList;
begin
  with ClientDataSet1 do
    sl := SumOfField(ClientDataSet1, FieldByName('班级'), FieldByName('语文成绩'));
  if sl.Count > 0 then begin
    sl.Text := StringReplace(sl.Text, '=', ':', [rfReplaceAll]);
    showmessage(sl.Text);
  end;
  sl.Free;
end;

end.
View Code

感谢广州佬的提供的代码.

原文地址:https://www.cnblogs.com/stroll/p/12743047.html