General grouping statistics

{*************************************** ****************}
{}
{Group statistics}
{}
{Copyright (c) 2008 yongnan Studio (Chen XinGuang )}
{}
{*************************************** ****************}

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 );
Private
{Private Declarations}
Fdataset: tdataset // a bridging variable
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 ';

// ================================================ ==========================================================
// Display the grouping statistics settings window and interface functions
// ================================================ ==========================================================

Procedure showgroup (adataset: tdataset );

Implementation

{$ R *. DFM}

// ================================================ ==========================================================
// Grid is the grid to be grouped for Statistics
// Associate the dataset grid. datasource. dataset with a grid.
// ================================================ ==========================================================

Procedure showgroup (adataset: tdataset );
Begin
If (not assigned (adataset) or (not adataset. Active) or
(Adataset. isempty) Then exit;
Formgroup: = tformgroup. Create (NiL );
Try
Formgroup. fdataset: = adataset;
Formgroup. showmodal;
Finally
Freeandnil (formgroup );
End;
End;

// ========================================== ========================================================== ===< br> // batcopy deletes an existing table first, create a new table, add data to the table
// batappend: append data to an existing table
// The dsquery source dataset control is tadoquery
// The dstable source dataset control is tadotable
// batch remove data from dbgrideh to the access temporary table 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 (fdataset );
Batchmove. desttable: = table;
Batchmove. Execute;
Finally
Freeandnil (table );
Freeandnil (batchmove );
End;
End;

Procedure tformgroup. btn2click (Sender: tobject );
Begin
Close;
End;

// ================================================ ==========================================================
// Put the field names of tnumericfield and non-tnumericfield in different tchecklistbox display
// ================================================ ==========================================================

Procedure tformgroup. loaddata;
VaR
I: integer;
Begin
Chklst1.clear;
Chklst2.clear;
Setlength (colarray, fdataset. fieldcount );
Setlength (colarray2, fdataset. fieldcount );
For I: = 0 to fdataset. fieldcount-1 do
Begin
If not (fdataset. Fields [I] Is tnumericfield)
Or (fdataset. Fields [I] Is tintegerfield) then
Begin
Colarray [I]. fieldname: = fdataset. Fields [I]. fieldname;
Colarray [I]. Title: = fdataset. Fields [I]. displaylabel;
Chklst1.items. Add (colarray [I]. Title );
End else
Begin
Colarray2 [I]. fieldname: = fdataset. Fields [I]. fieldname;
Colarray2 [I]. Title: = fdataset. Fields [I]. displaylabel;
Chklst2.items. Add (colarray2 [I]. Title );
End;
End;
End;

Procedure tformgroup. formshow (Sender: tobject );
Begin
Qry88: = tadoquery. Create (Self );
Loaddata;
End;

Procedure tformgroup. btn1click (Sender: tobject );
Begin
OK;
End;

// ================================================ ==========================================================
// Group statistics on the data in the access temporary table 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 ');
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;

// ================================================ ==========================================================
// Create an Access database
// ================================================ ==========================================================

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;

// ================================================ ==========================================================
// Confirm
// ================================================ ==========================================================

Procedure tformgroup. OK;
VaR
I, T, N: integer;
Begin
T: = 0;
For I: = 0 to chklst1.count-1 do // No category selected
If chklst1.checked [I] Then Inc (t );
If T = 0 Then exit;

N: = 0;
For I: = 0 to chklst2.count-1 do // No summary is selected
If chklst2.checked [I] Then Inc (N );
If n = 0 Then exit;
If not fileexists (getmdb) Then createtmpdb;
Batmove; // batch move
Group; // group statistics
Showdisplay (qry88); // display the Group result
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;

End.