ugroup.pas

中式财务栏 表格式录入 运行时设置可显示列、列名、列宽

{*******************************************************}
{                                                       }
{       分组统计                                        }
{                                                       }
{       版权所有 (C) 2008 咏南工作室(陈新光)            }
{                                                       }
{*******************************************************}

unit uGroup;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, ExtCtrls, StdCtrls, CheckLst, DBGridEh, db,ADOBatchMove,ComObj,
  ADODB,uDisplay,uCommFunc;

type
  TColParams = record 
    FieldName: string;
    Title: string;
  end;

  TFormGroup = class(TForm)
    grp1: TGroupBox;
    pnl1: TPanel;
    grp3: TGroupBox;
    btn1: TButton;
    btn2: TButton;
    chklst1: TCheckListBox;
    chklst2: TCheckListBox;
    btn3: TButton;
    btn4: TButton;
    procedure btn2Click(Sender: TObject);
    procedure FormShow(Sender: TObject);
    procedure btn1Click(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure btn3Click(Sender: TObject);
    procedure btn4Click(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
  private
    { Private declarations }
    FGrid:TDBGridEh;
    qry88:TADOQuery;
    ColArray,ColArray2: array of TColParams;
    procedure LoadData;
    procedure Group;
    procedure CreateTmpDb;
    procedure BatMove;
    procedure Ok;
  public
    { Public declarations }
  end;

var
  FormGroup: TFormGroup;

const
  FConnStr='Provider=Microsoft.Jet.OLEDB.4.0;Data Source= %s';

//==============================================================================
// 显示分组统计设置窗口，接口函数
//==============================================================================

procedure ShowGroup(AGrid:TDBGridEh);

implementation

{$R *.dfm}

//==============================================================================
// grid是待被分组统计的GRID
// 用GRID关联数据集grid.datasource.dataset
//==============================================================================

procedure ShowGroup(AGrid:TDBGridEh);
begin
  if (not Assigned(AGrid)) or (not AGrid.DataSource.DataSet.Active) or
    (AGrid.DataSource.DataSet.IsEmpty) then exit;
  FormGroup:=TFormGroup.Create(nil);
  try
    FormGroup.FGrid:=AGrid;
    FormGroup.ShowModal;
  finally
    FreeAndNil(FormGroup);
  end;
end;

//==============================================================================
// batCopy 先删除已存在的表，再创建新表，再往表中增加数据
// batAppend 往已存在的表中追加数据
// dsQuery 源数据集控件是TADOQUERY
// dsTable 源数据集控件是TADOTABLE
// 批移dbgrideh的数据至access临时表grp中 
//==============================================================================

procedure tFormGroup.BatMove;
var
  Table:TADOTable;
  batchmove:TADOBatchMove;
begin
  Table:=TADOTable.Create(nil);
  BatchMove:=TADOBatchMove.Create(nil);
  try
    BatchMove.Mode:=batCopy;
    BatchMove.SourceMode:=dsQuery;
    Table.ConnectionString:=Format(FConnStr,[GetMDB]);
    Table.TableName:='grp';
    Batchmove.SourceQuery:=TADOQuery(FGrid.DataSource.DataSet); 
    Batchmove.DestTable:=Table;
    BatchMove.Execute;
  finally
    FreeAndNil(Table);
    FreeAndNil(batchmove);
  end;
end;

procedure TFormGroup.btn2Click(Sender: TObject);
begin
  close;
end;


//==============================================================================
// 将TNumericField和非TNumericField的字段名分别放入不同的Tchecklistbox显示 
//==============================================================================

procedure TFormGroup.LoadData;
var
  i: Integer;
begin
  chklst1.Clear;
  chklst2.Clear;
  SetLength(ColArray,FGrid.Columns.Count);
  SetLength(ColArray2,FGrid.Columns.Count);
  for i := 0 to FGrid.Columns.Count - 1 do
  begin
    if not (FGrid.Columns[i].Field is TNumericField)
      or (FGrid.Columns[i].Field is TIntegerField) or
      (FGrid.Columns[i].Field is TLargeintField) then
    begin
      if FGrid.Columns[i].Visible then
      begin
        ColArray[i].FieldName := FGrid.Columns[i].FieldName;
        ColArray[i].Title := FGrid.Columns[i].Title.Caption;
        chklst1.Items.Add(ColArray[i].Title);
      end;
    end else
    begin
      if FGrid.Columns[i].Visible then
      begin
        ColArray2[i].FieldName := FGrid.Columns[i].FieldName;
        ColArray2[i].Title := FGrid.Columns[i].Title.Caption;
        chklst2.Items.Add(ColArray2[i].Title);
      end;
    end;  
  end;
end;

procedure TFormGroup.FormShow(Sender: TObject);
begin
  qry88:=TADOQuery.Create(self);
  LoadData;
end;

procedure TFormGroup.btn1Click(Sender: TObject);
begin
  ok;
end;

//==============================================================================
// 对ACCESS临时表GRP中的数据进行分组统计
//==============================================================================

procedure TFormGroup.Group;
var
  i,x:Integer;
begin
  with qry88 do
  begin
    ConnectionString:=Format(FConnStr,[GetMDB]);
    SQL.Clear;
    SQL.Add(' select ');
    SQL.Add(' from grp ');
    SQL.Add(' group by ');
    for i:=Low(colarray) to High(colarray) do
    begin
      for x:=0 to chklst1.Count-1 do
      begin
        if (ColArray[i].Title=chklst1.Items[x]) and (chklst1.Checked[x]) then
        begin
          SQL[0]:=SQL[0]+colarray[i].FieldName+' as '+colarray[i].Title+',';
          SQL[2]:=SQL[2]+colarray[i].FieldName+',';
        end;
      end;
    end;
    for i:=Low(colarray2) to High(colarray2) do
    begin
      for x:=0 to chklst2.Count-1 do
      begin
        if (ColArray2[i].Title=chklst2.Items[x]) and (chklst2.Checked[x]) then
        begin
          SQL[0]:=SQL[0]+'sum('+colarray2[i].FieldName+ ') as '+
            colarray2[i].Title+',';
        end;
      end;
    end;
    SQL[0]:=copy(sql[0],1,length(sql[0])-1);
    sql[2]:=copy(sql[2],1,length(sql[2])-1);
  end;
end;

//==============================================================================
// 创建ACCESS数据库
//==============================================================================

procedure TFormGroup.CreateTmpDb;
var   
  CreateAccess:OleVariant;
begin
  CreateAccess:=CreateOleObject('ADOX.Catalog');
  CreateAccess.create(Format(FConnStr,[GetMDB]));
end;

procedure TFormGroup.FormDestroy(Sender: TObject);
begin
  FreeAndNil(qry88);
end;

//==============================================================================
// 确定
//==============================================================================

procedure TFormGroup.Ok;
var
  i,t,n:Integer;
begin
  t:=0;
  for i:=0 to chklst1.Count-1 do        //没有选择任何分类选择
    if chklst1.Checked[i] then Inc(t);
  if t=0 then exit;

  n:=0;
  for i:=0 to chklst2.Count-1 do       //没有选择任何汇总选择
    if chklst2.Checked[i] then Inc(n);
  if n=0 then exit;
  if not FileExists(GetMDB) then CreateTmpDb;
  FGrid.DataSource.DataSet.DisableControls;
  BatMove;                   //批移
  group;                     //分组统计
  ShowDisplay(qry88);        //显示分组后结果
  FGrid.DataSource.DataSet.EnableControls;
  Close;
end;

procedure TFormGroup.btn3Click(Sender: TObject);
var
  i:Integer;
begin
  for i:=0 to chklst1.Count-1 do chklst1.Checked[i]:=True;
  for i:=0 to chklst2.Count-1 do chklst2.Checked[i]:=True;
end;

procedure TFormGroup.btn4Click(Sender: TObject);
var
  i:Integer;
begin
  for i:=0 to chklst1.Count-1 do chklst1.Checked[i]:=False;
  for i:=0 to chklst2.Count-1 do chklst2.Checked[i]:=False;
end;

procedure TFormGroup.FormClose(Sender: TObject; var Action: TCloseAction);
begin
  Action:=caFree;
  FormGroup:=nil;
end;

end.