2020年7月30日 星期四

QuickReportLib.pas 記錄




QuickReport 群組頁數/群組合計頁數 

function PageCount(AReport:TQuickRep):Integer;
function PageNumber(AReport:TQuickRep):Integer;
function GroupCount(AReport:TQuickRep; AExpression:String):Integer;
function GroupNumber(AReport:TQuickRep; AExpression:String):Integer;
function GroupPageCount(AReport:TQuickRep; AExpression:String):Integer;
function GroupPageNumber(AReport:TQuickRep; AExpression:String):Integer;

QuickRep1.Prepare;
QuickRep1.PreviewModule;

2020年7月28日 星期二

TRegistry 操作

Uses Registry;

//取得RootKey下的節點
procedure TForm1.Button1Click(Sender: TObject);
var reg: TRegistry;
begin
  reg := TRegistry.Create;
  reg.RootKey := HKEY_LOCAL_MACHINE;
  reg.OpenKey('', False);
  reg.GetKeyNames(memo1.Lines); //取得RootKey下的節點
  reg.CloseKey;
  FreeandNil(reg);
end;

 
//取得節點內的設定
procedure TForm1.Button1Click(Sender: TObject);
var reg: TRegistry;
begin
  reg := TRegistry.Create;
  reg.RootKey := HKEY_LOCAL_MACHINE;
  reg.OpenKey('SOFTWARE\Microsoft\Jet\4.0\Engines\Excel', False);
  reg.GetValueNames(memo1.Lines); //取得節點內的設定
  reg.CloseKey;
  FreeandNil(reg);
end;


//取值
procedure TForm1.Button2Click(Sender: TObject);
var reg: TRegistry;
  sValue:Variant;
  sName:String;
begin
  reg := TRegistry.Create;
  reg.RootKey := HKEY_LOCAL_MACHINE;
  reg.OpenKey('SOFTWARE\Microsoft\Jet\4.0\Engines\Excel', False);   //
  sName := 'TypeGuessRows';
  if reg.ValueExists(sName) then
  begin
    //取節點內的設定值, 必須與設定值的資料型態相同
    if reg.GetDataType(sName)=rdInteger then
      sValue := reg.ReadInteger(sName)
    else if reg.GetDataType(sName)=rdString then
      sValue := reg.ReadString(sName);
  end;
  memo1.text := VarToStr(sValue);
  reg.CloseKey;
  FreeandNil(reg);
end;


//設定值
procedure TForm1.Button3Click(Sender: TObject);
var reg: TRegistry;
  sValue:Variant;
  sName:String;
begin
  reg := TRegistry.Create;
  reg.RootKey := HKEY_LOCAL_MACHINE;
  reg.OpenKey('SOFTWARE\Microsoft\Jet\4.0\Engines\Excel', False);
  sName := 'TypeGuessRows';
  if reg.ValueExists(sName) then
  begin
    //取節點內的設定值, 必須與設定值的資料型態相同
    if reg.GetDataType(sName)=rdInteger then
      reg.WriteInteger(sName, 0)
    else if reg.GetDataType(sName)=rdString then
      reg.WriteInteger(sName, 0)
  end;
  reg.CloseKey;
  FreeandNil(reg);
end;

2020年7月24日 星期五

Client:TSocketConnection和Server:Scktsrvr關系----壓縮數據傳輸

Client:TSocketConnection和Server:Scktsrvr關系----壓縮數據傳輸

一直用SocketConnection和服務端的傳輸數據在三層數據庫中,從來沒有注意到它們之間的數據傳輸,只是想著,管它了,網絡的事,前段時間在Delphi中的Demos中發現DemosMidasIntrcpt.dpr例子,呵呵,再看了半天的VCL發現可以將Client端發送的給Server的數據,和Server發送給Client的數據是可以進行壓縮的。呵呵,不敢藏私,Share給大家。


1:
准備工作,先delphi光盤中的infoextraszlibzlib.pas進行編繹,然後copy 到lib路徑中,因為要壓縮數據,必須要有壓縮功能,這個delphi已經自帶,它是基於流的方式對接口IDataBlock(TDataBlock實現,其實就是對TMemoryStream的操作)數據進行壓縮和解壓的。做了這個後,才能進行下面的工作。
2:
Open DemosMidasIntrcptIntrcpt.dpr 
complier....(如沒有做第一步,嘿嘿...)
生成Intrcpt.dll 
將Intrcpt.dll copy to System directory,或者你的程序下面。
注冊它:regsrvr32 Intrcpt.dll (為什麼,這個嘛...)
記住Intrcpt.dpr的那個GUID,你也可以自己重新生成一個(按Shift+Ctrl+G)
3:
Server: 
Open scktsrvr.exe,相信各位都很熟悉那界面,端口(TListbox),Thread Cache Size(TEdit), GUID(TEdit),好,我們要做的事,就是將注冊的Intrcpt.dll那個GUID填到這個GUID(TEdit)框框中,
只需填自己程序的的那個端口的GUID啊,別亂填,如果有別人用這個程序,出了什麼,別找我。OK,Apply.
Client:
你寫的程序中肯定有TSocketConnection,它有個屬性InterceptGUID: string;好了,將Intrcpt.dll的GUID填上去,它是跟Server中的一樣的。OK.還有別忘了,Regsrvr32 intrcpt.dll 在你的客戶端。不然,程序雖不會raise,但是Server傳過來的數據是壓縮的....  

好了,呵呵。就這些了。3步驟,很清楚吧(不會吧,還不懂,倒)

原理

scktsrvr.exe其實是一堆TServerSocket,一個端口代表了一個TServerSocket,每個TServerSocket是基於多線程方式與客戶端進行數據交換。它寫了個TServerClientThread(在服務端中的客戶端)的擴展
,多加了對客戶端數據接收的管理解析,還有ActivityDateTime,GUID,一般不管它。但是我們用到的壓縮只是跟這個GUID有關,其它費話少說。

Server接受一個Client連接,則加一個TServerClientThread到本地中,用來監控Client Read 和Close事件,所以Server中的scktsrvr中我們只要了解了TServerClientThread動作方式就行了。
(
題外話:Server Socket中有客戶端連接後,記錄ClientSocket.Handle,並且將根據這個Handle產生一個TServerClientWinSocket對象加入到Connections(TList)對象中,當任何對這個Client的動作也就是說Server 發送和接收數據都是根據這個Client Handle來進行的,相應的ServerSocket中的Connections中的ClientSocket也發生相應的變化。
)

有兩個類跟這個TServerClientThread(實現ISendDataBlock接口)有關

