[分享]基于内核对象WaitableTimer实现的Timer组件,该如何处理

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.