Delphi 执行查询时显示进度条

要在执行查询时显示ProgressBar，我使用以下代码：

if not Query1.Prepared then
  Query1.Prepare;
Query1.Open;

ProgressBar1.Max := Query1.RecordCount;

ProgressBar1.Min := 0;
ProgressBar1.Position := 0;
Query1.First;
while not Query1.Eof do
begin
  ProgressBar1.Position := ProgressBar1.Position+1;
  ProgressBar1.StepIt;           
  Query1.Next;
  Application.ProcessMessages;
end;   

但是ProgressBar的显示仍然冻结（我看不到ProgressBar的进度）

---

执行此查询时，如何查看ProgressBar1的进度？

您没有对查询运行进度。查询在调用

Open

时进行。这时，查询被发送到数据库，然后数据库会处理它，这需要时间

在查询完成并对结果进行迭代之后，您将尝试执行进度。这可能是如此之快，以至于没有必要取得进展。在任何情况下，如果这很耗时，至少它会发生在代码中，因此您可以显示进度

真正的问题是，查询发生在数据库服务器上的其他地方，并且您无法从中获得进度回调。我确信某些数据库服务器确实提供了进度回调，但我认为您的技术没有这种可用性

也许你要做的最简单的事情如下：

将查询代码移动到单独的线程中。这对于保持主UI线程的响应性至关重要

不要试图填充进度条（因为没有进度回调，所以无法填充进度条），而是使用字幕进度条。这是一个进度条，它来回移动，告诉用户程序正忙，但没有挂起

---

您没有对查询运行进度。查询在调用

Open

时进行。这时，查询被发送到数据库，然后数据库会处理它，这需要时间

在查询完成并对结果进行迭代之后，您将尝试执行进度。这可能是如此之快，以至于没有必要取得进展。在任何情况下，如果这很耗时，至少它会发生在代码中，因此您可以显示进度

真正的问题是，查询发生在数据库服务器上的其他地方，并且您无法从中获得进度回调。我确信某些数据库服务器确实提供了进度回调，但我认为您的技术没有这种可用性

也许你要做的最简单的事情如下：

将查询代码移动到单独的线程中。这对于保持主UI线程的响应性至关重要

不要试图填充进度条（因为没有进度回调，所以无法填充进度条），而是使用字幕进度条。这是一个进度条，它来回移动，告诉用户程序正忙，但没有挂起

---

一些数据库组件提供异步操作，如TADOxxx组件，这样可以在查询运行时显示进度。下面是如何使用aysnc模式的完整示例（此示例使用SQL server）：

---

一些数据库组件提供异步操作，如TADOxxx组件，这样可以在查询运行时显示进度。下面是如何使用aysnc模式的完整示例（此示例使用SQL server）：

---

不要同时使用

Position+1

和

StepIt（）

。你的进度增加得太多了。使用其中一个，而不是两个。并且根本不要使用

Application ProcessMessages（）

。使用表单的

Update（）

方法，或者将查询移动到另一个线程。谢谢你，雷米，我删除了：Application ProcessMessages（）和StepIt（）。我添加了Update（）方法，但显示仍然冻结<代码>而不是查询1.Eof do初学者ProgressBar1.Position:=ProgressBar1.Position+1；ProgressBar1.Update（）；问题1.下一步；结束我在这个代码中犯了错误吗？请不要同时使用

Position+1

和

StepIt（）

。你的进度增加得太多了。使用其中一个，而不是两个。并且根本不要使用

Application ProcessMessages（）

。使用表单的

Update（）

方法，或者将查询移动到另一个线程。谢谢你，雷米，我删除了：Application ProcessMessages（）和StepIt（）。我添加了Update（）方法，但显示仍然冻结<代码>而不是查询1.Eof do初学者ProgressBar1.Position:=ProgressBar1.Position+1；ProgressBar1.Update（）；问题1.下一步；结束请问我在这个代码中犯了错误吗？谢谢你的帮助。我在本地使用绝对数据库。所以数据库在我的电脑里。我完全同意你所说的。将查询代码移动到单独的线程中。我不知道如何在我的情况下做到这一点。我将寻找一个例子一个例子将不胜感激。谢谢你的帮助，谢谢。但是，GUI线程在查询运行时被阻塞，因此字幕进度条不起作用：）@DaveBoltman这完全是意料之中的，因为您阻塞了主线程。如果您希望显示一个字幕进度条，那么您需要在工作线程上执行该操作。这在Delphi中很棘手，因为UI库必须从主线程访问。如果您的目标是Windows，您可以创建一个纯Win32窗口，并在后台线程中运行它。你真正的问题是，你在阻止主线程的时候犯了一个错误。当然，谢谢。现在正在研究异步执行查询…感谢您的帮助。我在本地使用绝对数据库。所以数据库在我的电脑里。我完全同意你所说的。将查询代码移动到单独的线程中。我不知道如何在我的情况下做到这一点。我将寻找一个例子一个例子将不胜感激。谢谢你的帮助，谢谢。但是，GUI线程在查询运行时被阻塞，因此字幕进度条不起作用：）@DaveBoltman这完全是意料之中的，因为您阻塞了主线程。如果您希望显示一个字幕进度条，那么您需要在工作线程上执行该操作。这在Delphi中很棘手，因为UI库必须从主线程访问。如果你