1: TDataBlockInterpreter(對發送過來的數據進行解析InterpretData(Data: IDataBlock))
  解析數據(水平有限,對它真是還是一知半解,有錯請指出)
    接口類IDataBlock,由TDataBlock通過TMemoryStream的讀寫來實現,其中Signature是其主要標識,說明這個IDataBlock的數據類型    ,TDataBlockInterpreter根據Signature來對應進行相應的調用,  如:
    Client端連接後,在Server要運行應用服務器(Application Server),
    Client端需要得到ServerName 列表,
    Client端得到Server 的DataBroker的列表,
    Client端斷開連接後,Server要Close應用服務器(Application Server),
    Client和Server的數據交換,也是由它來解析。
所以這個IDataBlock的數據很重要,而我們的壓縮和解壓就是針對於它,但是TDataBlockInterpreter是得到Data才對它解析,因而我們要在Send 和Recv 之前對它解壓和壓縮。這個任務在TSocketTransport身上。    

2: TSocketTransport;(數據進行發送和接收, 實現ITransport接口)
  Server端:
    在Server端,TSocketTransport其實就是一個用來管理對ClientSocket實例,它將ClientSocket.Handle生成一個對象後,ClientSocket發送和接收過來的Data,在發送Data之前,它將調用InterceptOutgoing(Data: IDataBlock)函數,這個函數的功能是:
如果InterceptGUID <> ,那麼它將根據這個GUID生成一個COM(Obj)對象,Obj.DataOut(Data: IDataBlock),也就是我們注冊的那個壓縮的DLL中的那個壓縮函數,將壓縮過後的Data再發送出去。這就完成compress and send Data.(我試過那個壓縮功能,壓縮比大概是1/9,像zip壓縮比差不多).
由客戶端傳過來的數據調用InterceptIncoming(Data: IDataBlock)函數,這就不多說了,Data := 解壓後的Data.  壓縮和解壓過後的Data交由TDataBlockInterpreter去解析,完成一次數據交換。  
  Client端:
    說完Server端,客戶端的道理也是差不多的。唯一不同的是Server端中不調用ITransport.SetConnected()方法,因為它是根據ClientSocket.Handle生成的對象,也就是它是已經連接的對象,而Client端的TSocktConnection調用Connected := True時,其實就是調用ITransport.SetConnect將一個ClientSocket連接到Server端中的TServerSocket中,然後TServerSocket根據這個ClientSocket.Handle生成了一個TServerClientThread對象保存在本地中,開始對這個ClientSocket的監控(FD_Read, FD_Close消息事件).

注:
  IDataBlock由TDataBlock實現,主要是管理TMemoryStream來存放數據
  ITransport由TSocketTransport實現,主要是用TClientSocket來連接TServerSocket,並和它進行交換數據。
  ISendDataBlock在Scktsrvr.exe中由TServerClientThread實現,通過TSocketTransport來發送數據.

轉貼至 http://www.aspphp.online/bianchen/gengduo/delphi/201701/221405.html

2020年7月20日 星期一

Display Menu Item Hints


  F_HintWindow:THintWindow;
  ..
  Private
    procedure WMMenuSelect(var Msg: TWMMenuSelect) ; message WM_MENUSELECT; 
  ..
  ..
procedure TForm1.WMMenuSelect(var Msg: TWMMenuSelect); 
var miSelectItem:TMenuItem;
  hSubMenu : HMENU;
begin
  if Msg.MenuFlag and MF_POPUP = MF_POPUP then
  begin
    hSubMenu := GetSubMenu(Msg.Menu, Msg.IDItem) ;
    miSelectItem := Self.Menu.FindItem(hSubMenu, fkHandle) ;
  end
  else
  begin
    miSelectItem := Self.Menu.FindItem(Msg.IDItem, fkCommand) ;
  end;
  //
  if not Assigned(miSelectItem) then
    Exit;
  //
  if True then
  begin
    pr_Show_HintWindow('Display Menu Item Hints');
  end
  else
  begin
    pr_Close_HintWindow;
  end;
end;

procedure TForm1.pr_Show_HintWindow(AText:String);
var pPoint:TPoint;
  iHeight, iWidth:Integer;
begin
  if not Assigned(F_HintWindow) then
    F_HintWindow := THintWindow.Create(Self);
  //
  pPoint := ClientToScreen(Mouse.CursorPos);
  iHeight := Canvas.TextHeight(AText);
  iWidth := Canvas.TextWidth(AText);
  F_HintWindow.ActivateHint(Rect(pPoint.X, pPoint.Y,pPoint.X+iWidth, pPoint.Y+iHeight), AText);
end;

procedure TForm1.pr_Close_HintWindow;
begin
  if Assigned(F_HintWindow) then
    F_HintWindow.ReleaseHandle;
end;

參考
  https://www.thoughtco.com/how-to-display-menu-item-hints-1058397

2020年6月30日 星期二

Delphi 執行檔,程式碼執行無法繼續,因為找不到Borlndmm.dll。...

Delphi 獨立執行檔(Exe),啟動後出現錯誤訊息
"程式碼執行無法繼續,因為找不到borlndmm.dll。重新安裝程式或許可以修正此問題。"


與 uese ShareMem有關

在字串中重複的出現次數


function fn_StrOccurrences(const ASubStr, AText:String):Integer; //在字串中重複的出現次數
var iOffset:Integer;
begin
  Result := 0;
  iOffset := PosEx(ASubStr, AText, 1);
  while iOffset<>0 do
  begin
    Inc(Result);
    iOffset := PosEx(ASubStr, AText, iOffset + Length(ASubStr));
  end;
end;

轉貼至:http://grandruru.blogspot.com/2016/08/blog-post.html

2020年6月25日 星期四

...import an Excel Table to a TStringgrid?

...import an Excel Table to a TStringgrid?
Autor: Thomas Stutz

uses
  ComObj;

function Xls_To_StringGrid(AGrid: TStringGrid; AXLSFile: string): Boolean;
const
  xlCellTypeLastCell = $0000000B;
var
  XLApp, Sheet: OLEVariant;
  RangeMatrix: Variant;
  x, y, k, r: Integer;
