unit Testbc1;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls,
  Forms, Dialogs, StdCtrls, Grids, DBGrids, DB, DBTables, ComCtrls;

type
  TForm1 = class(TForm)
    Table1: TTable;
    BatchMove1: TBatchMove;
    Table2: TTable;
    Button1: TButton;
    ProgressBar1: TProgressBar;
    procedure Button1Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

uses Bde; {Здесь расположены Dbi Types и Procs}

{$R *.DFM}

{тип структуры данных для сохранения информации о предыдущем обратном вызове}
type
  TDbiCbInfo = record
    ecbType: CBType;
    iClientData: longint;
    DataBuffLn: word;
    DataBuff: pCBPROGRESSDesc;
    DbiCbFn: pointer;
  end;
type
  PDbiCbInfo = ^TDbiCbInfo;

  {Наша функция обратного вызова}

function DbiCbFn(ecbType: CBType;
  iClientData: Longint;
  CbInfo: pointer): CBRType stdcall;
var
  s: string;
begin
  {Проверяем, является ли тип обратного вызова тем, который мы ожидаем}
  if ecbType = cbGENPROGRESS then
  begin
    {если iPercentDone меньше нуля, извлекаем число}
    {обработанных записей из параметра szMsg}
    if pCBPROGRESSDesc(cbInfo).iPercentDone < 0 then
    begin
      s := pCBPROGRESSDesc(cbInfo).szMsg;
      Delete(s, 1, Pos(': ', s) + 1);
      {Вычислям процент выполненного и изменяем линейку прогресса}
      Form1.ProgressBar1.Position :=
        Round((StrToInt(s) / Form1.Table1.RecordCount) * 100);
    end
    else
    begin
      {Устанавливаем линейку прогресса}
      Form1.ProgressBar1.Position :=
        pCBPROGRESSDesc(cbInfo).iPercentDone;
    end;
  end;
  {существовал ли предыдущий зарегистрированный обратный вызов?}
  {если так - осуществляем вызов и возвращаемся}
  if PDbiCbInfo(iClientData)^.DbiCbFn <> nil then
    DbiCbFn :=
      pfDBICallBack(PDbiCbInfo(iClientData)^.DbiCbFn)
      (ecbType,
      PDbiCbInfo(iClientData)^.iClientData,
      cbInfo)
  else
    DbiCbFn := cbrCONTINUE;
end;

procedure TForm1.Button1Click(Sender: TObject);
var
  CbDataBuff: CBPROGRESSDesc; {Структура DBi}
  {структура данных должна хранить информацию о предыдущем обратном вызове}
  OldDbiCbInfo: TDbiCbInfo;
begin
  {Убедимся в том, что перемещаемая таблица открыта}
  Table1.Open;
  {Убедимся в том, что таблица-приемник закрыта}
  Table2.Close;
  {получаем информацию о любом установленном обратном вызове}
  DbiGetCallBack(Table2.Handle,
    cbGENPROGRESS,
    @OldDbiCbInfo.iClientData,
    @OldDbiCbInfo.DataBuffLn,
    @OldDbiCbInfo.DataBuff,
    pfDBICallBack(OldDbiCbInfo.DbiCbFn));
  {регистрируем наш обратный вызов}
  DbiRegisterCallBack(Table2.Handle,
    cbGENPROGRESS,
    longint(@OldDbiCbInfo),
    SizeOf(cbDataBuff),
    @cbDataBuff,
    @DbiCbFn);

  Form1.ProgressBar1.Position := 0;
  BatchMove1.Execute;

  {если предыдущий обратный вызов существовал - вновь устанавливаем его,}
  {в противном случае "отрегистрируем" наш обратный вызов}
  if OldDbiCbInfo.DbiCbFn <> nil then
    DbiRegisterCallBack(Table2.Handle,
      cbGENPROGRESS,
      OldDbiCbInfo.iClientData,
      OldDbiCbInfo.DataBuffLn,
      OldDbiCbInfo.DataBuff,
      OldDbiCbInfo.DbiCbFn)
  else
    DbiRegisterCallBack(Table2.Handle,
      cbGENPROGRESS,
      longint(@OldDbiCbInfo),
      SizeOf(cbDataBuff),
      @cbDataBuff,
      nil);

  {Показываем наш успех!}
  Table2.Open;

end;

end.