Delphi拖延线程

在有些情况下，事件触发特别频繁，但是我们不希望事件每次触发都执行他对应的功能而是在我们操作完毕后才执行功能。

比如：Edit1.OnChange事件对应了一个查询本地库的操作，当我们比较快速的输入时界面总是出现卡顿的现象，感觉很不爽。

如何才能使程序在我们停止输入时才执行查询数据库操作呢？

我写了一个拖延线程：

unit UntTaskDelay;

interface

uses
  Windows, Classes;

type
  TTaskDelay = class(TThread)
  private
    FStart: Cardinal;
    FOffSet: Cardinal;
    FHWND: HWND;
    FWM_START: Cardinal;
  protected
    procedure Execute; override;
  public
    constructor Create(cOffSet: Cardinal; MainHdl: HWND; wmStart: Cardinal);
    destructor Destroy; override;
    procedure Delay;

    property OffSet: Cardinal read FOffSet write FOffSet;
  end;

var
  TaskDelay: TTaskDelay;

implementation

{ TaskDelay }

constructor TTaskDelay.Create(cOffSet: Cardinal; MainHdl: HWND; wmStart: Cardinal);
begin
  FOffSet:= cOffSet;
  FStart:= GetTickCount + FOffSet;

  FHWND:= MainHdl;

  FWM_START:= wmStart;

  inherited Create(True);   
  FreeOnTerminate:= True;
end;

procedure TTaskDelay.Delay;
begin
  FStart:= GetTickCount + FOffSet;
end;

destructor TTaskDelay.Destroy;
begin

  inherited;
end;

procedure TTaskDelay.Execute;
begin
  inherited;
  while not Terminated do
  begin
    if GetTickCount< FStart then
      Sleep(FOffSet)
    else
    begin
      SendMessage(FHWND, FWM_START, 0, 0);
      Break;
    end;
  end;
end;

end.

调用方式：

const
  WM_TASKDELAY = WM_USER + 1003;
  
type
  TForm1= class(TForm)
  private
    procedure WMTASKDELAY(var msg: TMessage); message WM_TASKDELAY;
  end;

//判断线程是否释放
//返回值：0-已释放；1-正在运行；2-已终止但未释放；
//3-未建立或不存在
function CheckThreadFreed(aThread: TThread): Byte;
var
  i: DWord;
  IsQuit: Boolean;
begin
  if Assigned(aThread) then
  begin
    IsQuit := GetExitCodeThread(aThread.Handle, i);
    if IsQuit then           //If the function succeeds, the return value is nonzero.
                                 //If the function fails, the return value is zero.
    begin
      if i = STILL_ACTIVE then    //If the specified thread has not terminated,
                                 //the termination status returned is STILL_ACTIVE.
        Result := 1
      else
        Result := 2;              //aThread未Free，因为Tthread.Destroy中有执行语句
    end
    else
      Result := 0;                //可以用GetLastError取得错误代码
  end
  else
    Result := 3;
end;
procedure TForm1.WMTASKDELAY(var msg: TMessage);
begin

end;

procedure TForm1.edtKHMCChange(Sender: TObject); 
begin
  case CheckThreadFreed(TaskDelay) of
    0,3:
    begin
      TaskDelay:= TTaskDelay.Create(100, Handle, WM_TASKDELAY);
      TaskDelay.Resume;
    end;
  end;
  TaskDelay.Delay;
end;

试试看吧！

猜你喜欢