begin
  Result := False;
  // Create Excel-OLE Object
  XLApp := CreateOleObject('Excel.Application');
  try
    // Hide Excel
    XLApp.Visible := False;

    // Open the Workbook
    XLApp.Workbooks.Open(AXLSFile);

    // Sheet := XLApp.Workbooks[1].WorkSheets[1];
    Sheet := XLApp.Workbooks[ExtractFileName(AXLSFile)].WorkSheets[1];

    // In order to know the dimension of the WorkSheet, i.e the number of rows
    // and the number of columns, we activate the last non-empty cell of it

    Sheet.Cells.SpecialCells(xlCellTypeLastCell, EmptyParam).Activate;
    // Get the value of the last row
    x := XLApp.ActiveCell.Row;
    // Get the value of the last column
    y := XLApp.ActiveCell.Column;

    // Set Stringgrid's row &col dimensions.

    AGrid.RowCount := x;
    AGrid.ColCount := y;

    // Assign the Variant associated with the WorkSheet to the Delphi Variant

    RangeMatrix := XLApp.Range['A1', XLApp.Cells.Item[X, Y]].Value;
    //  Define the loop for filling in the TStringGrid
    k := 1;
    repeat
      for r := 1 to y do
        AGrid.Cells[(r - 1), (k - 1)] := RangeMatrix[K, R];
      Inc(k, 1);
      AGrid.RowCount := k + 1;
    until k > x;
    // Unassign the Delphi Variant Matrix
    RangeMatrix := Unassigned;

  finally
    // Quit Excel
    if not VarIsEmpty(XLApp) then
    begin
      // XLApp.DisplayAlerts := False;
      XLApp.Quit;
      XLAPP := Unassigned;
      Sheet := Unassigned;
      Result := True;
    end;
  end;
end;


procedure TForm1.Button1Click(Sender: TObject);
begin
  if Xls_To_StringGrid(StringGrid1, 'C:\Table1.xls') then
    ShowMessage('Table has been exported!');
end;

轉貼至:https://www.swissdelphicenter.ch/en/showcode.php?id=1728

2020年6月9日 星期二

Table 分組後取最大的資料列


1.
  Select A.* 
  From [Table1] as A
  Inner Join (
              Select [Field01], Max([Score]) Score
              From [Table1]
              Group By [Field01) as B on A.[Field01]=B.[Field01] and A.[Score]=B.[Score] 
  Order By A.[Field01]

2.
  Select *
  From (
    Select ROW_NUMBER() OVER(PARTITION BY [Field01] ORDER BY [Score] DESC) as rowid, *
    FROM [Table1]
  )
  Where rowid=1

2020年4月27日 星期一

C# PadLeft / PadRight 字串補指定字元


string str="A";
str.PadLift(3,'0'); --> 00A 左邊補指定字元
str.PadRight(3, '0'); --> A00 右邊補指定字元

2020年4月21日 星期二

C# InputBox 輸入視窗

using System.Windows.Forms;
using System.Drawing;

public static DialogResult InputBox(string title, string promptText, ref string value)
{
  Form form = new Form();
  Label label = new Label();
  TextBox textBox = new TextBox();
  Button buttonOk = new Button();
  Button buttonCancel = new Button();

  form.Text = title;
  label.Text = promptText;
  textBox.Text = value;

  buttonOk.Text = "OK";
  buttonCancel.Text = "Cancel";
  buttonOk.DialogResult = DialogResult.OK;
  buttonCancel.DialogResult = DialogResult.Cancel;

  label.SetBounds(9, 20, 372, 13);
  textBox.SetBounds(12, 36, 372, 20);
  buttonOk.SetBounds(228, 72, 75, 23);
  buttonCancel.SetBounds(309, 72, 75, 23);

  label.AutoSize = true;
  textBox.Anchor = textBox.Anchor | AnchorStyles.Right;
  buttonOk.Anchor = AnchorStyles.Bottom | AnchorStyles.Right;
  buttonCancel.Anchor = AnchorStyles.Bottom | AnchorStyles.Right;

  form.ClientSize = new Size(396, 107);
  form.Controls.AddRange(new Control[] { label, textBox, buttonOk, buttonCancel });
  form.ClientSize = new Size(Math.Max(300, label.Right + 10), form.ClientSize.Height);
  form.FormBorderStyle = FormBorderStyle.FixedDialog;
  form.StartPosition = FormStartPosition.CenterScreen;
  form.MinimizeBox = false;
  form.MaximizeBox = false;
  form.AcceptButton = buttonOk;
  form.CancelButton = buttonCancel;

  DialogResult dialogResult = form.ShowDialog();
  value = textBox.Text;
  return dialogResult;
}




 Ex:

string value = "Document 1";

if (Tmp.InputBox("New document", "New document name:", ref value) == DialogResult.OK)
{
  myDocument.Name = value;
}

轉貼至 https://dotblogs.com.tw/aquarius6913/2014/09/03/146444

2020年3月24日 星期二

C# MessageBox 常用語法

  MessageBox.Show("Hello World");



  DialogResult result;
  result = MessageBox.Show("Are you OK?", "Question",
    MessageBoxButtons.YesNo,
    MessageBoxIcon.Question);
  if (result = DialogResult.Yes)
  {
    ...
  }


2020年3月20日 星期五

C# DevExpress PopupMenu




                    Point pointPos = new Point();
                    pointPos.X = button1.Left;
                    pointPos.Y = button1.Left + button1.Height;
                    pointPos = button1.PointToScreen(pointPos);
                    popupMenu1.ShowPopup(pointPos);

2020年3月5日 星期四

Which is the best way to load a string (HTML code) in TWebBrowser?

procedure THTMLEdit.EditText(CONST HTMLCode: string);
var
  Doc: Variant;
begin
  if NOT Assigned(wbBrowser.Document) then
    wbBrowser.Navigate('about:blank');

  Doc := wbBrowser.Document;
  Doc.Clear;
  Doc.Write(HTMLCode);
  Doc.Close;
end;


https://stackoverflow.com/questions/39773033/which-is-the-best-way-to-load-a-string-html-code-in-twebbrowser

2020年2月25日 星期二

URLDownloadToFile - some pages is not download

It seems that Win7 does some of the work for us - that is to say, I just tried the code in a virtual machine with XP and VS2005 - I got the same problem, i.e error (from the watch window) - "hRes 0x800401e4 Invalid syntax HRESULT"

Earlier in the evening I had read that you need to make sure COM is initialized for the thread. I disregarded this and plowed on - this was fine when I used Win7 and Vs2010.

Anyway, the fix was to use CoInitialize(NULL); before the call to URLDownloadToFile - after this change, hRes holds S_OK afterwards. :)

Listing as tested with VS2005 in XP
Hide   Copy Code
#include "stdafx.h"
#include <windows.h>
#include <urlmon.h>

int main()
{
CoInitialize(NULL);
HRESULT hRes;
hRes = URLDownloadToFile(NULL, L"http://www.google.com/", L"google.com.file", 0, NULL);

return 0;
}

Posted 12-Aug-12 9:03am
enhzflep


https://www.codeproject.com/Questions/439137/URLDownloadToFile-some-pages-is-not-download

DELPHI TDownLoadURL下载网络文件



unit Unit1;

interface

uses
  //引用   Vcl.ExtActns
  Vcl.ExtActns,
  System.SysUtils, System.Types, System.UITypes, System.Classes,
  System.Variants,
  FMX.Types, FMX.Graphics, FMX.Controls, FMX.Forms, FMX.Dialogs, FMX.StdCtrls,
  IdBaseComponent, IdComponent, IdTCPConnection, IdTCPClient, IdHTTP, FMX.Edit;

type
  TForm1 = class(TForm)
    GroupBox1: TGroupBox;
    ProgressBar1: TProgressBar;
    Edit1: TEdit;
    GroupBox2: TGroupBox;
    Edit3: TEdit;
    Edit4: TEdit;
    Label1: TLabel;
    Label2: TLabel;
    Label3: TLabel;
    Button1: TButton;
    procedure Button1Click(Sender: TObject);
  private
    procedure URL_OnDownloadProgress(Sender: TDownLoadURL;
    Progress, ProgressMax: Cardinal; StatusCode: TURLDownloadStatus;
    StatusText: String; var Cancel: Boolean);
  public
    { Public declarations }
  end;

var

  Form1: TForm1;

implementation

{$R *.fmx}

var

  DownLoadURL1:TDownLoadURL;


//url=网络文件  'http://helloroman.oicp.net:8000/test.rar';
//Filename=保存到本地文件 'D:\Administrator\Desktop\123.rar';

function DownLoadFile(url,Filename:string):boolean;
var
  DownLoadURL1:TDownLoadURL;
begin
  try
    DownLoadURL1:=TDownLoadURL.Create(Form1);
    DownLoadURL1.URL:= url;
    DownLoadURL1.Filename:= Filename;
    DownLoadURL1.OnDownloadProgress:=Form1.URL_OnDownloadProgress;
    DownLoadURL1.ExecuteTarget(nil);
    DownLoadURL1.Free;
    Result:=true;
  except
    Result:=false;
  end;
end;


procedure DownLoadThread;
begin
  Form1.label3.Text:='0 kb / 0 kb';
  if DirectoryExists(ExtractFilePath(Form1.edit4.text)) then
  begin
    if not DownLoadFile(Form1.edit3.text,Form1.edit4.text) then
      Form1.GroupBox1.Text:='下载失败'
    else
      Form1.GroupBox1.Text:='下载完毕';
  end
  else
     SHowMessage(Form1.edit4.text + '不存在!');
end;


procedure TForm1.Button1Click(Sender: TObject);
begin
  TThread.CreateAnonymousThread(DownLoadThread).Start;
end;

function BytesToStr(iBytes: Integer): String;
var
  iKb: Integer;
begin
  iKb := Round(iBytes / 1024);
  if iKb > 1000 then
    Result := Format('%.2f MB', [iKb / 1024])
  else
    Result := Format('%d KB', [iKb]);
end;

// 获取网络文件名
function GetUrlFileName(url:string):string;
var
 str:string;
begin
 url:=StringReplace(StrRScan(PChar(url),'/'), '/', '',[rfReplaceAll]);
 if Pos('=',url) > 0 then
    url:=StringReplace(StrRScan(PChar(url),'='), '=', '',[rfReplaceAll]);
 Result:=url;
end;

procedure TForm1.URL_OnDownloadProgress(Sender: TDownLoadURL;
  Progress, ProgressMax: Cardinal; StatusCode: TURLDownloadStatus;
  StatusText: String; var Cancel: Boolean);
begin
  ProgressBar1.Max := ProgressMax div 100;
  ProgressBar1.Value := Progress div 100;

  Caption := StatusText;

  case StatusCode of
    dsFindingResource:GroupBox1.Text:='查找资源...';
    dsConnecting:GroupBox1.Text:='连接中...';
    dsRedirecting:GroupBox1.Text:='';
    dsBeginDownloadData:GroupBox1.Text:='准备下载文件...';
    dsDownloadingData:GroupBox1.Text:='下载中...';
  end;


  Edit1.Text:= Format('文件名:%s',[GetUrlFileName(Edit3.Text)]);
  label3.Text := Format('%s / %s', [BytesToStr(Progress),BytesToStr(ProgressMax)]);
end;

end.



http://www.cnblogs.com/xe2011/p/3719454.html

2020年2月20日 星期四

How to download a file from the Internet


uses
  URLMon, ShellApi;

function fn_DownloadFile(ASourceFile, ADestFile: String): Boolean;
begin
  try
    Result := UrlDownloadToFile(nil, PChar(ASourceFile), PChar(ADestFile), 0, nil) = 0;
  except
    Result := False;
  end;
end;


URLDownloadToFile function

https://docs.microsoft.com/en-us/previous-versions/windows/internet-explorer/ie-developer/platform-apis/ms775123(v=vs.85)?redirectedfrom=MSDN

2020年2月13日 星期四

遞迴 SQL With...

  with [recursive] as(
    ----------------------
    --資料來源 begin
    ----------------------
    Select field1 , field2
    From Table a
    Where field1 = 1
    --------------------
    --資料來源 end
    -------------------
    Union All
    Select b.field1, b.field2
    From Table b
    Join [recursive] on b.field2 = [recursive].fied01
  )
  select * from [recursive]

2019年12月25日 星期三

Delphi clientdataset的详细介绍

delphi Midas SQLServer的自增字段的处理1.新增时,表中有自增字段,但是不希望用Refresh,直接ApplyUpdates直接看见自增字段的值在DataSetProvider.AfterUpdateRecord写如下代码

01.DataSetProvider.Options.poPropogateChanges:=True;
02.procedure TForm1.DataSetProvider1AfterUpdateRecord(Sender: TObject;
03.SourceDS: TDataSet; DeltaDS: TCustomClientDataSet;
04.UpdateKind: TUpdateKind);
05.begin
06.//DstId TADODataset
07.//FId 为自增字段
08.if   UpdateKind=ukInsert then
09.    begin
10.       DstId.CommandText:='select @@Identity as FId ';
11.       DstId.Open;
12.       DeltaDS.FieldByName('FId').ReadOnly:=False;
13.       DeltaDS.FieldByName('FId').NewValue:=DstId.FieldByName('FId').AsInteger ;
14.       DstId.Close;
15.   end;
16.end;


  2.新增时,从表的关联字段与主表的自增字段同步更新

