基于内核对象WaitableTimer实现的Timer组件

 基于内核对象WaitableTimer实现的Timer组件

 

把TTimer组件的代码抄了过来，把实现计数部分改由内核对象来实现。

Delphi(Pascal) code

   
   

    
    
unit WaitTimerU;

interface

uses
  Classes, Windows, Consts;


    
    type
    
    
  TWaitTimer 
    
    =
    
     class(TComponent)
  private
    FWaitableTimer: THandle;
    FInterval: Cardinal;
    FOnTimer: TNotifyEvent;
    FEnabled: Boolean;
    
    
    procedure
    
     UpdateTimer;
    
    
    procedure
    
     SetEnabled(Value: Boolean);
    
    
    procedure
    
     SetInterval(Value: Cardinal);
    
    
    procedure
    
     SetOnTimer(Value: TNotifyEvent);
  protected
    
    
    procedure
    
     Timer; dynamic;
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
  published
    property Enabled: Boolean read FEnabled write SetEnabled default True;
    property Interval: Cardinal read FInterval write SetInterval default 
    
    1000
    
    ;
    property OnTimer: TNotifyEvent read FOnTimer write SetOnTimer;
  
    
    end
    
    ;

implementation


    
    procedure
    
     TimerAPCProc(lpArgToCompletionRoutine: Pointer; dwTimerLowValue: DWORD;
  dwTimerHighValue: DWORD); stdcall;

    
    begin
    
    
  TWaitTimer(lpArgToCompletionRoutine).Timer;
  SleepEx(INFINITE, True);

    
    end
    
    ;


    
    function
    
     WaitTimerThreadFun(P: Pointer): Integer; stdcall;

    
    var
    
    
  DueTime: Int64;

    
    begin
    
    
  
    
    with
    
     TWaitTimer(P) 
    
    do
    
    
  
    
    begin
    
    
    DueTime :
    
    =
    
     
    
    -
    
    Int64(Interval)
    
    *
    
    10000
    
    ;
    
    
    if
    
     SetWaitableTimer(FWaitableTimer, DueTime, Interval, @TimerAPCProc, P, False) 
    
    then
    
    
    
    
    begin
    
    
      SleepEx(INFINITE, True);
    
    
    end
    
    
    
    
    else
    
    
      raise EOutOfResources.Create(SNoTimers);
  
    
    end
    
    ;
  Result :
    
    =
    
     
    
    0
    
    ;

    
    end
    
    ;


    
    {
    
     TWaitTimer 
    
    }
    
    

constructor TWaitTimer.Create(AOwner: TComponent);

    
    begin
    
    
  inherited Create(AOwner);
  FEnabled :
    
    =
    
     True;
  FInterval :
    
    =
    
     
    
    1000
    
    ;
  FWaitableTimer :
    
    =
    
     CreateWaitableTimer(
    
    nil
    
    , False, 
    
    nil
    
    );

    
    end
    
    ;

destructor TWaitTimer.Destroy;

    
    begin
    
    
  FEnabled :
    
    =
    
     False;
  UpdateTimer;
  CloseHandle(FWaitableTimer);
  inherited;

    
    end
    
    ;


    
    procedure
    
     TWaitTimer.SetEnabled(Value: Boolean);

    
    begin
    
    
  
    
    if
    
     Value 
    
    <>
    
     FEnabled 
    
    then
    
    
  
    
    begin
    
    
    FEnabled :
    
    =
    
     Value;
    UpdateTimer;
  
    
    end
    
    ;

    
    end
    
    ;


    
    procedure
    
     TWaitTimer.SetInterval(Value: Cardinal);

    
    begin
    
    
  
    
    if
    
     Value 
    
    <>
    
     FInterval 
    
    then
    
    
  
    
    begin
    
    
    FInterval :
    
    =
    
     Value;
    UpdateTimer;
  
    
    end
    
    ;

    
    end
    
    ;


    
    procedure
    
     TWaitTimer.SetOnTimer(Value: TNotifyEvent);

    
    begin
    
    
  FOnTimer :
    
    =
    
     Value;
  UpdateTimer;

    
    end
    
    ;


    
    procedure
    
     TWaitTimer.Timer;

    
    begin
    
    
  
    
    if
    
     Assigned(FOnTimer) 
    
    then
    
     FOnTimer(Self);

    
    end
    
    ;


    
    procedure
    
     TWaitTimer.UpdateTimer;

    
    var
    
    
  ID: DWORD;

    
    begin
    
    
  CancelWaitableTimer(FWaitableTimer);
  
    
    if
    
     (FInterval 
    
    <>
    
     
    
    0
    
    ) 
    
    and
    
     FEnabled 
    
    and
    
     Assigned(FOnTimer) 
    
    then
    
    
  
    
    begin
    
    
    CreateThread(
    
    nil
    
    , 
    
    0
    
    , @WaitTimerThreadFun, Self, 
    
    0
    
    , ID);
  
    
    end
    
    ;

    
    end
    
    ;


    
    end
    
    .