[教程]高效处理在主线程中显示后台线程处理进度

• Delphi • 评论关闭 • •浏览 849 次

先看经典的处理方法：

TThread.CreateAnonymousThread(
    procedure
    var
      AHint: TZProgressNotify;
      ACount: Integer;
      ATime: Cardinal;
    const
      PassCount=1000000;
    begin
      ACount := 0;
      ATime := TThread.GetTickCount;
      while (not Application.Terminated) and (ACount < PassCount) do
      begin
        AHint.Progress := ACount*100 div PassCount ;
        AHint.HintText := ACount.ToString;
        Inc(ACount);
        TThread.Synchronize(nil,
          procedure
          begin
            FProgress.Update(AHint);
          end
        );
        FProgress.Update(AHint);
      end;
      AHint.HintText := (TThread.GetTickCount - ATime).ToString + 'ms';
      FProgress.Update(AHint);
    end).Start;

我们需要更新进度时，将其切换到主线程，并更新进度显示。我们测试显示用了32735ms，也就是说100万次进度更新，用了约33秒。

接下来我们来看下优化后的代码：

TThread.CreateAnonymousThread(
    procedure
    var
      AHint: TZProgressNotify;
      ACount: Integer;
      ATime: Cardinal;
    const
      PassCount=1000000;
    begin
      ACount := 0;
      ATime := TThread.GetTickCount;
      while (not Application.Terminated) and (ACount < PassCount) do
      begin
        AHint.Progress := ACount*100 div PassCount ;
        AHint.HintText := ACount.ToString;
        Inc(ACount);
        FProgress.Update(AHint);
      end;
      AHint.HintText := (TThread.GetTickCount - ATime).ToString + 'ms';
      FProgress.Update(AHint);
    end).Start;

对的，你没看错，我们将 FProgress.Update 直接在后台线程调用了。我们对其代码进行了逻辑隔离，实测 100 万次进度更新，用时 78 毫秒。

我们来看一下具体的实现：

type
  TZProgressNotify = record
    Progress: Integer;
    HintText: String;
  end;

TZMainThreadUpdator < T: record >= record
private
const
  FLAG_READING = Integer($80000000);
var
  FBuffers: array [0 .. 1] of T;
  FActiveIndex, FUpdateRefCount: Integer;
public
  procedure Update(const AValue: T);
  function GetData: T;overload;
  procedure GetData(var AValue: T);overload;
  property Data: T read GetData;
end;

{ TZMainThreadUpdator<T> }

procedure TZMainThreadUpdator<T>.GetData(var AValue: T);
// 值复制可能会引起冲突，我们需要避免在值复制时，外部更新，所以将 FActiveIndex 加入标志位
var
  ABufferIndex: Integer;
begin
  Assert(MainThreadId = TThread.Current.ThreadID,
    'GetData must invoke in main thread');
  //设置读取中标记位，设置后，Update不会更新 FActiveIndex 的值
  repeat
    ABufferIndex := FActiveIndex;
  until AtomicCmpExchange(FActiveIndex, ABufferIndex or FLAG_READING,
    ABufferIndex) = ABufferIndex;
  AValue := FBuffers[ABufferIndex];
  //允许后续的 Update 更新 FActiveIndex 的值以体现最新的进度
  AtomicExchange(FActiveIndex, ABufferIndex);
end;

function TZMainThreadUpdator<T>.GetData: T;
begin
  GetData(Result);
end;

procedure TZMainThreadUpdator<T>.Update(const AValue: T);
var
  ABufferIndex: Integer;
begin
  ABufferIndex := AtomicIncrement(FUpdateRefCount);
  try
    // 增加计数，如果有多个同时提交更新，只有第一个会保留，剩下的会丢弃
    if ABufferIndex = 1 then
    begin
      // 多个线程同时更新，只保留第一个更新线程的结果，避免使用锁
      ABufferIndex := (FActiveIndex + 1) and $1;
      FBuffers[ABufferIndex] := AValue;
      // 如果 FActiveIndex 不处于读状态，则更新，否则忽略更新，可以增加额外的标记来记录这个情况，然后在读取的时候清楚这一标记，本版本不做处理
      AtomicCmpExchange(FActiveIndex, ABufferIndex, FActiveIndex and $1);
    end;
  finally
    AtomicDecrement(FUpdateRefCount);
  end;
end;
分享到：