01.procedure TProducts.DataSetProvider1BeforeUpdateRecord(Sender: TObject;
02.SourceDS: TDataSet; DeltaDS: TCustomClientDataSet;
03.UpdateKind: TUpdateKind; var Applied: Boolean);
04.begin
05.//DstProduct为从表的Name
06.//CategoryID是从表的对于主表的字增自段的关联字段
07.// qryIdentity是TADOQuery qryIdentity.SQL:='select @@identity'
08.if (UpdateKind = ukInsert) and
09.(SourceDS = DstProduct) and
10.(DeltaDS.FieldByName('CategoryID').Value = Unassigned)   ) then
11.begin
12.    if DeltaDS.BOF then
13.    begin
14.      qryIdentity.Close;
15.      qryIdentity.Open;
16.    end;
17.    DeltaDS.FieldByName('CategoryID').NewValue := qryIdentity.Fields[0].Value;
18.end;
19.end;


  Delphi做为一个快速应用开发工具,深受程序员的喜爱。其强大的组件功能,让程序员能够轻松、高效地完成常见的界面开发、数据库应用等功能。然而,帮助的相对缺乏,使得许多组件的功能并不为人们正确地使用,究其原因,仍然是认识上的问题。对于MIDAS开发中的核心部件,TClientDataSet 和TDataSetProvider,由于资料的缺乏,人们在网上大多谈论的是李维的书籍内容。我有幸在BDN上见到了Cary Jensen的Professional Developer系列文章,详细阐述了DELPHI的数据库开发技术。现节选出其中的ClientDataSet部分,与大家共同分享。
ClientDataSet是一个功能强大的类,通过在内存中模拟表格,实现了其它数据集组件所不具备的强大功能。以往只在Delphi和C++ Builder企业版中才提供这个组件,如今,Borland的全部产品(包括最新的Kylix)都集成了TClientDataSet组件。
TClientDataSet从类的继承关系上来看,是TDataSet这个抽象类的子类,所以我们可以在TDataSet这个抽象层次上对其进行我们熟悉的操作,比如导航、排序、过滤、编辑。要注意的是,TClientDataSet使用了一种全新的技术,它将所有的数据均放在内存中,所以 TClientDataSet是个只存在内存中的“虚拟表”,因此对数据库的操作是非常快的。在PIII 850,512MB的机器上对十万条记录进行建索引的操作,花费的时间少于半分钟。
与一般的数据集组件不同,TClientDataSet使用的技术比较特别,本着高速度、低存储需求的原则,TClientDataSet的内部使用了两个数据存储源。第一个是其Data属性,这是当前内存数据的视图,反映了所有的数据改变。如果用户从数据中删除一条记录,则此记录将从Data中消失,相应地,加入一条新记录后,此记录便存在Data属性中了。
另一个数据源是Delta属性,故名思义,即增量的意思,这个属性反映了对数据的改变。无论是向Data属性新增还是删除记录,都会在Delta中记录下来,如果是修改了Data中的记录,则会在Delta保存两条相应的记录,一条是原始记录,另一条仅包含修改的字段值。正因为Delta的存在和 TClientDataSet在内存中记录数据的特点,所有的改变都没有立即更新加对应的物理存储中,可以根据这些信息在适当的时候恢复,所以 TClientDataSet天生具有缓冲更新功能。
为了使数据更新回数据存储源,我们要调用TClientDataSet中对应的方法。如果ClientDataSet与 DataSetProvider关联,那么仅需调用TClientDataSet的ApplyUpdates方法即可保存数据的更新,但如果 TClientDataSet没有对应的TDataSetProvider存在,而是直接同文件关联,那么,这种方式是非常有趣的,我们在 BriefCase模型中会再次讲解这个问题。此时,如果使用TClientDataSet的SaveToFile和LoadFromFile,都会保留着Delta。调用MergeChangeLog和ClearChanges后,Delta的内容才会被
清空。只是前者是将Delta的数据同Data结合起来,将改变存储到物理介质上,而ClearChanges则是一股脑儿全部清空,将数据回复到原始状态。大部分的应用都是将TClientDataSet与TDataSetProvider结合使用的。两者联合使用的行为反映了Borland的设计宗旨,就是要提供一个面向分布式环境的思路。我们下面来慢慢解释。
当我们将TClientDataSet对象的Active属性设为True或者调用其Open方法后,ClientDataSet会向 DataSetProvider发送一个取数据包请求。于是DataSetProvider便会打开对应的数据集,将记录指针指向第一条记录,然后从头到尾依次扫描。对于扫描到的每一条记录,都会将其编码成一个variant数组,我们通常将它称之为数据包。完成扫描后,DataSetProvider会关闭指向的数据集,并将所有的这些数据包传递给ClientDataSet。在我提供的演示程序中,你可以清楚地看到这种行为(毕竟眼见为实吗!)。程序主界面右边的DBGrid连接到一个指向数据库表的数据源,DataSetProvider即指向此表。当选择了ClientDataSet | Load菜单项时,你可以看到表格的数据被依次扫描,一旦到达最后一条记录,表格便会被关闭,右边的DBGrid被清空,而左边反映 ClientDataSet数据的DBGrid便出显示出内存中的数据来。由于这个过程会在DBGrid上反映出来,所以不到1000条记录的取出时间中,大部分都浪费在屏幕的更新显示上了,你可以选择ClientDataSet | View Table Loading来禁止显示,而达到加速的目的。
在上面的描述中,我们没有提到一个重要的环节,即数据包是如何还原成表格的。那是因为DataSetProvider会将数据包中的元数据解码出来,根据元数据(我们可以理解为数据表的结构)便可以构造出与物理数据表一模一样的内存虚拟表。但要注意的是,尽管DataSetProvider指向的数据表可能有多个索引,但这些信息是不会放在数据包中的,换句话说,ClientDataSet当中的数据默认情况下是无索引的。但因为 ClientDataSet具有与TDataSet一致的行为,所以我们可以在此基础上根据需要重建索引。
在ClientDataSet中的数据被修改后,可以提交给物理数据表持久化这此改变。这个工作便是由DataSetProvider完成的。内部工作原理是:DataSetProvider创建一个TSQLResolver的实例,这个实例会生成要在底层数据上执行更改的SQL语句。详细地说,就是对修改日志中的每一条被删除、插入、更改记录生成对应的SQL语句。这个语句的生成也可以由用户控制,DataSetProvider的 UpdateMode属性和ClientDataSet中的ProviderFlags属性都对SQL语句的生成有影响。
当然,你也可以换一种方式,即采取同单机或C/S结构一样的数据直接操作机制,绕过SQL语句和缓冲更新机制来修改数据库。只需将 ResolveToDataSet属性设为True,那么DataSetProvider在持久化更新时便不会使用TSQLResolve,而是直接修改物理数据源。即定位到要删除的记录,调用删除语句,定位到修改记录,调用修改语句。我们可以对演示程序稍加修改,观察此种行为。请将演示程序中的 DataSetProvider的ResolveToDataSet属性由False改为True,运行。在界面中修改数据并且保存,你将会看到右边的导航按钮会在瞬间变得可用。
更绝妙的是,Borland考虑到了应用的多样性,为我们提供了BeforeUpdateRecord事件,这样,当 DataSetProvider对每个修改日志的记录进行操作时,都会触发此事件,我们可以在此事件中加入自己的处理,如“加密操作”、“商业敏感数据处理”等应用,从而极大地方便了程序员,让程序员对于数据具有完全的控制能力。分布式环境的复杂性对数据的存取提出了更高的要求,所以使用事务来保证数据的完整性和一致性是非常必要的,Borland考虑到了这一点,当调用ClientDataSet的ApplyUpdates时,你可以传递一个整数值来指明可以容忍的错误数量。如果你的数据非常严格,则可以传递0值,这样,DataSetProvider在应用修改时便会打开一个事务,如果遇到错误,便会回退此事务,修改日志将保持原样,并且将出错的记录标记出来,最后会触发OnReconcileError事件。如果传递了一个大于0的数,则当出现的错误数量小于此指定值时,事务会被提交,发生错误而导致提交失败的记录会保留在Delta中,而提交成功的记录会从修改日志中删除。若错误数量达到指定值,则事务会回退,结果同整数值为0的情况。如果值为负数,则会交所以可提交的数据都提交,不可提交的数据仍然保存在修改日志中,并将出错记录标记出来。
虽然,Borland是为了满足分布式编程的需要而设计了TClientDataSet,但在其它类型的编程环境中使用ClientDataSet 也具有积极的意义。首先,我们可以看到,由于数据均在内存中进行操作,而且仅在打开数据库取数据时和将修改持久到回数据库时,才有数据库开销,其它时间数据库为零,这样就极大地增加了数据库的负荷,让数据库服务器能满足更多用户的连接请求。其次,ClientDataSet具有其它数据集所不具备的许多高级功能,这为程序员进行复杂的编程提供了便利,可以不考虑数据库本身是否支持这此功能,而让ClientDataSet去处理这些复杂而繁琐的细节。最后,ClientDataSet在数据存储和应用程序间起到一个抽象层的作用。假如你的程序使用了TClientDataSet,那么如果你以后要更改数据库存储机制。比如说由BDE移植到dbExpress,或者从ADO移植到Interbase Express,你的用户界面和数据控制部分几乎就不用改变,只需要将DataSetProvider指向新的数据存取组件即可。顺便说一句,由于缓冲更新的存在,用户可能非常厌恶调用ApplyUpdates操作,那么你可以将此调用放入AfterPost和AfterDelte中,让用户的操作更方便。
多层结构中必不可少件TClientDataSet的全面剖析2008-12-11 15:01在三层结构中,TClientDataSet的地位是不可估量的,她的使用正确与否,是十分关键的,本文从以下几个方面阐述她的使用,希望对你有所帮助.


