为了大家都看到,就贴在这里吧:
unit CBackF;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
Db, DBTables, Grids, DBGrids, ComCtrls, StdCtrls, Bde;
type
TForm1 = class(TForm)
Button1: TButton;
Button2: TButton;
ProgressBar1: TProgressBar;
Query1: TQuery;
DataSource2: TDataSource;
DBGrid2: TDBGrid;
ListBox1: TListBox;
procedure Button2Click(Sender: TObject);
procedure Button1Click(Sender: TObject);
private
fAborted: Boolean;
CallBackObj: TBDECallBack;
CallBackObj1: TBDECallBack;
function fnCallBack (CBInfo: Pointer): CBRType;
function fnCancelCallBack (CBInfo: Pointer): CBRType;
public
{ Public declarations }
end;
var
Form1: TForm1;
implementation
{$R *.DFM}
procedure TForm1.Button2Click(Sender: TObject);
begin
fAborted := True;
Button2.Enabled := False;
end;
function TForm1.fnCallBack(CBInfo: Pointer): CBRType;
var
I: Integer;
begin
if fAborted then
Result := cbrAbort
else
Result := cbrContinue;
with PCBPROGRESSDesc(CBInfo)^ do
begin
ListBox1.Items.Add ('Message:' + szMsg);
ProgressBar1.Position := iPercentDone;
ListBox1.Items.Add ('Percent: ' + IntToStr (iPercentDone));
end;
for I := 1 to 1000 do
Application.ProcessMessages;
end;
procedure TForm1.Button1Click(Sender: TObject);
var
Buffer: CBPROGRESSDesc;
begin
// activate the DBE first
Session.Open;
// create and install the callback object
CallBackObj := TBDECallBack.Create (Self, nil,
cbGenProgress {cbCancelQry}, @Buffer, sizeof (Buffer),
fnCallBack, True);
CallBackObj1 := TBDECallBack.Create (Self, nil,
cbCancelQry, @Buffer, sizeof (Buffer),
fnCancelCallBack, True);
try
Query1.Open;
finally
CallBackObj.Free;
CallBackObj1.Free;
end;
end;
function TForm1.fnCancelCallBack(CBInfo: Pointer): CBRType;
const i:integer=0;
begin
if faborted then
result:= cbrABORT
else
result:= cbrContinue;
end;
end.
这是一个示例程序,从网上得来的,其中fnCancelCallBack是我加的,
用于测试calcel功能,结果是paradox时两个callback function都会被
调用,sql server时一个也不行。
并且可以注意到ipercentdone总为-1,看来是为batchmove设计的,
对其他操作无意义。