原来的实现:http://blog.csdn.net/jankercsdn/article/details/8874469 有许多不完善的地方,使用中进行了一些改动和完善,
unit uHardWorkThread; interface uses Windows, Messages, Classes, SysUtils, SyncObjs; const WM_QUIT_HARD_THREAD = WM_USER + 305; //退出线程 type THardWorkThread = class(TThread) private FMsgHandle:THandle; //消息目的窗口句柄 FErrorCount:Integer; //连续错误次数 FIsWorking:boolean; //是否正在工作 FIsSuspending:Boolean; //是否正在挂起 FQuitEvent:TEvent; //退出线程事件 FRunEvent:TEvent; //运行事件,有信号表示运行 FWorkCompletedEvent:TEvent; //工作完成事件, 有信号表示完成 FPIsInterrupt:PBoolean; //中断 protected function WaitForWorkCompleted(const AWaitTime:Integer):Boolean; //等待线程工作完成 procedure SetupWorkCompleted(AWorkCompleted:Boolean); //设置线程工作状态 procedure ImmediatelySuspend; //立即挂起,一般继承子孙类内部用 procedure Execute; override; procedure DoWorkProc(const APIsInterrupt:PBoolean); virtual; abstract; //实际的工作过程(虚方法,子类必须实现) public constructor Create(AMsgHandle:THandle); virtual; //这个句柄注意,当消息目的窗体的Position变化时,窗体的Handle就变了(比如Dock窗体) destructor Destroy; override; procedure StartThread; //开始线程 function ExitThread(const AWaitTime:Integer):Boolean; //退出线程 function SuspendThread(const AWaitTime:Integer):Boolean; //挂起线程 procedure ResumeThread; //恢复线程 property MsgHandle:THandle read FMsgHandle write FMsgHandle; //消息句柄 property ErrorCount:Integer read FErrorCount; end; implementation { THardWorkThread } constructor THardWorkThread.Create(AMsgHandle: THandle); begin inherited Create(True); FMsgHandle:=AMsgHandle; FQuitEvent:=TEvent.Create; FRunEvent:=TEvent.Create; FRunEvent.ResetEvent; FWorkCompletedEvent:=TEvent.Create; FWorkCompletedEvent.SetEvent; New(FPIsInterrupt); FPIsInterrupt^:=False; FErrorCount:=0; FIsWorking:=False; FIsSuspending:=True; //FreeOnTerminate:=True; //不要自动释放 end; destructor THardWorkThread.Destroy; begin Dispose(FPIsInterrupt); FWorkCompletedEvent.Free; FRunEvent.Free; FQuitEvent.Free; inherited; end; { procedure THardWorkThread.DoWorkProc; begin end; } procedure THardWorkThread.Execute; var Msg:TMsg; begin while True do begin if PeekMessage(Msg,0,0,0,PM_REMOVE) then begin if Msg.message = WM_QUIT_HARD_THREAD then begin FQuitEvent.SetEvent; Break; end; end; if FPIsInterrupt^ then begin Continue; end; //等待运行 FIsSuspending := True; FRunEvent.WaitFor(INFINITE); FIsSuspending := False; //退出时,如果线程挂起,则要恢复线程,然后退出 if PeekMessage(Msg,0,0,0,PM_NOREMOVE) then begin if Msg.message = WM_QUIT_HARD_THREAD then Continue; end; if FPIsInterrupt^ then begin Continue; end; SetupWorkCompleted(False); //开始工作 try DoWorkProc(FPIsInterrupt); finally SetupWorkCompleted(True); //完成工作 end; Sleep(100); end; end; function THardWorkThread.ExitThread(const AWaitTime: Integer): Boolean; begin Result:=True; FPIsInterrupt^:=True; PostThreadMessage(ThreadID,WM_QUIT_HARD_THREAD,0,0); if FIsSuspending then ResumeThread; //PostThreadMessage(ThreadID,WM_QUIT_HARD_THREAD,0,0); if FQuitEvent.WaitFor(AWaitTime) = wrTimeOut then Result:=False; end; procedure THardWorkThread.ImmediatelySuspend; begin FRunEvent.ResetEvent; //FIsSuspending := True; end; procedure THardWorkThread.ResumeThread; begin FRunEvent.SetEvent; //FIsSuspending := False; end; procedure THardWorkThread.SetupWorkCompleted(AWorkCompleted: Boolean); begin FIsWorking:=not AWorkCompleted; if AWorkCompleted then begin FWorkCompletedEvent.SetEvent; end else begin FWorkCompletedEvent.ResetEvent; end; end; procedure THardWorkThread.StartThread; begin Start; end; function THardWorkThread.SuspendThread(const AWaitTime: Integer): Boolean; begin Result:=False; if FIsSuspending then begin Result:=True; end else begin if WaitForWorkCompleted(AWaitTime) then begin FRunEvent.ResetEvent; FIsSuspending:=True; Result:=True; end; end; end; function THardWorkThread.WaitForWorkCompleted(const AWaitTime: Integer): Boolean; begin Result:=True; if FIsWorking then Result:=FWorkCompletedEvent.WaitFor(AWaitTime) = wrSignaled; end; end.