1.动态索引

procedure TForm1.DBGrid1TitleClick(Column: TColumn);
begin
if (not column.Field is Tblobfield) then//Tblobfield不能索引,二进制
ClientDataSet1.IndexFieldNames:=column.Field.FieldName;
end;

2.多层结构中主从表的实现
设主表ClientDataSet1.packetrecord为-1,所有记录
设从表ClientDataSet1.packetrecord为0,当前记录

3.Taggregates使用

(1)在字段编辑中add new field类型为aggregates
后设置expression(表达试)
设置active:=true即可
使用dbedit的field为前者即可

(2)使用Aggergates属性add设计表达试
调用
  showmessage(floattostr(ClientDataSet1.Aggregates.Count));
  showmessage(ClientDataSet1.Aggregates.Items[0].Value);

4.在单层数据库中不要BDE
使用ClientDataSet代替table,使用ClientDataSet的loadfilename装入cds
代替table的tablename的db或者dbf
原来的程序改造方法:
加一个ClientDataSet,使用右键assign locate data
后savetofile,再loadfromfile,后删除table
将原连table的datasource设为ClientDataSet
唯一注意的是:要将midas.dll拷到system或者当前目录

5.三层结构的公文包的实现方法
同时设定1:filename(*.cds)2.remote server

6.可以对data赋值(从另一个数据集取值)
ClientDataSet2.Data:=ClientDataSet1.Data;
ClientDataSet2.Open;
或者
ClientDataSet2.CloneCursor(ClientDataSet1,true);
ClientDataSet2.Open;

7.附加数据取得
客户程序向应用服务器请求数据。如果TClientDataSet 的
FetchOnDemand 属性设为True,
客户程序会根据需要自动检索附加的数据包如BLOB字段的值或嵌套表的内容。
否则,
客户程序需要显式地调用GetNextPacket 才能获得这些附加的数据包。
ClientDataSet的packetrecords设置一次取得的记录个数

8.ClientDataSet与服务器端query连接方法

(1)sql内容为空
ClientDataSet1.Close;
ClientDataSet1.CommandText:=edit1.Text;//即sql内容
ClientDataSet1.Open;

对于没有应用服务器设置filter 如:country like 'A%'
filtered=true可实现sql功能


(2)有参数
如服务端query的sql为
select * from animals
where name like :dd

则:客户端ClientDataSet

var
pm:Tparam;
begin
ClientDataSet1.Close;
ClientDataSet1.ProviderName:='DataSetProvider1';
pm:=Tparam.Create(nil);
pm.Name:='dd';
pm.DataType:=ftString;
ClientDataSet1.Params.Clear;
ClientDataSet1.Params.AddParam(pm);
ClientDataSet1.Params.ParamByName('dd').AsString:=edit1.Text ;
ClientDataSet1.Open;
pm.Free;
end;

9.数据的更新管理

(1)savepoint 保存目前为止数据状态,可以恢复到这个状态
var
pp:integer;
begin
pp:=ClientDataSet1.SavePoint;
ClientDataSet1.Edit;
ClientDataSet1.FieldByName('姓名').asstring:='古话';
ClientDataSet1.Post;
table1.Refresh;
end;

恢复点

ClientDataSet1.SavePoint:=pp;

(2)cancel,RevertRecord

取消对当前记录的修改,只适合没有post的,如果post,调用
RevertRecord


(3)cancelupdate
取消对数据库所有的修改


(4)UndoLastChange(boolean),changecount
取消上一次的修改,可以实现连续撤消
参数为true:光标到恢复处
false:光标在当前位置不动
changecount返回修改记录的次数,一个记录修改多次,返回只一次
但UndoLastChange只撤消一次

10.可写的recno
对于Ttable和Tquery的recno是只读的,而TClientDataSet的recno可读可写
ClientDataSet1.recno:=5;是设第五个记录为当前记录

11.数据保存
对于table使用post可更新数据
而ClientDataSet1的post只更新内存数据,要更新服务器数据要使用
ApplyUpdates(MaxErrors: Integer),他有一个参数,是允许发出错误的
次数,-1表示无数次,使用simpleobjectbroker时常设为0,实现自动容错和负载平衡

