Question

我需要处理一些数据并且每5-10秒显示一次进度（我以百分比显示进度但我也更新了一些图表）。我想在没有多线程的情况下这样做。循环可能很大。它可以从数百万开始，可能高达数十亿。

我可以使用GetTickCount：

const 
  RefreshEvery= 5000;

for x:= 1 to 10000000000 do
 if GetTickCount-OldTime> RefreshEvery then
 begin
   OldTime:= GetTickCount;
   if Assigned(FProgress) then FProgress(Self);
 end;

但是在循环中调用GetTickCount会执行数十亿次......

关于最有效的方法的任何想法？

为什么没有多线程？
这是一个很大的应用程序，在GUI进度模块中有一个小故障。我想解决这个问题，重新打包并交付它而不需要对其进行大的更改，这需要再次进行密集测试。多线程？......很酷，但后来......

Answer 1

您的问题似乎是确定一种有效的方法来评估发布进度更新的时间间隔。如果你是针对线程方法设置的，那么你正在做的事情很好 - 没有太多改进它的方法。实际上，确定更新间隔的效率在线程代码中也是如此，因此无论是否有线程问题都是相同的。

您似乎对FProgress(self)的内容存在问题（即：如何执行状态更新），这似乎也不是关于＆＃34;取消冻结＆＃34 ; GUI所以我不会解决这些问题。

您的选择

GetTickCount - 根据时间更新
if x mod 1000 = 0 - 基于循环变量更新
（类似于）if x shl 22 = 0 - 与上面相同，但是没有分裂的棘手的mod 1024
Per @LURD，您也可以使用类似if i and $3FF = 0的类似性能

如果您的循环完全没有任何肉，那么它们的性能几乎相同。测试：

program Project1;

uses Windows, SysUtils;

{$APPTYPE CONSOLE}    

var 
  i : integer;
  t0 : cardinal;
begin
  t0 := GetTickCount;
  for i := 0 to 1000000000 do begin
    if t0 - GetTickCount > 1000 then;
  end;
  t0 := GetTickCount - t0;
  WriteLn('GetTickCount : ' + IntToStr(t0));

  t0 := GetTickCount;
  for i := 0 to 1000000000 do begin
    if i mod 1000 = 0 then;
  end;
  t0 := GetTickCount - t0;
  WriteLn('i mod 1000 : ' + IntToStr(t0));

  t0 := GetTickCount;
  for i := 0 to 1000000000 do begin
    if i shl 22 = 0 then;
  end;
  t0 := GetTickCount - t0;
  WriteLn('i shl 22 : ' + IntToStr(t0));

  ReadLn;
end.

产生输出（对我来说）

 GetTickCount : 3978   
 i mod 1000 :   3386   
 i shl 22 :     2184

最后一个选项大约是表现的两倍，但是如果你的循环做任何实质性的事情，你可能不会注意到任何差异。

附录：

如果你需要让自己满意的话，比特移位是一种准确的方法：

program Project1;

uses SysUtils;

{$APPTYPE CONSOLE}

var
  i : integer;
begin
  for i := 0 to 1000000000 do begin
    if (i shl 22 = 0) <> (i mod 1024 = 0) then
      WriteLn('not the same! : ' + IntToStr(i));
  end;
  WriteLn('complete.');
  ReadLn;
end.

请注意，i shl 22不等于i mod 1024，但对于相同的i值，它们都为零。

Answer 2

如果您不想将繁忙的循环移动到后台线程中，您至少可以使用后台线程进行计时：

type
  TTimerThread = class(TThread)
  protected
    procedure Execute; override;
  public
    class var Flag: Boolean;
  end;

implementation

{ TTimerThread }

procedure TTimerThread.Execute;
begin
  Sleep(5000); // 5 seconds;
  Flag:= True;
end;

并在繁忙循环中检查/重置TTimerThread.Flag。

更新：一个更好的计时器线程，可以立即终止，最多等待5秒钟：

uses
  Windows, Classes;

type
  TimerThread = class(TThread)
  private
    FEvent: THandle;
  protected
    procedure Execute; override;
  public
    class var Flag: Boolean;
    procedure FastTerminate;
  end;

implementation

{ TimerThread }

procedure TimerThread.Execute;
begin
  FEvent:= CreateEvent(nil, True, False, nil);
//  FreeOnTerminate:= True;
  while not Terminated do begin
    if WaitForSingleObject(FEvent, 5000) = WAIT_TIMEOUT then
      Flag:= True
    else
      Terminate;
  end;
  CloseHandle(FEvent);
end;

procedure TimerThread.FastTerminate;
begin
  SetEvent(FEvent);
end;

Answer 3

不是最优雅的方法，或者说有点脏，但它正在运行和（与其他答案形成对比），它使GUI保持响应！

如果你使用Application.ProcessMessages条件之类的东西可以根据需要进行调整，那么调用x mod 1000 = 0的开销不应该如下所述 gigantic 。此外，我们不知道“数据处理”的实际计算密集程度如何，Application.ProcessMessages的实际影响最小是不可能的。

procedure TForm2.CancelButtonClick(Sender: TObject);
begin
  FCanceled := true;
end;

procedure TForm2.StartButtonClick(Sender: TObject);
var
  x: Integer;
  timer: TTimer;
begin
  timer := TTimer.Create(self);
  timer.Interval := 5000;
  timer.OnTimer := HandleTimer;
  for x:= 1 to 10000000000 do
  begin
    if (x mod 1000 = 0) then
      Application.ProcessMessages;
    inc(FProgress);
    if FCanceled then
      break;
  end;
  timer.Free;
end;

procedure TForm2.HandleTimer(Sender: TObject);
begin
  Label1.Caption := IntToStr(FProgress);
end;

如何显示长进程的GUI进度？

3 个答案: