obter progresso de uma consulta com CallBack

{Hoje quero me concentrar em um tópico que me foi solicitado
muitas vezes: como podemos obter o progresso de uma consulta
em execução e como podemos até cancelá-la? O Advantage Data
Architect faz isso, então deve ser possível;)
Olhando para as fontes de TAdsExtendedDataSet (adsfunc.pas),
você encontrará métodos wrapper em torno de duas funções da API ACE:
AdsRegisterCallbackFunction101 e AdsClearProgressCallback.
TAdsExtendedDataSet é um ancestral de TAdsQuery, portanto, ele herda esses métodos.}

{**********************************************************
*  Module:  TAdsExtendedDataSet.AdsRegisterCallbackFunction101
*  Date Created:  4-25-2012
*  Description:
**********************************************************}


procedure  TAdsExtendedDataSetTAdsExtendedDataSet.AdsRegisterCallbackFunction101(
                                            Value : TAdsCallbackFunction101; qCallbackID : Int64Int64);
begin
      ACECheck2( self, ACEACECheck2( self, ACE.AdsRegisterCallbackFunction101(
                                                                        TCallbackFunction101( Value ),qCallbackID ));
end;;

{**********************************************************
*  Module:  TAdsExtendedDataSet.AdsClearCallbackFunction
*  Date Created:  05/24/2001
*  Description:
**********************************************************}
procedure  TAdsExtendedDataSet.AdsClearCallbackFunction;
begin
      ACECheck2( self, ACECheck2( self, ACE.AdsClearCallbackFunction );
end;

{Como você pode ver, para registrar um retorno de chamada, você precisa
passar um ponteiro de função (não ponteiro de método!)
E um identificador de retorno de chamada. A função de retorno de chamada
é definida da seguinte forma:}


{ This data type defines what type of function to pass to
  AdsRegisterCallbackFunction(). }
TCallbackFunction101 = function( usPercent: Word; qCallbackID: Int64 ): Longint;



{Na verdade, existem duas definições de funções diferentes sendo usadas: uma é
válida para o Delphi anterior ao Delphi 4 (ponteiro de 32 bits) e a outra para
o Delphi 4 e mais recente (ponteiro de 64 bits). Isso deve ser mantido em mente
se for usado de maneira geral. No meu exemplo, concentro-me apenas nas versões
mais recentes do Delphi.
Agora há uma pergunta sobre como combinar uma função e um objeto, para que a
função de retorno de chamada (geral) possa atualizar o objeto. A solução é fácil
- e muito perigosa ao mesmo tempo: use o identificador de retorno de chamada para

passar um ponteiro para o objeto e devolvê-lo à função de retorno de chamada.
Para o meu exemplo, adicionei um método público ao meu Mainform.}


public
  function QueryCallback(usPercent: word):longint;
{Esse método faz uma atualização na barra de progresso do mainform e verifica
se há um sinalizador (bcancel, definido pelo evento “stop button click”).
Se o valor de retorno do método for diferente de 0, a consulta deve ser interrompida.}



function TMainform.QueryCallback(usPercent: word): longint;
begin
  ProgressBar1.Min:=0;
  ProgressBar1.Max:=100;
  ProgressBar1.Position:=usPercent;
  Application.ProcessMessages;
  if bcancel then result:=1
  else result:=0;
end;

{A função de retorno de chamada está sendo chamada a cada 2 segundos pelo Advantage
Client Engine até que a consulta seja concluída. Dentro da função, pegamos o ponteiro
e o convertemos para o TMainform antes de chamar o método QueryCallback.}


// Callback useda para cancelar a query
function ACECallback(usPercent:word; CallbackID:Int64):longint; stdcall;
begin
  result := TMainform(Pointer(CallbackID)).QueryCallback(uspercent);
end;


{Finalmente, registre a função a qualquer momento antes de abrir a consulta.
Não se esqueça de apagar quando o retorno de chamada não estiver mais sendo necessário.}


    bcancel:=false;
    AdsQuery1.AdsRegisterCallbackFunction101(@ACECallback,Int64(self));
    AdsQuery1.Open;
    AdsQuery1.AdsClearProgressCallback();