ClientDataSet排序


1、简单排序
ClientDataSet1.IndexFieldNames:='排序字段'

2、复杂排序(建立索引)
下面这个过程仅供参考(因为用到三方控件DBGridEh):
procedure TDM1.DsSort(SortColumn: TColumnEh);
var
OldIndex:string;
begin
if (SortColumn.Grid.DataSource=nil) or (SortColumn.Grid.DataSource.DataSet=nil) or (not SortColumn.Grid.DataSource.DataSet.Active) then Exit;
OldIndex:=TClientDataSet(SortColumn.Field.DataSet).IndexName;
if OldIndex<>'' then
begin
   TClientDataSet(SortColumn.Field.DataSet).IndexName:='';
   TClientDataSet(SortColumn.Field.DataSet).DeleteIndex(OldIndex);
end;

case SortColumn.Title.SortMarker of
   smNoneEh,
   smUpEh :TClientDataSet(SortColumn.Field.DataSet).AddIndex('px',SortColumn.Field.FieldName,[ixDescending]);
   smDownEh:TClientDataSet(SortColumn.Field.DataSet).AddIndex('px',SortColumn.Field.FieldName,[ixPrimary]);
end;

TClientDataSet(SortColumn.Field.DataSet).IndexName:='px';

end; 把上面的过程稍做修改,可用于标准DBGridvar

ASC:Boolean=True;//是否升序排列


procedure TDM1.DsSort(SortColumn: TColumn);
var
OldIndex:string;
begin
if (SortColumn.Grid.DataSource=nil) or (SortColumn.Grid.DataSource.DataSet=nil) or (not SortColumn.Grid.DataSource.DataSet.Active) then Exit;
OldIndex:=TClientDataSet(SortColumn.Field.DataSet).IndexName;
if OldIndex<>'' then
begin
TClientDataSet(SortColumn.Field.DataSet).IndexName:='';
TClientDataSet(SortColumn.Field.DataSet).DeleteIndex(OldIndex);
end;

case ASC of
True :TClientDataSet(SortColumn.Field.DataSet).AddIndex('px',SortColumn.Field.FieldName, [ixDescending]);//已经是升序就按降序排列
else//否则按升序排列
TClientDataSet(SortColumn.Field.DataSet).AddIndex('px',SortColumn.Field.FieldName,[ixPrimary]);
end;{end case}

TClientDataSet(SortColumn.Field.DataSet).IndexName:='px';
ASC:=not ASC;
end;

用于TABLEvar

ASC:Boolean=True;//是否升序排列

procedure DsSort(SortColumn: TColumn);
var
OldIndex:string;
begin
if (SortColumn.Grid.DataSource=nil) or
     (SortColumn.Grid.DataSource.DataSet=nil) or
     (not SortColumn.Grid.DataSource.DataSet.Active) then Exit;
OldIndex:=TTable(SortColumn.Field.DataSet).IndexName;
if OldIndex<>'' then
begin
    TTable(SortColumn.Field.DataSet).IndexName:='';
    TTable(SortColumn.Field.DataSet).DeleteIndex(OldIndex);
end;

try
TTable(SortColumn.Field.DataSet).DeleteIndex('px');
except
end;

case ASC of
    True : TTable(SortColumn.Field.DataSet).AddIndex('px',
                  SortColumn.Field.FieldName,
                  [ixDescending]);//已经是升序就按降序排列
    else//否则按升序排列
    TTable(SortColumn.Field.DataSet).AddIndex('px',
           SortColumn.Field.FieldName,
           [ixPrimary]);
end;{end case}

TTable(SortColumn.Field.DataSet).IndexName:='px';
ASC:=not ASC;
end;


//当点击DBGRID标题时调用

procedure TForm1.DBGrid1TitleClick(Column: TColumn);
begin
DsSort(Column);
end;

ClientDataSet的隐含功能------转载《Delphi 从入门到精通》

                      可能与前面的笔记有重复的地方

    ClientDataSet组件支持很多特性,其中一些与三级结构有关,而且还可以用在其他环境中。该组件说明了一个数据库完全映象在内存中,这使得可以进行动态的操作,如建立一个索引,其他数据集合通常不支持该特性。例如,为了对查询分类,我们通常是重新执行它。为了索引一个局部表格,需要定义索引。只有ADO数据集合有一些与ClientDataSet一样的动态索引功能。
    索引并不是ClientDataSet提供的全部功能。当我们拥有了索引之后,可以基于它定义组,可能是多级别的分组。对于确定一个记录在组中的位置(头、尾或中间位置),甚至有专门的支持。在组或整个数据表格中,我们可以定义总计;也就是说,可以动态计算整个表格或当前组中一列的总和或平均值。数据不需要发送给物理服务器,因为这些总计操作发生在内存中。我们甚至可以定义新的总计字段,可以直接与数据敏感控件相连。
    注意,所有这些特性不但可以用与MIDAS应用程序,还可以用与客户机/服务器,甚至是局部瘦应用程序。事实上,ClientDataSet组件可以从远程MIDAS连接、局部数据集合(建立起数据的快照)、或局部文件(就象在公文包模式中一样,但使用的只是在客户机数据集合中定义的整个表格)中获得起数据。
    这是另一个需要研究的领域,所以将向读者演示两个范例来突出关键特性。这些范例没有基于MIDAS,而是基于局部表格。


1、定义抽象的数据的数据类型

    VCL数据库支持的一个有趣的特性是,当我们基于局部文件使用ClientDataSet时,可以定义抽象的数据类型。只需在窗体上放置一个 ClientDataSet组件,为FieldDefs属性激活编辑器,添加两个字段,并为他们的DataType属性选择ftADT值。现在,移到 ChildDefs属性,并定义子字段,下面是AdtDemo范例的字段定义:
    FieldDefs = <
      item
        Name = 'ID'
        DataType = ftInteger
      end
      item
        name = 'Name'
        ChildDefs = <
          item
            name = 'LastName'
            DataType = ftString
            size = 20
          end
          item
            name = 'FirstName'
            datatype = ftString
            size = 20
          end>
       datatype = ftADT
       size = 2
     end>

    在此,只需为ClientDataSet的FileName属性输入一个名称,用鼠标右键单击组件,并选择Create Table命令即可;我们准备编译并运行应用程序(在向它连接数据敏感组件之后)。数据会自动从提供的文件中读取,关闭程序时会将变化保存在文件中。
    如果使用DBGrid查看结果数据集合,它允许我们展开或压缩ADT字段的子字段。我们可以通过定义字段的OnGetText事件提供它的压缩值(在 Delphi4 中有一个缺省值,但Delphi5中没有):

