{
     *******************************************************}{
                                                            }{
            Delphi Thread Sample 4                          }{
            Creation Date 2012.12.21                        }{
            Created By: ming                                }{
                                                            }{
     *******************************************************}unit unitWorkThread;interfaceuses  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;beginend;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.