unit Unit1;

interface

uses
  Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
  Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Data.DB, Data.Win.ADODB, Vcl.StdCtrls;

type
  TDataSetWrapper = class(TDataSet);

  TForm1 = class(TForm)
    ADOConnection1: TADOConnection;
    ADOQuery1: TADOQuery;
    Button1: TButton;
    Memo1: TMemo;
    procedure FormCreate(Sender: TObject);
    procedure Button1Click(Sender: TObject);
  private
    { Private declarations }
    AbortQuery : Boolean;
    procedure ADOQuery1FetchProgress(DataSet: TCustomADODataSet; Progress, MaxProgress: Integer; var EventStatus: TEventStatus);
    procedure ADOQuery1FetchComplete(DataSet: TCustomADODataSet; const Error: Error; var EventStatus: TEventStatus);
    procedure ProcessRecords;
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

// warning about OnFetchxxxx events, they occurr OUTSIDE the main thread, always synchronize!!!
procedure TForm1.ADOQuery1FetchComplete(DataSet: TCustomADODataSet; const Error: Error; var EventStatus: TEventStatus);

begin
 if EventStatus = esOK then
  // access your records here
  TThread.Synchronize(nil, ProcessRecords);
 TThread.Synchronize(nil, procedure()
  begin
   Button1.Caption := 'Start';
   Button1.Tag := 0;
  end
 );
end;

procedure TForm1.ADOQuery1FetchProgress(DataSet: TCustomADODataSet; Progress, MaxProgress: Integer; var EventStatus: TEventStatus);
begin
 // query has been aborted
 if Button1.Tag=2 then
  begin
   EventStatus := esCancel;
   TThread.Synchronize(nil, procedure()
    begin
     if Assigned(ADOQuery1.RecordSet) then ADOQuery1.RecordSet.Cancel;
     Button1.Tag := 0;
    end
   );
  end else
 // query busy
 if Button1.Tag=1 then
  TThread.Synchronize(nil, procedure()
   begin
    // indicate progress 
    Memo1.Lines.Add(Format('progress: %d',[Progress]));
   end
  );
end;

procedure TForm1.ProcessRecords;
begin
   ADOQuery1.First;
   Memo1.Lines.Add(ADOQuery1.Fields[0].AsString);
   ADOQuery1.Next;
   Memo1.Lines.Add(ADOQuery1.Fields[0].AsString);
   ADOQuery1.Next;
   Memo1.Lines.Add(ADOQuery1.Fields[0].AsString);
   ADOQuery1.Next;
   Memo1.Lines.Add(ADOQuery1.Fields[0].AsString);
   ADOQuery1.Next;
   Memo1.Lines.Add(ADOQuery1.Fields[0].AsString);
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
 // use tag to define state we are in
 // 0 means idle
 // 1 means query active
 // 2 means abort query
 if Button1.Tag = 0 then
  begin
   Button1.Tag := 1;
   // simulate long query with cross join, make sure your table has enough records (in this case 1000 records is enough)
   ADOQuery1.SQL.Text := 'SELECT TOP 100000 T1.* FROM MyTable T1, MyTable T2';
   ADOQuery1.Open;
   Button1.Caption := 'Abort';
  end else
 if Button1.Tag = 1 then
  begin
   // abort!!!
   Button1.Tag := 2;
  end;
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
 Button1.Caption := 'Start';
 Button1.Tag := 0;
 ADOQuery1.ExecuteOptions := [eoAsyncExecute, eoAsyncFetchNonBlocking];
 ADOQuery1.OnFetchProgress := ADOQuery1FetchProgress;
 ADOQuery1.OnFetchComplete := ADOQuery1FetchComplete;
 ADOConnection1.Connected := True;
end;

end.