procedure TForm1.ClientDataSet1NameGetText(Sender:TField;
var Text:String;DisplayText:Boolean);
begin
Text:=ClientDataSet1NameFirstName.AsString+' '+
        ClientDataSet1NameLastName.AsString;
end;

2、动态索引
    一旦ClientDataSet上有了数据,数据就已全部处于内存中了。当我们将组件基于局部文件中时(如在AdtDemo范例中),在程序启动时整个文件就被装载到了内存总。这与从Paradox数据表格中装载数据(BDE只装载正访问的字段)不同。
    将整个表格装在内存中的优点是,我们可以快速地对它进行分类。使用ClientDataSet组件,我们可以通过赋给IndexFieldNames属性相应的字段名来实现分类。在AdtDemo(以及很多程序)中,该索引变动会在单击DBGrid控件的标题(触发OnTitleClick事件)时执行:

procedure TForm1.DBGrid1TitleClick(Column:TColumn);
begin
if Column.Field.FullName = 'Name' then
     ClientDataSet1.IndexFieldNames := 'Name.LastName'
else
     ClientDataSet1.IndexFieldNames := Column.Field.FullName;
end;

   由于ADT定义,程序使用了字段的FullName属性(而不是FieldName属性)。事实上,对于子字段来说,索引应该基于 Name.LastName,而不是LastName。而且ADT字段不能自己被索引,所以如果选择它,程序会使用LastName子字段作为索引。这些索引不是持久性的;它们没有保存在文件中,而只是在内存中应用于数据。
   技巧:ClientDataSet可以拥有基于计算字段的索引,特别是内部计算字段,这种字段类型只能用于该数据集合。

3、分组

   一旦为ClientDataSet定义了一个索引,就可以通过该索引对数据进行分组了。实际上,一组被定义为连续记录的一个列表(根据索引),记录中被索引的字段的值不会改变。例如,如果有一个基于国家的索引,带有该国家的所有地址都将归为一组。
   cdsCalcs范例有一个ClientDataSet组件,它同样从DBDEMOS数据库的Country表格中读取其数据。该操作可以在设计时,使用 ClientDataSet组件快捷菜单的Assign Local Data命令来执行。为了在运行时读取数据,获得一个更新的快照,可以向窗体添加一个DataSetProvider组件,如下连接三个组件:
   Object Table :TTable
     active = true
     databasename = 'dbdemos'
     tablename = 'country.db'
   end

   object datasetprovider1: TDataSetProvider
     dataset = table1
   end

   object clientdataset1: tclientdataset
     providername = 'datasetprovider1'
   end


现在我们来看看组的定义。该定义可以通过为索引指定一个分组级别,与索引定义一起获得:

   object clientdataset1: tclientdataset
     indexdefs = <
       item
         name = 'clientdataset1index1'
         fields = 'continent'
         groupinglevel = 1
       end>

     indexname = 'clientdtaset1index1'


当拥有了一组之后,我们可以在DBGrid中向用户显示分组结构。只需为分组字段(在范例中是Continent字段)处理OnGetText事件,只有当记录是组的第一个记录是才显示文本:

procedure TForm1.ClientDataSet1ContinentGetText(Sender:TField;
var Text:String;DisplayText:Boolean);
begin
if gbFirst in ClientDataSet1.GetGroupState(1) then
     Text:= sender.asstring
else
     text:='';
end;


4、定义合计

   ClientDataSet组件另一个功能强大的特性是对合计的支持。合计是一个基于多个记录的计算值,如整个数据表格或一组记录(使用我们刚才讨论过的分组逻辑来定义)中某个字段的和值或平均值。合计是可持续的;也就是说,如果有一个记录发生改变,会立刻重新计算合计值。例如,当拥护在发货清单条目中输入时,发货单的总和会自动被重新计算出来。
   注意:::合计是递增维持的,而不是每当有一个值改动时就重新计算所有的值。合计的更新利用了ClientDataSet追踪的Delta。例如,当字段发生改变时,为了更新Sum,ClientDataSet会从合计中读取旧值,并加上新值。只需要两次计算,即使在该合计组中有上千行。因此,合计更新是瞬时的。
   有两种方法定义合计。我们可以使用ClientDataSet(是一个集合)的Aggregates属性,或可以使用Fields编辑器定义合计字段。在这两种情况下,我们定义的合计表达式,赋给它一个名称,并将它与一个索引和一个分组级别(除非想将它应用于整个数据表格)连接。下面是CdsCalcs范例的Aggregates集合:

Object ClientDataSet1: TClientDataSet

Aggregates = <
    item
      Active = True
      AggregateName = 'Count'
      Expression = 'Count(Name)'
      GroupingLevel = 1
      IndexName = 'ClientDataSet1Index1'
      Visible = False
    end
    item
      Active = True
      AggregateName = 'TotalPopulation'
      Expression = 'SUM(POPULATION)'
      Visible = False
    end>

AggregatesActive = True


注意,在上面的最后一行代码中,除了激活每个想使用的特定合计之外,我们还必须为合计激活支持。解除合计是重要的,因为合计太多会减慢程序执行的速度。我们曾提到的另一种方法是使用Fields编辑器,在其快捷菜单中选择New Field命令,并选择Aggregate选项(只有在一个ClientDataSet中可以与InternalCalc选项一起使用)。下面是一个合计字段的定义:

Object ClientDataSet1: TClientDataSet
object ClientDataSet1TotalArea: TAggregateField
    FieldName = 'TotalArea'
    ReadOnly = True
    Visible = True
    Active = True
    DisplayFormat = '###,###,###'
    Expression = 'SUM(AREA)'
    GroupingLevel = 1
    IndexName = 'ClientDataSet1Index1'
end

    合计字段在Fields编辑器中被显示为独立的一组。与普通合计相比,使用合计字段的优点是,我们可以定义显示格式,并将字段直接与数据敏感控件相连,如 CdsCalcs范例中的DBEdit。因为合计与一个组相连,所以要选择了另一组的记录,输出就会被自动更新。而且,如果改变数据,合计值也会立刻显示新值。
    为了使用普通合计,必须编写一些代码,如下例子中所示(注意合计的Value是一个变体):

procedure TForm1.Button1Click(Sender: TObject);
begin
Label1.Caption:= 'Area : '+ ClientDataSet1TotalArea.DisplayText +
#13'Population : ' + FormatFloat('###,###,###',ClientDataSet1.Aggregates[1].Value)
+ #13'Number : ' + IntToStr(ClientDataSet1.Aggregates[0].Value);
end;

轉貼至:https://www.cnblogs.com/yplong/archive/2013/02/23/2923473.html