线程Timer对象

type

 TTimerThread = class ;

 TWakeupKind = ( wkTimerExpired , wkEventTriggered );

 TWaitState = ( wsIdle , wsWaiting );

 TWakeupEvent = procedure ( sender : TTimerThread ; reason : TWakeupKind ) of object ;

 TTimerThread = class ( TThread )

  private

   FInterval : DWORD ;

   FReason : TWakeupKind ;

   FEvent : THandle ;

   FState : TwaitState ;

   FWakeupEvent : TWakeupEvent ;

   FNoWakeupEvent : Boolean ;

    procedure SyncWakeup ;

  protected

    procedure DoWakeup ;

  public

    constructor Create ; reintroduce ;

    destructor Destroy ; override ;

    procedure Execute ; override ;

    procedure Sleep ( forInterval : DWORD );

    procedure Wakeup ;

    procedure Terminate ;

    property OnTimer : TWakeupEvent read FWakeupEvent write FWakeupEvent ;

    property Interval : DWORD read FInterval write FInterval ;

    property State : TWaitState read FState ;

  end ; {TTimerThread}

implementation

{ TTimerThread }

constructor TTimerThread . Create ;

begin

  // create thread suspended

  inherited Create ( true );

  // create event object

 FEvent := CreateEvent (

    nil , // use default security

   true , // event will be manually reset

   false , // event starts out not signaled

    nil ); // event has no name

  if FEvent = 0 then

    raise Exception . CreateFmt ( 'TTimerThread.Create: could not create API event handle.'#13#10'%s' ,

      [ Syserrormessage ( GetLastError )]);

  // thread will stay suspended until started by a Sleep or Resume call

 FState := wsIdle ;

 FNoWakeupEvent := False ;

end ;

destructor TTimerThread . Destroy ;

begin

  inherited ;

  if FEvent <> 0 then

   CloseHandle ( FEvent );

end ;

procedure TTimerThread . DoWakeup ;

begin

  // called in threads context to fire OnWakeup event

  if Assigned ( FWakeupEvent ) and not FNoWakeupEvent then

   Synchronize ( SyncWakeup );

end ;

procedure TTimerThread . Execute ;

var

 res : DWORD ;

begin

  // Executes inside threads context

  repeat

   Fstate := wsWaiting ;

   res := WaitForSingleObject ( FEvent , FInterval );

    if res = WAIT_OBJECT_0 then

    begin

     FReason := wkEventTriggered ;

     ResetEvent ( FEvent );

    end

    else

     FReason := wkTimerExpired ;

   DoWakeup ;

    if not Terminated then

    begin

     Fstate := wsIdle ;

     Suspend ;

    end ;

  until Terminated ;

end ;

procedure TTimerThread . Sleep ( forInterval : DWORD );

begin

  // called from outside threads context to start thread sleeping

 Interval := forInterval ;

  if State <> wsIdle then

  begin

    // thread is already waiting. Wake it up but disable wakeup event

   FNoWakeupEvent := true ;

    try

     Wakeup ;

      while State = wsWaiting do

       Windows . Sleep ( 10 );

    finally

     FNoWakeupEvent := false ;

    end ;

  end ;

 Resume ;

end ;

procedure TTimerThread . SyncWakeup ;

begin

  // executes in main threads context

  // Note: FWakeupevent has already been checked to be <> nil in DoWakeup

 FWakeupEvent ( self , FReason );

end ;

procedure TTimerThread . Terminate ;

begin

  inherited Terminate ;

  // in case thread is waiting, don't fire Wakeup event on wakeup.

 FNoWakeupEvent := true ;

 Wakeup ;

end ;

procedure TTimerThread . Wakeup ;

begin

  // executes in callers thread context

  if State = wsWaiting then

   SetEvent ( FEvent );

end ;