Delphi线程类(四)
View Code
{*******************************************************} { } { Delphi Thread Sample 4 } { Creation Date 2012.12.21 } { Created By: ming } { } {*******************************************************} unit unitWorkThread; interface uses Classes,Windows, Messages, SysUtils, Graphics, StdCtrls; type TWorkThread = class(TThread) private { Private declarations } FEvent: HWND; FMsg: string; FMemo: TMemo; FInterval,FTickTimes: Cardinal; procedure doSyncProc1; procedure syncOutputMsg; procedure addLog(const msg: string); overload; procedure addLog(const fmtStr:string; const params: array of const); overload; procedure _sleep(millisecond:Cardinal); protected procedure Execute; override; public constructor Create(Suspend: boolean); overload; constructor Create(Suspend: boolean; mmoOutput: TMemo); overload; destructor Destroy; override; private FThreadPause,FThreadStop: Boolean; procedure doSomething; public function ThreadStart: Boolean; function ThreadPause: Boolean; function ThreadStop: Boolean; procedure ThreadTerminate; public property Interval:Cardinal read FInterval write FInterval; end; var WorkThread: TWorkThread; implementation { TWorkThread } constructor TWorkThread.Create(Suspend: boolean); begin inherited Create(Suspend); FEvent := CreateEvent(nil,True,False,nil); FreeOnTerminate := True; FInterval := 1000; end; procedure TWorkThread.addLog(const msg: string); begin FMsg := msg; Synchronize(syncOutputMsg); end; procedure TWorkThread.addLog(const fmtStr: string; const params: array of const); begin FMsg := Format(fmtStr,params); Synchronize(syncOutputMsg); end; constructor TWorkThread.Create(Suspend: boolean; mmoOutput: TMemo); begin inherited Create(Suspend); FEvent := CreateEvent(nil,True,False,nil); FreeOnTerminate := True; FInterval := 1000; FMemo := mmoOutput; end; destructor TWorkThread.Destroy; begin CloseHandle(FEvent); inherited; end; procedure TWorkThread.doSomething; begin addLog(FormatDateTime('c',now)); end; procedure TWorkThread.doSyncProc1; begin end; procedure TWorkThread.syncOutputMsg; var dt: string; begin dt := FormatDateTime('hh:nn:ss',now); FMsg := Format('[%s] - ',[dt]) + FMsg; if Assigned(FMemo) then FMemo.Lines.Add(FMsg); end; procedure TWorkThread.Execute; begin inherited; while not Terminated do begin if WaitForSingleObject(FEvent,100)=WAIT_OBJECT_0 then begin Break; end; if (GetTickCount - FTickTimes) >= FInterval then try if not FThreadStop then begin doSomething; FTickTimes := GetTickCount; end; except on e:Exception do addLog(e.Message); end; if FThreadStop then Suspend; end; end; function TWorkThread.ThreadStart: Boolean; begin FThreadStop := False; if Suspended then Resume; end; function TWorkThread.ThreadPause: Boolean; begin FThreadPause := True; if not Suspended then Suspend; end; function TWorkThread.ThreadStop: Boolean; begin FThreadPause := False; FThreadStop := True; if Suspended then Resume; end; procedure TWorkThread.ThreadTerminate; begin FThreadStop := False; if FEvent>0 then begin SetEvent(FEvent); if Suspended then Resume; end; end; procedure TWorkThread._sleep(millisecond: Cardinal); begin //WaitForSingleObject(Self.Handle,millisecond); WaitForSingleObject(FEvent,millisecond); end; end.